[flang] Prevent IR name clashes between BIND(C) and external procedures

[jeanPerier]

Defining a procedure with a BIND(C, NAME="...") where the binding label matches the assembly name of a non BIND(C) external procedure in the same file causes a failure when generating the LLVM IR because of the assembly symbol name clash.

Prevent this crash with a clearer semantic error.

[llvmbot]

@llvm/pr-subscribers-flang-semantics

@llvm/pr-subscribers-flang-fir-hlfir

Changes

Defining a procedure with a BIND(C, NAME="...") where the binding label matches the assembly name of a non BIND(C) external procedure in the same file causes a failure when generating the LLVM IR because of the assembly symbol name clash.

Prevent this crash with a clearer semantic error.

---

Full diff: https://github.com/llvm/llvm-project/pull/66777.diff

4 Files Affected:

• (modified) flang/include/flang/Common/Fortran.h (+7)
• (modified) flang/lib/Optimizer/Transforms/ExternalNameConversion.cpp (+2-5)
• (modified) flang/lib/Semantics/check-declarations.cpp (+42)
• (added) flang/test/Semantics/bind-c14.f90 (+9)

diff --git a/flang/include/flang/Common/Fortran.h b/flang/include/flang/Common/Fortran.h
index 15db21bf3473c05..4007bfc7994f988 100644
--- a/flang/include/flang/Common/Fortran.h
+++ b/flang/include/flang/Common/Fortran.h
@@ -114,5 +114,12 @@ bool AreCompatibleCUDADataAttrs(
 
 static constexpr char blankCommonObjectName[] = "__BLNK__";
 
+// Get the assembly name for a non BIND(C) external symbol other than the blank
+// common block.
+inline std::string GetExternalAssemblyName(
+    std::string symbolName, bool underscoring) {
+  return underscoring ? std::move(symbolName) + "_" : std::move(symbolName);
+}
+
 } // namespace Fortran::common
 #endif // FORTRAN_COMMON_FORTRAN_H_
diff --git a/flang/lib/Optimizer/Transforms/ExternalNameConversion.cpp b/flang/lib/Optimizer/Transforms/ExternalNameConversion.cpp
index 64791d673dacd36..e967a8f19d53af3 100644
--- a/flang/lib/Optimizer/Transforms/ExternalNameConversion.cpp
+++ b/flang/lib/Optimizer/Transforms/ExternalNameConversion.cpp
@@ -38,11 +38,8 @@ mangleExternalName(const std::pair<fir::NameUniquer::NameKind,
   if (result.first == fir::NameUniquer::NameKind::COMMON &&
       result.second.name.empty())
     return Fortran::common::blankCommonObjectName;
-
-  if (appendUnderscore)
-    return result.second.name + "_";
-
-  return result.second.name;
+  return Fortran::common::GetExternalAssemblyName(result.second.name,
+                                                  appendUnderscore);
 }
 
 /// Update the early outlining parent name
diff --git a/flang/lib/Semantics/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 14f34666056e8e5..2c2866d590ae5a4 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -130,6 +130,7 @@ class CheckHelper {
   }
   bool IsResultOkToDiffer(const FunctionResult &);
   void CheckGlobalName(const Symbol &);
+  void CheckProcedureAssemblyName(const Symbol &symbol);
   void CheckExplicitSave(const Symbol &);
   void CheckBindC(const Symbol &);
   void CheckBindCFunctionResult(const Symbol &);
@@ -178,6 +179,9 @@ class CheckHelper {
   std::map<std::string, SymbolRef> globalNames_;
   // Collection of external procedures without global definitions
   std::map<std::string, SymbolRef> externalNames_;
+  // Collection of target dependent assembly names of external and BIND(C)
+  // procedures.
+  std::map<std::string, SymbolRef> procedureAssemblyNames_;
 };
 
 class DistinguishabilityHelper {
@@ -277,6 +281,7 @@ void CheckHelper::Check(const Symbol &symbol) {
     CheckContiguous(symbol);
   }
   CheckGlobalName(symbol);
+  CheckProcedureAssemblyName(symbol);
   if (symbol.attrs().test(Attr::ASYNCHRONOUS) &&
       !evaluate::IsVariable(symbol)) {
     messages_.Say(
@@ -2623,6 +2628,43 @@ void CheckHelper::CheckGlobalName(const Symbol &symbol) {
   }
 }
 
+void CheckHelper::CheckProcedureAssemblyName(const Symbol &symbol) {
+  if (!IsProcedure(symbol) || symbol != symbol.GetUltimate())
+    return;
+  const std::string *bindName{symbol.GetBindName()};
+  const bool hasExplicitBindingLabel{
+      symbol.GetIsExplicitBindName() && bindName};
+  if (hasExplicitBindingLabel || IsExternal(symbol)) {
+    const std::string assemblyName{hasExplicitBindingLabel
+            ? *bindName
+            : common::GetExternalAssemblyName(
+                  symbol.name().ToString(), context_.underscoring())};
+    auto pair{procedureAssemblyNames_.emplace(std::move(assemblyName), symbol)};
+    if (!pair.second) {
+      const Symbol &other{*pair.first->second};
+      const bool otherHasExplicitBindingLabel{
+          other.GetIsExplicitBindName() && other.GetBindName()};
+      if (otherHasExplicitBindingLabel != hasExplicitBindingLabel) {
+        // The BIND(C,NAME="...") binding label is the same as the name that
+        // will be used in LLVM IR for an external procedure declared without
+        // BIND(C) in the same file. While this is not forbidden by the
+        // standard, this name collision would lead to a crash when producing
+        // the IR.
+        if (auto *msg{messages_.Say(symbol.name(),
+                "%s procedure assembly name conflicts with %s procedure assembly name"_err_en_US,
+                hasExplicitBindingLabel ? "BIND(C)" : "Non BIND(C)",
+                hasExplicitBindingLabel ? "non BIND(C)" : "BIND(C)")}) {
+          msg->Attach(other.name(), "Conflicting declaration"_en_US);
+        }
+        context_.SetError(symbol);
+        context_.SetError(other);
+      }
+      // Otherwise, the global names also match and the conflict is analyzed
+      // by CheckGlobalName.
+    }
+  }
+}
+
 void CheckHelper::CheckBindC(const Symbol &symbol) {
   bool isExplicitBindC{symbol.attrs().test(Attr::BIND_C)};
   if (isExplicitBindC) {
diff --git a/flang/test/Semantics/bind-c14.f90 b/flang/test/Semantics/bind-c14.f90
new file mode 100644
index 000000000000000..03660858ce38dad
--- /dev/null
+++ b/flang/test/Semantics/bind-c14.f90
@@ -0,0 +1,9 @@
+! RUN: %python %S/test_errors.py %s %flang_fc1 -funderscoring
+
+subroutine conflict()
+end subroutine
+
+!ERROR: BIND(C) procedure assembly name conflicts with non BIND(C) procedure assembly name
+subroutine foo(x)  bind(c, name="conflict_")
+  real :: x
+end subroutine