[flang] Use BIND name, if any, when consolidating common blocks (#65613)

This patch changes how common blocks are aggregated and named in
lowering in order to:

* fix one obvious issue where BIND(C) and non BIND(C) with the same
Fortran name were "merged"

* go further and deal with a derivative where the BIND(C) C name matches
the assembly name of a Fortran common block. This is a bit unspecified
IMHO, but gfortran, ifort, and nvfortran "merge" the common block
without complaints as a linker would have done. This required getting
rid of all the common block mangling early in FIR (\_QC) instead of
leaving that to the phase that emits LLVM from FIR because BIND(C)
common blocks did not have mangled names. Care has to be taken to deal
with the underscoring option of flang-new.

See added flang/test/Lower/HLFIR/common-block-bindc-conflicts.f90 for an
illustration.

6 files changed, 38 insertions, 13 deletions

diff --git a/flang/lib/Frontend/CompilerInvocation.cpp b/flang/lib/Frontend/CompilerInvocation.cpp
index 81bf89b..dba2ac1 100644
--- a/flang/lib/Frontend/CompilerInvocation.cpp
+++ b/flang/lib/Frontend/CompilerInvocation.cpp
@@ -1237,7 +1237,8 @@ void CompilerInvocation::setSemanticsOpts(
       .set_searchDirectories(fortranOptions.searchDirectories)
       .set_intrinsicModuleDirectories(fortranOptions.intrinsicModuleDirectories)
       .set_warningsAreErrors(getWarnAsErr())
-      .set_moduleFileSuffix(getModuleFileSuffix());
+      .set_moduleFileSuffix(getModuleFileSuffix())
+      .set_underscoring(getCodeGenOpts().Underscoring);
 
   llvm::Triple targetTriple{llvm::Triple(this->targetOpts.triple)};
   // FIXME: Handle real(3) ?
@@ -1262,6 +1263,7 @@ void CompilerInvocation::setLoweringOptions() {
 
   // Lower TRANSPOSE as a runtime call under -O0.
   loweringOpts.setOptimizeTranspose(codegenOpts.OptimizationLevel > 0);
+  loweringOpts.setUnderscoring(codegenOpts.Underscoring);
 
   const LangOptions &langOptions = getLangOpts();
   Fortran::common::MathOptionsBase &mathOpts = loweringOpts.getMathOptions();
diff --git a/flang/lib/Lower/Bridge.cpp b/flang/lib/Lower/Bridge.cpp
index 6e896c7..75784f4 100644
--- a/flang/lib/Lower/Bridge.cpp
+++ b/flang/lib/Lower/Bridge.cpp
@@ -836,7 +836,9 @@ public:
   }
   std::string
   mangleName(const Fortran::semantics::Symbol &symbol) override final {
-    return Fortran::lower::mangle::mangleName(symbol, scopeBlockIdMap);
+    return Fortran::lower::mangle::mangleName(
+        symbol, scopeBlockIdMap, /*keepExternalInScope=*/false,
+        getLoweringOptions().getUnderscoring());
   }
   std::string mangleName(
       const Fortran::semantics::DerivedTypeSpec &derivedType) override final {
diff --git a/flang/lib/Lower/Mangler.cpp b/flang/lib/Lower/Mangler.cpp
index 4ea6238..8e94ccf 100644
--- a/flang/lib/Lower/Mangler.cpp
+++ b/flang/lib/Lower/Mangler.cpp
@@ -83,10 +83,9 @@ Fortran::lower::mangle::mangleName(std::string &name,
 }
 
 // Mangle the name of \p symbol to make it globally unique.
-std::string
-Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol,
-                                   ScopeBlockIdMap &scopeBlockIdMap,
-                                   bool keepExternalInScope) {
+std::string Fortran::lower::mangle::mangleName(
+    const Fortran::semantics::Symbol &symbol, ScopeBlockIdMap &scopeBlockIdMap,
+    bool keepExternalInScope, bool underscoring) {
   // Resolve module and host associations before mangling.
   const auto &ultimateSymbol = symbol.GetUltimate();
 
@@ -167,11 +166,12 @@ Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol,
                                                      symbolName);
           },
           [&](const Fortran::semantics::CommonBlockDetails &) {
-            return fir::NameUniquer::doCommonBlock(symbolName);
+            return Fortran::semantics::GetCommonBlockObjectName(ultimateSymbol,
+                                                                underscoring);
           },
           [&](const Fortran::semantics::ProcBindingDetails &procBinding) {
             return mangleName(procBinding.symbol(), scopeBlockIdMap,
-                              keepExternalInScope);
+                              keepExternalInScope, underscoring);
           },
           [&](const Fortran::semantics::DerivedTypeDetails &) -> std::string {
             // Derived type mangling must use mangleName(DerivedTypeSpec) so
@@ -186,13 +186,14 @@ Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol,
 
 std::string
 Fortran::lower::mangle::mangleName(const Fortran::semantics::Symbol &symbol,
-                                   bool keepExternalInScope) {
+                                   bool keepExternalInScope,
+                                   bool underscoring) {
   assert((symbol.owner().kind() !=
               Fortran::semantics::Scope::Kind::BlockConstruct ||
           symbol.has<Fortran::semantics::SubprogramDetails>()) &&
          "block object mangling must specify a scopeBlockIdMap");
   ScopeBlockIdMap scopeBlockIdMap;
-  return mangleName(symbol, scopeBlockIdMap, keepExternalInScope);
+  return mangleName(symbol, scopeBlockIdMap, keepExternalInScope, underscoring);
 }
 
 std::string Fortran::lower::mangle::mangleName(
diff --git a/flang/lib/Optimizer/Transforms/ExternalNameConversion.cpp b/flang/lib/Optimizer/Transforms/ExternalNameConversion.cpp
index 6775676..64791d6 100644
--- a/flang/lib/Optimizer/Transforms/ExternalNameConversion.cpp
+++ b/flang/lib/Optimizer/Transforms/ExternalNameConversion.cpp
@@ -6,6 +6,7 @@
 //
 //===----------------------------------------------------------------------===//
 
+#include "flang/Common/Fortran.h"
 #include "flang/Optimizer/Dialect/FIRDialect.h"
 #include "flang/Optimizer/Dialect/FIROps.h"
 #include "flang/Optimizer/Support/InternalNames.h"
@@ -36,7 +37,7 @@ mangleExternalName(const std::pair<fir::NameUniquer::NameKind,
                    bool appendUnderscore) {
   if (result.first == fir::NameUniquer::NameKind::COMMON &&
       result.second.name.empty())
-    return "__BLNK__";
+    return Fortran::common::blankCommonObjectName;
 
   if (appendUnderscore)
     return result.second.name + "_";
diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp
index 1121be4..7176deb 100644
--- a/flang/lib/Semantics/semantics.cpp
+++ b/flang/lib/Semantics/semantics.cpp
@@ -212,7 +212,14 @@ public:
   void MapCommonBlockAndCheckConflicts(
       SemanticsContext &context, const Symbol &common) {
     const Symbol *isInitialized{CommonBlockIsInitialized(common)};
-    auto [it, firstAppearance] = commonBlocks_.insert({common.name(),
+    // Merge common according to the name they will have in the object files.
+    // This allows merging BIND(C) and non BIND(C) common block instead of
+    // later crashing. This "merge" matches what ifort/gfortran/nvfortran are
+    // doing and what a linker would do if the definition were in distinct
+    // files.
+    std::string commonName{
+        GetCommonBlockObjectName(common, context.underscoring())};
+    auto [it, firstAppearance] = commonBlocks_.insert({commonName,
         isInitialized ? CommonBlockInfo{common, common}
                       : CommonBlockInfo{common, std::nullopt}});
     if (!firstAppearance) {
@@ -291,7 +298,8 @@ private:
     }
     return nullptr;
   }
-  std::map<SourceName, CommonBlockInfo> commonBlocks_;
+
+  std::map<std::string, CommonBlockInfo> commonBlocks_;
 };
 
 SemanticsContext::SemanticsContext(
diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp
index 7c52397..54047f9 100644
--- a/flang/lib/Semantics/tools.cpp
+++ b/flang/lib/Semantics/tools.cpp
@@ -1655,4 +1655,15 @@ std::string GetModuleOrSubmoduleName(const Symbol &symbol) {
   return result;
 }
 
+std::string GetCommonBlockObjectName(const Symbol &common, bool underscoring) {
+  if (const std::string * bind{common.GetBindName()}) {
+    return *bind;
+  }
+  if (common.name().empty()) {
+    return Fortran::common::blankCommonObjectName;
+  }
+  return underscoring ? common.name().ToString() + "_"s
+                      : common.name().ToString();
+}
+
 } // namespace Fortran::semantics