[flang] Avoid global name conflict when BIND(C,NAME=) is used

[klausler]

Summary

At the top level of program units in a source file, two subprograms
are allowed to have the same name if at least one of them has a
distinct interoperable binding name. F18's symbol table requires
(most) symbols in a scope to have distinct names, though. Solve
by using compiler-created names for the symbols of global scope
subprograms that have interoperable binding names.

[jeanPerier]

LGTM

flang/lib/Semantics/program-tree.h

public:
   const EntryStmtList &entryStmts() const { return entryStmts_; }
   const GenericSpecList &genericSpecs() const { return genericSpecs_; }
 
   Symbol::Flag GetSubpFlag() const;
   bool IsModule() const; // Module or Submodule
   bool HasModulePrefix() const; // in function or subroutine stmt
   Scope *scope() const { return scope_; }
   void set_scope(Scope &);
+  const parser::LanguageBindingSpec *bindingSpec() const {
+    return bindingSpec_;
+  }
+  ProgramTree &set_bindingSpec(const parser::LanguageBindingSpec *spec) {
+    bindingSpec_ = spec;
+    return *this;
+  }
   void AddChild(ProgramTree &&);
   void AddEntry(const parser::EntryStmt &);
   void AddGeneric(const parser::GenericSpec &);
 
   template <typename T>
   ProgramTree &set_stmt(const parser::Statement<T> &stmt) {
     stmt_ = &stmt;
     return *this;
private:
   const parser::SpecificationPart &spec_;
   const parser::ExecutionPart *exec_{nullptr};
   std::list<ProgramTree> children_;
   EntryStmtList entryStmts_;
   GenericSpecList genericSpecs_;
   Scope *scope_{nullptr};
   const parser::CharBlock *endStmt_{nullptr};
   bool isSpecificationPartResolved_{false};
+  const parser::LanguageBindingSpec *bindingSpec_{nullptr};
 };
 
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_PROGRAM_TREE_H_

flang/lib/Semantics/program-tree.cpp

auto result{stmt ? BuildSubprogramTree(stmt->statement.v, x).set_stmt(*stmt)
                    : BuildSubprogramTree(emptyName, x)};
   return result.set_endStmt(end);
 }
 
 ProgramTree ProgramTree::Build(const parser::FunctionSubprogram &x) {
   const auto &stmt{std::get<parser::Statement<parser::FunctionStmt>>(x.t)};
   const auto &end{std::get<parser::Statement<parser::EndFunctionStmt>>(x.t)};
   const auto &name{std::get<parser::Name>(stmt.statement.t)};
-  return BuildSubprogramTree(name, x).set_stmt(stmt).set_endStmt(end);
+  const parser::LanguageBindingSpec *bindingSpec{};
+  if (const auto &suffix{
+          std::get<std::optional<parser::Suffix>>(stmt.statement.t)}) {
+    if (suffix->binding) {
+      bindingSpec = &*suffix->binding;
+    }
+  }
+  return BuildSubprogramTree(name, x)
+      .set_stmt(stmt)
+      .set_endStmt(end)
+      .set_bindingSpec(bindingSpec);
 }
 
 ProgramTree ProgramTree::Build(const parser::SubroutineSubprogram &x) {
   const auto &stmt{std::get<parser::Statement<parser::SubroutineStmt>>(x.t)};
   const auto &end{std::get<parser::Statement<parser::EndSubroutineStmt>>(x.t)};
   const auto &name{std::get<parser::Name>(stmt.statement.t)};
-  return BuildSubprogramTree(name, x).set_stmt(stmt).set_endStmt(end);
+  const parser::LanguageBindingSpec *bindingSpec{};
+  if (const auto &binding{std::get<std::optional<parser::LanguageBindingSpec>>(
+          stmt.statement.t)}) {
+    bindingSpec = &*binding;
+  }
+  return BuildSubprogramTree(name, x)
+      .set_stmt(stmt)
+      .set_endStmt(end)
+      .set_bindingSpec(bindingSpec);
 }
 
 ProgramTree ProgramTree::Build(const parser::SeparateModuleSubprogram &x) {
   const auto &stmt{std::get<parser::Statement<parser::MpSubprogramStmt>>(x.t)};
   const auto &end{
       std::get<parser::Statement<parser::EndMpSubprogramStmt>>(x.t)};
   const auto &name{stmt.statement.v};
   return BuildSubprogramTree(name, x).set_stmt(stmt).set_endStmt(end);

flang/lib/Semantics/resolve-names.cpp

public:
   void Post(const parser::EntryStmt &);
   bool Pre(const parser::InterfaceBody::Subroutine &);
   void Post(const parser::InterfaceBody::Subroutine &);
   bool Pre(const parser::InterfaceBody::Function &);
   void Post(const parser::InterfaceBody::Function &);
   bool Pre(const parser::Suffix &);
   bool Pre(const parser::PrefixSpec &);
 
-  bool BeginSubprogram(
-      const parser::Name &, Symbol::Flag, bool hasModulePrefix = false);
+  bool BeginSubprogram(const parser::Name &, Symbol::Flag,
+      bool hasModulePrefix = false,
+      const parser::LanguageBindingSpec * = nullptr);
   bool BeginMpSubprogram(const parser::Name &);
   void PushBlockDataScope(const parser::Name &);
   void EndSubprogram();
 
 protected:
   // Set when we see a stmt function that is really an array element assignment
   bool badStmtFuncFound_{false};
 
 private:
   // Edits an existing symbol created for earlier calls to a subprogram or ENTRY
   // so that it can be replaced by a later definition.
   bool HandlePreviousCalls(const parser::Name &, Symbol &, Symbol::Flag);
   void CheckExtantProc(const parser::Name &, Symbol::Flag);
   // Create a subprogram symbol in the current scope and push a new scope.
-  Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag);
+  Symbol &PushSubprogramScope(const parser::Name &, Symbol::Flag,
+      const parser::LanguageBindingSpec * = nullptr);
   Symbol *GetSpecificFromGeneric(const parser::Name &);
   SubprogramDetails &PostSubprogramStmt(const parser::Name &);
 };
 
 class DeclarationVisitor : public ArraySpecVisitor,
                            public virtual ScopeHandler {
 public:
   using ArraySpecVisitor::Post;
void ScopeHandler::PushScope(Scope &scope) {
   // as we read 19.3.1(2), so we allow the name to be used as a local
   // identifier in the module or submodule too.  Same with programs
   // (14.1(3)) and BLOCK DATA.
   if (!currScope_->IsDerivedType() && kind != Scope::Kind::Module &&
       kind != Scope::Kind::MainProgram && kind != Scope::Kind::BlockData) {
     if (auto *symbol{scope.symbol()}) {
       // Create a dummy symbol so we can't create another one with the same
       // name. It might already be there if we previously pushed the scope.
-      if (!FindInScope(scope, symbol->name())) {
-        auto &newSymbol{MakeSymbol(symbol->name())};
+      SourceName name{symbol->name()};
+      if (!FindInScope(scope, name)) {
+        auto &newSymbol{MakeSymbol(name)};
         if (kind == Scope::Kind::Subprogram) {
           // Allow for recursive references.  If this symbol is a function
           // without an explicit RESULT(), this new symbol will be discarded
           // and replaced with an object of the same name.
           newSymbol.set_details(HostAssocDetails{*symbol});
         } else {
           newSymbol.set_details(MiscDetails{MiscDetails::Kind::ScopeName});
         }
       }
     }
   }
 }
 void ScopeHandler::PopScope() {
   // Entities that are not yet classified as objects or procedures are now
   // assumed to be objects.
   // TODO: Statement functions
   for (auto &pair : currScope()) {
     ConvertToObjectEntity(*pair.second);
   }
-  SetScope(currScope_->parent());
+  // If popping back into a global scope, pop back to the main global scope.
+  SetScope(currScope_->parent().IsGlobal() ? context().globalScope()
+                                           : currScope_->parent());
 }
 void ScopeHandler::SetScope(Scope &scope) {
   currScope_ = &scope;
   ImplicitRulesVisitor::SetScope(InclusiveScope());
 }
 
 Symbol *ScopeHandler::FindSymbol(const parser::Name &name) {
   return FindSymbol(currScope(), name);
void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
   // Clear the RESULT() name now in case an ENTRY statement in the implicit-part
   // has a RESULT() suffix.
   info.resultName = nullptr;
 }
 
 SubprogramDetails &SubprogramVisitor::PostSubprogramStmt(
     const parser::Name &name) {
   Symbol &symbol{*currScope().symbol()};
-  CHECK(name.source == symbol.name());
+  auto &subp{symbol.get<SubprogramDetails>()};
   SetBindNameOn(symbol);
+  CHECK(name.source == symbol.name() ||
+      (subp.bindName() && symbol.owner().IsGlobal() &&
+          context().IsTempName(symbol.name().ToString())));
   symbol.attrs() |= EndAttrs();
   if (symbol.attrs().test(Attr::MODULE)) {
     symbol.attrs().set(Attr::EXTERNAL, false);
   }
   return symbol.get<SubprogramDetails>();
 }
 
 void SubprogramVisitor::Post(const parser::EntryStmt &stmt) {
if (details.isFunction()) {
       newDetails.set_result(*currScope().CopySymbol(details.result()));
       funcResultStack().Push(); // just to be popped later
     }
   }
   return true;
 }
 
 // A subprogram or interface declared with SUBROUTINE or FUNCTION
-bool SubprogramVisitor::BeginSubprogram(
-    const parser::Name &name, Symbol::Flag subpFlag, bool hasModulePrefix) {
+bool SubprogramVisitor::BeginSubprogram(const parser::Name &name,
+    Symbol::Flag subpFlag, bool hasModulePrefix,
+    const parser::LanguageBindingSpec *bindingSpec) {
   if (hasModulePrefix && currScope().IsGlobal()) { // C1547
     Say(name,
         "'%s' is a MODULE procedure which must be declared within a "
         "MODULE or SUBMODULE"_err_en_US);
     return false;
   }
   Symbol *moduleInterface{nullptr};
   if (hasModulePrefix && !inInterfaceBlock()) {
if (!moduleInterface) {
       moduleInterface = FindSymbol(currScope().parent(), name);
       if (!IsSeparateModuleProcedureInterface(moduleInterface)) {
         Say(name,
             "'%s' was not declared a separate module procedure"_err_en_US);
         return false;
       }
     }
   }
-  Symbol &newSymbol{PushSubprogramScope(name, subpFlag)};
+  Symbol &newSymbol{PushSubprogramScope(name, subpFlag, bindingSpec)};
   if (moduleInterface) {
     newSymbol.get<SubprogramDetails>().set_moduleInterface(*moduleInterface);
     if (moduleInterface->attrs().test(Attr::PRIVATE)) {
       newSymbol.attrs().set(Attr::PRIVATE);
     } else if (moduleInterface->attrs().test(Attr::PUBLIC)) {
       newSymbol.attrs().set(Attr::PUBLIC);
     }
   }
if (IsDummy(*prev)) {
       // Procedures in an INTERFACE block do not resolve to symbols
       // in scopes between the global scope and the current scope.
     } else if (!HandlePreviousCalls(name, *prev, subpFlag)) {
       SayAlreadyDeclared(name, *prev);
     }
   }
 }
 
-Symbol &SubprogramVisitor::PushSubprogramScope(
-    const parser::Name &name, Symbol::Flag subpFlag) {
-  auto *symbol{GetSpecificFromGeneric(name)};
+Symbol &SubprogramVisitor::PushSubprogramScope(const parser::Name &name,
+    Symbol::Flag subpFlag, const parser::LanguageBindingSpec *bindingSpec) {
+  Symbol *symbol{GetSpecificFromGeneric(name)};
   if (!symbol) {
+    if (bindingSpec && currScope().IsGlobal() && bindingSpec->v) {
+      // Create this new top-level subprogram with a binding label
+      // in a new global scope, so that its symbol's name won't clash
+      // with another symbol that has a distinct binding label.
+      PushScope(Scope::Kind::Global,
+          &MakeSymbol(context().GetTempName(currScope()), Attrs{},
+              MiscDetails{MiscDetails::Kind::ScopeName}));
+    }
     CheckExtantProc(name, subpFlag);
     symbol = &MakeSymbol(name, SubprogramDetails{});
   }
-  symbol->set(subpFlag);
   symbol->ReplaceName(name.source);
+  symbol->set(subpFlag);
   PushScope(Scope::Kind::Subprogram, symbol);
   auto &details{symbol->get<SubprogramDetails>()};
   if (inInterfaceBlock()) {
     details.set_isInterface();
     if (isAbstract()) {
       symbol->attrs().set(Attr::ABSTRACT);
     } else {
       MakeExternal(*symbol);
bool ResolveNamesVisitor::BeginScopeForNode(const ProgramTree &node) {
   switch (node.GetKind()) {
     SWITCH_COVERS_ALL_CASES
   case ProgramTree::Kind::Program:
     PushScope(Scope::Kind::MainProgram,
         &MakeSymbol(node.name(), MainProgramDetails{}));
     return true;
   case ProgramTree::Kind::Function:
   case ProgramTree::Kind::Subroutine:
-    return BeginSubprogram(
-        node.name(), node.GetSubpFlag(), node.HasModulePrefix());
+    return BeginSubprogram(node.name(), node.GetSubpFlag(),
+        node.HasModulePrefix(), node.bindingSpec());
   case ProgramTree::Kind::MpSubprogram:
     return BeginMpSubprogram(node.name());
   case ProgramTree::Kind::Module:
     BeginModule(node.name(), false);
     return true;
   case ProgramTree::Kind::Submodule:
     return BeginSubmodule(node.name(), node.GetParentId());
   case ProgramTree::Kind::BlockData:

flang/test/Semantics/bind-c01.f90

 ! RUN: %python %S/test_errors.py %s %flang_fc1
 ! 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
 
+!ERROR: Two symbols have the same BIND(C) name 'x3'
 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
+
+! Ensure no error in this situation
+subroutine foo() bind(c, name="x6")
+end subroutine
+subroutine foo() bind(c, name="x7")
+end subroutine