[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.

Author: jeanPerier

flang/include/flang/Common/Fortran.h

@@ -109,5 +109,7 @@ std::string AsFortran(IgnoreTKRSet);
 bool AreCompatibleCUDADataAttrs(
     std::optional<CUDADataAttr>, std::optional<CUDADataAttr>, IgnoreTKRSet);
 
+static constexpr char blankCommonObjectName[] = "__BLNK__";
+
 } // namespace Fortran::common
 #endif // FORTRAN_COMMON_FORTRAN_H_

flang/include/flang/Lower/LoweringOptions.def

@@ -34,5 +34,8 @@ ENUM_LOWERINGOPT(LowerToHighLevelFIR, unsigned, 1, 0)
 /// If true, reverse PowerPC native vector element order.
 ENUM_LOWERINGOPT(NoPPCNativeVecElemOrder, unsigned, 1, 0)
 
+/// If true, assume external names will be suffixed with an underscore. On by default.
+ENUM_LOWERINGOPT(Underscoring, unsigned, 1, 1)
+
 #undef LOWERINGOPT
 #undef ENUM_LOWERINGOPT

flang/include/flang/Lower/Mangler.h

@@ -43,9 +43,11 @@ using ScopeBlockIdMap =
 /// a symbol where all the Fortran context is needed. Otherwise, external
 /// symbols are mangled outside of any scope.
 std::string mangleName(const semantics::Symbol &, ScopeBlockIdMap &,
-                       bool keepExternalInScope = false);
+                       bool keepExternalInScope = false,
+                       bool underscoring = true);
 std::string mangleName(const semantics::Symbol &,
-                       bool keepExternalInScope = false);
+                       bool keepExternalInScope = false,
+                       bool underscoring = true);
 
 /// Convert a derived type instance to an internal name.
 std::string mangleName(const semantics::DerivedTypeSpec &, ScopeBlockIdMap &);

flang/include/flang/Semantics/semantics.h

@@ -93,6 +93,7 @@ class SemanticsContext {
   }
   const std::string &moduleDirectory() const { return moduleDirectory_; }
   const std::string &moduleFileSuffix() const { return moduleFileSuffix_; }
+  bool underscoring() const { return underscoring_; }
   bool warningsAreErrors() const { return warningsAreErrors_; }
   bool debugModuleWriter() const { return debugModuleWriter_; }
   const evaluate::IntrinsicProcTable &intrinsics() const { return intrinsics_; }
@@ -130,6 +131,10 @@ class SemanticsContext {
     moduleFileSuffix_ = x;
     return *this;
   }
+  SemanticsContext &set_underscoring(bool x) {
+    underscoring_ = x;
+    return *this;
+  }
   SemanticsContext &set_warnOnNonstandardUsage(bool x) {
     warnOnNonstandardUsage_ = x;
     return *this;
@@ -262,6 +267,7 @@ class SemanticsContext {
   std::vector<std::string> intrinsicModuleDirectories_;
   std::string moduleDirectory_{"."s};
   std::string moduleFileSuffix_{".mod"};
+  bool underscoring_{true};
   bool warnOnNonstandardUsage_{false};
   bool warningsAreErrors_{false};
   bool debugModuleWriter_{false};

flang/include/flang/Semantics/tools.h

@@ -683,5 +683,8 @@ std::optional<R> GetConstExpr(
 // Returns "m" for a module, "m:sm" for a submodule.
 std::string GetModuleOrSubmoduleName(const Symbol &);
 
+// Return the assembly name emitted for a common block.
+std::string GetCommonBlockObjectName(const Symbol &, bool underscoring);
+
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_TOOLS_H_

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();

flang/lib/Lower/Bridge.cpp

@@ -836,7 +836,9 @@ class FirConverter : public Fortran::lower::AbstractConverter {
   }
   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 {

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(

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 + "_";

flang/lib/Semantics/semantics.cpp

@@ -212,7 +212,14 @@ class CommonBlockMap {
   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 @@ class CommonBlockMap {
     }
     return nullptr;
   }
-  std::map<SourceName, CommonBlockInfo> commonBlocks_;
+
+  std::map<std::string, CommonBlockInfo> commonBlocks_;
 };
 
 SemanticsContext::SemanticsContext(