From 58cd823d503cc445a90a4ed9d4ffdb0497d60c02 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler@nvidia.com>
Date: Tue, 15 Jul 2025 14:50:52 -0700
Subject: [PATCH] [flang] Catch bad members of BIND(C) COMMON block

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.
---
 flang/lib/Semantics/check-declarations.cpp | 48 +++++++++++++++++-----
 flang/test/Semantics/bind-c18.f90          |  7 ++++
 2 files changed, 44 insertions(+), 11 deletions(-)
 create mode 100644 flang/test/Semantics/bind-c18.f90

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