[flang] Check for conflicting BIND(C) names

Check for two or more symbols that define a data object or entry point
with the same interoperable BIND(C) name.

Differential Revision: https://reviews.llvm.org/D100067

2 files changed, 60 insertions, 0 deletions

diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 69607c466e16..0b28a3188e5d 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -19,6 +19,8 @@
 #include "flang/Semantics/tools.h"
 #include "flang/Semantics/type.h"
 #include <algorithm>
+#include <map>
+#include <string>
 
 namespace Fortran::semantics {
 
@@ -100,6 +102,7 @@ private:
     }
   }
   bool IsResultOkToDiffer(const FunctionResult &);
+  void CheckBindCName(const Symbol &);
 
   SemanticsContext &context_;
   evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
@@ -112,6 +115,8 @@ private:
   // Cache of calls to Procedure::Characterize(Symbol)
   std::map<SymbolRef, std::optional<Procedure>, SymbolAddressCompare>
       characterizeCache_;
+  // Collection of symbols with BIND(C) names
+  std::map<std::string, SymbolRef> bindC_;
 };
 
 class DistinguishabilityHelper {
@@ -195,6 +200,7 @@ void CheckHelper::Check(const Symbol &symbol) {
   if (symbol.attrs().test(Attr::VOLATILE)) {
     CheckVolatile(symbol, derived);
   }
+  CheckBindCName(symbol);
   if (isDone) {
     return; // following checks do not apply
   }
@@ -1654,6 +1660,35 @@ void CheckHelper::CheckGenericOps(const Scope &scope) {
   helper.Check(scope);
 }
 
+static const std::string *DefinesBindCName(const Symbol &symbol) {
+  const auto *subp{symbol.detailsIf<SubprogramDetails>()};
+  if ((subp && !subp->isInterface()) || symbol.has<ObjectEntityDetails>()) {
+    // Symbol defines data or entry point
+    return symbol.GetBindName();
+  } else {
+    return nullptr;
+  }
+}
+
+// Check that BIND(C) names are distinct
+void CheckHelper::CheckBindCName(const Symbol &symbol) {
+  if (const std::string * name{DefinesBindCName(symbol)}) {
+    auto pair{bindC_.emplace(*name, symbol)};
+    if (!pair.second) {
+      const Symbol &other{*pair.first->second};
+      if (DefinesBindCName(other) && !context_.HasError(other)) {
+        if (auto *msg{messages_.Say(
+                "Two symbols have the same BIND(C) name '%s'"_err_en_US,
+                *name)}) {
+          msg->Attach(other.name(), "Conflicting symbol"_en_US);
+        }
+        context_.SetError(symbol);
+        context_.SetError(other);
+      }
+    }
+  }
+}
+
 void SubprogramMatchHelper::Check(
     const Symbol &symbol1, const Symbol &symbol2) {
   const auto details1{symbol1.get<SubprogramDetails>()};
diff --git a/flang/test/Semantics/bind-c01.f90 b/flang/test/Semantics/bind-c01.f90
new file mode 100644
index 000000000000..9afb04962d18
--- /dev/null
+++ b/flang/test/Semantics/bind-c01.f90
@@ -0,0 +1,25 @@
+! RUN: %S/test_errors.sh %s %t %f18
+! Check for multiple symbols being defined with with same BIND(C) name
+
+module m1
+  integer, bind(c, name="x1") :: x1
+  !ERROR: Two symbols have the same BIND(C) name 'x1'
+  integer, bind(c, name=" x1 ") :: x2
+ contains
+  !ERROR: Two symbols have the same BIND(C) name 'x3'
+  subroutine x3() bind(c, name="x3")
+  end subroutine
+end module
+
+subroutine x4() bind(c, name=" x3 ")
+end subroutine
+
+! Ensure no error in this situation
+module m2
+ interface
+  subroutine x5() bind(c, name=" x5 ")
+  end subroutine
+ end interface
+end module
+subroutine x5() bind(c, name=" x5 ")
+end subroutine