[flang-commits] [flang] 3de11b7 - [flang] Catch bad members of BIND(C) COMMON block (#148971)

[via flang-commits]

Author: Peter Klausler
Date: 2025-07-16T09:10:26-07:00
New Revision: 3de11b70620d911613a48d493048cb48bb76ec19

URL: https://github.com/llvm/llvm-project/commit/3de11b70620d911613a48d493048cb48bb76ec19
DIFF: https://github.com/llvm/llvm-project/commit/3de11b70620d911613a48d493048cb48bb76ec19.diff

LOG: [flang] Catch bad members of BIND(C) COMMON block (#148971)

Variables that can't be BIND(C), like pointers, can't be in a BIND(C)
common block, either.

Fixes https://github.com/llvm/llvm-project/issues/148922.

Added: 
    flang/test/Semantics/bind-c18.f90

Modified: 
    flang/lib/Semantics/check-declarations.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index f9d64485f1407..a2f2906af10b8 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -151,8 +151,8 @@ class CheckHelper {
   void CheckProcedureAssemblyName(const Symbol &symbol);
   void CheckExplicitSave(const Symbol &);
   parser::Messages WhyNotInteroperableDerivedType(const Symbol &);
-  parser::Messages WhyNotInteroperableObject(
-      const Symbol &, bool allowNonInteroperableType = false);
+  parser::Messages WhyNotInteroperableObject(const Symbol &,
+      bool allowNonInteroperableType = false, bool forCommonBlock = false);
   parser::Messages WhyNotInteroperableFunctionResult(const Symbol &);
   parser::Messages WhyNotInteroperableProcedure(const Symbol &, bool isError);
   void CheckBindC(const Symbol &);
@@ -519,11 +519,35 @@ void CheckHelper::Check(const Symbol &symbol) {
 }
 
 void CheckHelper::CheckCommonBlock(const Symbol &symbol) {
+  auto restorer{messages_.SetLocation(symbol.name())};
   CheckGlobalName(symbol);
   if (symbol.attrs().test(Attr::BIND_C)) {
     CheckBindC(symbol);
+    for (auto ref : symbol.get<CommonBlockDetails>().objects()) {
+      if (ref->has<ObjectEntityDetails>()) {
+        if (auto msgs{WhyNotInteroperableObject(*ref,
+                /*allowInteroperableType=*/false, /*forCommonBlock=*/true)};
+            !msgs.empty()) {
+          parser::Message &reason{msgs.messages().front()};
+          parser::Message *msg{nullptr};
+          if (reason.IsFatal()) {
+            msg = messages_.Say(symbol.name(),
+                "'%s' may not be a member of BIND(C) COMMON block /%s/"_err_en_US,
+                ref->name(), symbol.name());
+          } else {
+            msg = messages_.Say(symbol.name(),
+                "'%s' should not be a member of BIND(C) COMMON block /%s/"_warn_en_US,
+                ref->name(), symbol.name());
+          }
+          if (msg) {
+            msg->Attach(
+                std::move(reason.set_severity(parser::Severity::Because)));
+          }
+        }
+      }
+    }
   }
-  for (MutableSymbolRef ref : symbol.get<CommonBlockDetails>().objects()) {
+  for (auto ref : symbol.get<CommonBlockDetails>().objects()) {
     if (ref->test(Symbol::Flag::CrayPointee)) {
       messages_.Say(ref->name(),
           "Cray pointee '%s' may not be a member of a COMMON block"_err_en_US,
@@ -3154,14 +3178,16 @@ parser::Messages CheckHelper::WhyNotInteroperableDerivedType(
 }
 
 parser::Messages CheckHelper::WhyNotInteroperableObject(
-    const Symbol &symbol, bool allowNonInteroperableType) {
+    const Symbol &symbol, bool allowNonInteroperableType, bool forCommonBlock) {
   parser::Messages msgs;
-  if (examinedByWhyNotInteroperable_.find(symbol) !=
-      examinedByWhyNotInteroperable_.end()) {
-    return msgs;
+  if (!forCommonBlock) {
+    if (examinedByWhyNotInteroperable_.find(symbol) !=
+        examinedByWhyNotInteroperable_.end()) {
+      return msgs;
+    }
+    examinedByWhyNotInteroperable_.insert(symbol);
   }
   bool isExplicitBindC{symbol.attrs().test(Attr::BIND_C)};
-  examinedByWhyNotInteroperable_.insert(symbol);
   CHECK(symbol.has<ObjectEntityDetails>());
   if (isExplicitBindC && !symbol.owner().IsModule()) {
     msgs.Say(symbol.name(),
@@ -3258,7 +3284,7 @@ parser::Messages CheckHelper::WhyNotInteroperableObject(
     msgs.Say(symbol.name(),
         "An interoperable pointer must not be CONTIGUOUS"_err_en_US);
   }
-  if (msgs.AnyFatalError()) {
+  if (!forCommonBlock && msgs.AnyFatalError()) {
     examinedByWhyNotInteroperable_.erase(symbol);
   }
   return msgs;
@@ -3338,8 +3364,8 @@ parser::Messages CheckHelper::WhyNotInteroperableProcedure(
           // on the C side by either a cdesc_t * or a void *.  F'2023 18.3.7 (5)
           bool allowNonInteroperableType{!dummy->attrs().test(Attr::VALUE) &&
               (IsDescriptor(*dummy) || IsAssumedType(*dummy))};
-          dummyMsgs =
-              WhyNotInteroperableObject(*dummy, allowNonInteroperableType);
+          dummyMsgs = WhyNotInteroperableObject(
+              *dummy, allowNonInteroperableType, /*forCommonBlock=*/false);
         } else {
           CheckBindC(*dummy);
         }

diff  --git a/flang/test/Semantics/bind-c18.f90 b/flang/test/Semantics/bind-c18.f90
new file mode 100644
index 0000000000000..f61111458c6d9
--- /dev/null
+++ b/flang/test/Semantics/bind-c18.f90
@@ -0,0 +1,7 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1
+bind(c) :: /blk/
+!ERROR: 'x' may not be a member of BIND(C) COMMON block /blk/
+common /blk/ x
+!BECAUSE: A scalar interoperable variable may not be ALLOCATABLE or POINTER
+integer, pointer :: x
+end