[flang] Check for conflicting BIND(C) names

[klausler]

Summary

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

[jeanPerier]

LGTM

flang/lib/Semantics/check-declarations.cpp

 #include "flang/Evaluate/fold.h"
 #include "flang/Evaluate/tools.h"
 #include "flang/Semantics/scope.h"
 #include "flang/Semantics/semantics.h"
 #include "flang/Semantics/symbol.h"
 #include "flang/Semantics/tools.h"
 #include "flang/Semantics/type.h"
 #include <algorithm>
+#include <map>
+#include <string>
 
 namespace Fortran::semantics {
 
 namespace characteristics = evaluate::characteristics;
 using characteristics::DummyArgument;
 using characteristics::DummyDataObject;
 using characteristics::DummyProcedure;
 using characteristics::FunctionResult;
private:
   void SayWithDeclaration(const Symbol &symbol, A &&...x) {
     if (parser::Message * msg{messages_.Say(std::forward<A>(x)...)}) {
       if (messages_.at().begin() != symbol.name().begin()) {
         evaluate::AttachDeclaration(*msg, symbol);
       }
     }
   }
   bool IsResultOkToDiffer(const FunctionResult &);
+  void CheckBindCName(const Symbol &);
 
   SemanticsContext &context_;
   evaluate::FoldingContext &foldingContext_{context_.foldingContext()};
   parser::ContextualMessages &messages_{foldingContext_.messages()};
   const Scope *scope_{nullptr};
   bool scopeIsUninstantiatedPDT_{false};
   // This symbol is the one attached to the innermost enclosing scope
   // that has a symbol.
   const Symbol *innermostSymbol_{nullptr};
   // 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 {
 public:
   DistinguishabilityHelper(SemanticsContext &context) : context_{context} {}
   void Add(const Symbol &, GenericKind, const Symbol &, const Procedure &);
   void Check(const Scope &);
 
std::visit(
           [&](const DerivedTypeDetails &x) { CheckDerivedType(symbol, x); },
           [&](const GenericDetails &x) { CheckGeneric(symbol, x); },
           [](const auto &) {},
       },
       symbol.details());
   if (symbol.attrs().test(Attr::VOLATILE)) {
     CheckVolatile(symbol, derived);
   }
+  CheckBindCName(symbol);
   if (isDone) {
     return; // following checks do not apply
   }
   if (IsPointer(symbol)) {
     CheckPointer(symbol);
   }
   if (InPure()) {
     if (IsSaved(symbol)) {
if (ultimate.has<DerivedTypeDetails>()) {
           addSpecifics(*pair2.second);
         }
       }
     }
   }
   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>()};
   const auto details2{symbol2.get<SubprogramDetails>()};
   if (details1.isFunction() != details2.isFunction()) {
     Say(symbol1, symbol2,
         details1.isFunction()
             ? "Module function '%s' was declared as a subroutine in the"

flang/test/Semantics/bind-c01.f90

+! 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