[flang] Process subprogram BIND(C,NAME=...) locally

[klausler]

Summary

The scalar-default-character-expression that defines the interoperable
name of a function or subroutine (or interface) must have its names
resolved within the context of the subprogram, despite its appearance
on a function-stmt or a subroutine-stmt. Failure to do so can lead
to bogus errors or to incorrect results.

The solution is to defer name resolution for function-stmt suffixes
(but not entry-stmt suffixes) and for subroutine-stmt language binding
specifications to EndSubprogram(). (Their resolution only need to be
deferred to the end of the specification part, but it's cleanest to
deal with it in EndSubprogram().)

[klausler]

Tweak code to work in the absence of an earlier change on which this one used to depend.

flang/lib/Semantics/resolve-names.cpp

private:
   void AddSpecificProcs(const std::list<parser::Name> &, ProcedureKind);
   void ResolveSpecificsInGeneric(Symbol &generic);
 };
 
 class SubprogramVisitor : public virtual ScopeHandler, public InterfaceVisitor {
 public:
   bool HandleStmtFunction(const parser::StmtFunctionStmt &);
   bool Pre(const parser::SubroutineStmt &);
-  void Post(const parser::SubroutineStmt &);
   bool Pre(const parser::FunctionStmt &);
   void Post(const parser::FunctionStmt &);
   bool Pre(const parser::EntryStmt &);
   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,
       const parser::LanguageBindingSpec * = nullptr,
       const ProgramTree::EntryStmtList * = nullptr);
   bool BeginMpSubprogram(const parser::Name &);
   void PushBlockDataScope(const parser::Name &);
-  void EndSubprogram();
+  void EndSubprogram(
+      const std::optional<parser::LanguageBindingSpec> * = nullptr);
 
 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.
if (suffix.resultName) {
     } else {
       Message &msg{Say(*suffix.resultName,
           "RESULT(%s) may appear only in a function"_err_en_US)};
       if (const Symbol * subprogram{InclusiveScope().symbol()}) {
         msg.Attach(subprogram->name(), "Containing subprogram"_en_US);
       }
     }
   }
-  return true;
+  // LanguageBindingSpec deferred to Post(EntryStmt) or, for FunctionStmt,
+  // all the way to EndSubprogram().
+  return false;
 }
 
 bool SubprogramVisitor::Pre(const parser::PrefixSpec &x) {
   // Save this to process after UseStmt and ImplicitPart
   if (const auto *parsedType{std::get_if<parser::DeclarationTypeSpec>(&x.u)}) {
     FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())};
     if (info.parsedType) { // C1543
       Say(currStmtSource().value(),
bool SubprogramVisitor::Pre(const parser::PrefixSpec &x) {
   }
 }
 
 bool SubprogramVisitor::Pre(const parser::InterfaceBody::Subroutine &x) {
   const auto &name{std::get<parser::Name>(
       std::get<parser::Statement<parser::SubroutineStmt>>(x.t).statement.t)};
   return BeginSubprogram(name, Symbol::Flag::Subroutine);
 }
-void SubprogramVisitor::Post(const parser::InterfaceBody::Subroutine &) {
-  EndSubprogram();
+void SubprogramVisitor::Post(const parser::InterfaceBody::Subroutine &x) {
+  EndSubprogram(&std::get<std::optional<parser::LanguageBindingSpec>>(
+      std::get<parser::Statement<parser::SubroutineStmt>>(x.t).statement.t));
 }
 bool SubprogramVisitor::Pre(const parser::InterfaceBody::Function &x) {
   const auto &name{std::get<parser::Name>(
       std::get<parser::Statement<parser::FunctionStmt>>(x.t).statement.t)};
   return BeginSubprogram(name, Symbol::Flag::Function);
 }
-void SubprogramVisitor::Post(const parser::InterfaceBody::Function &) {
-  EndSubprogram();
-}
-
-bool SubprogramVisitor::Pre(const parser::SubroutineStmt &) {
-  return BeginAttrs();
-}
-bool SubprogramVisitor::Pre(const parser::FunctionStmt &) {
-  FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())};
-  CHECK(!info.inFunctionStmt);
-  info.inFunctionStmt = true;
-  return BeginAttrs();
+void SubprogramVisitor::Post(const parser::InterfaceBody::Function &x) {
+  const auto &maybeSuffix{std::get<std::optional<parser::Suffix>>(
+      std::get<parser::Statement<parser::FunctionStmt>>(x.t).statement.t)};
+  EndSubprogram(maybeSuffix ? &maybeSuffix->binding : nullptr);
 }
-bool SubprogramVisitor::Pre(const parser::EntryStmt &) { return BeginAttrs(); }
 
-void SubprogramVisitor::Post(const parser::SubroutineStmt &stmt) {
+bool SubprogramVisitor::Pre(const parser::SubroutineStmt &stmt) {
+  BeginAttrs();
+  Walk(std::get<std::list<parser::PrefixSpec>>(stmt.t));
+  Walk(std::get<parser::Name>(stmt.t));
+  Walk(std::get<std::list<parser::DummyArg>>(stmt.t));
+  // Don't traverse the LanguageBindingSpec now; it's deferred to EndSubprogram.
   const auto &name{std::get<parser::Name>(stmt.t)};
   auto &details{PostSubprogramStmt(name)};
   for (const auto &dummyArg : std::get<std::list<parser::DummyArg>>(stmt.t)) {
     if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
       Symbol &dummy{MakeSymbol(*dummyName, EntityDetails{true})};
       details.add_dummyArg(dummy);
     } else {
       details.add_alternateReturn();
     }
   }
+  return false;
 }
+bool SubprogramVisitor::Pre(const parser::FunctionStmt &) {
+  FuncResultStack::FuncInfo &info{DEREF(funcResultStack().Top())};
+  CHECK(!info.inFunctionStmt);
+  info.inFunctionStmt = true;
+  return BeginAttrs();
+}
+bool SubprogramVisitor::Pre(const parser::EntryStmt &) { return BeginAttrs(); }
 
 void SubprogramVisitor::Post(const parser::FunctionStmt &stmt) {
   const auto &name{std::get<parser::Name>(stmt.t)};
   auto &details{PostSubprogramStmt(name)};
   for (const auto &dummyName : std::get<std::list<parser::Name>>(stmt.t)) {
     Symbol &dummy{MakeSymbol(dummyName, EntityDetails{true})};
     details.add_dummyArg(dummy);
   }
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()};
-  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 (const auto &suffix{std::get<std::optional<parser::Suffix>>(stmt.t)}) {
+    Walk(suffix->binding);
+  }
   PostEntryStmt(stmt);
   EndAttrs();
 }
 
 void SubprogramVisitor::CreateEntry(
     const parser::EntryStmt &stmt, Symbol &subprogram) {
   const auto &entryName{std::get<parser::Name>(stmt.t)};
   Scope &outer{currScope().parent()};
bool SubprogramVisitor::BeginSubprogram(const parser::Name &name,
   if (entryStmts) {
     for (const auto &ref : *entryStmts) {
       CreateEntry(*ref, newSymbol);
     }
   }
   return true;
 }
 
-void SubprogramVisitor::EndSubprogram() { PopScope(); }
+void SubprogramVisitor::EndSubprogram(
+    const std::optional<parser::LanguageBindingSpec> *binding) {
+  if (binding && *binding && currScope().symbol()) {
+    // Finally process the BIND(C,NAME=name) now that symbols in the name
+    // expression will resolve local names.
+    auto flagRestorer{common::ScopedSet(inSpecificationPart_, false)};
+    BeginAttrs();
+    Walk(**binding);
+    SetBindNameOn(*currScope().symbol());
+    currScope().symbol()->attrs() |= EndAttrs();
+  }
+  PopScope();
+}
 
 bool SubprogramVisitor::HandlePreviousCalls(
     const parser::Name &name, Symbol &symbol, Symbol::Flag subpFlag) {
   // If the extant symbol is a generic, check its homonymous specific
   // procedure instead if it has one.
   if (auto *generic{symbol.detailsIf<GenericDetails>()}) {
     return generic->specific() &&
         HandlePreviousCalls(name, *generic->specific(), subpFlag);
case ProgramTree::Kind::Submodule:
     return BeginSubmodule(node.name(), node.GetParentId());
   case ProgramTree::Kind::BlockData:
     PushBlockDataScope(node.name());
     return true;
   }
 }
 
 void ResolveNamesVisitor::EndScopeForNode(const ProgramTree &node) {
-  EndSubprogram();
+  using BindingPtr = const std::optional<parser::LanguageBindingSpec> *;
+  EndSubprogram(common::visit(
+      common::visitors{
+          [](const parser::Statement<parser::FunctionStmt> *stmt) {
+            if (stmt) {
+              if (const auto &maybeSuffix{
+                      std::get<std::optional<parser::Suffix>>(
+                          stmt->statement.t)}) {
+                return &maybeSuffix->binding;
+              }
+            }
+            return BindingPtr{};
+          },
+          [](const parser::Statement<parser::SubroutineStmt> *stmt) {
+            return stmt ? &std::get<std::optional<parser::LanguageBindingSpec>>(
+                              stmt->statement.t)
+                        : BindingPtr{};
+          },
+          [](const auto *) { return BindingPtr{}; },
+      },
+      node.stmt()));
 }
 
 // Some analyses and checks, such as the processing of initializers of
 // pointers, are deferred until all of the pertinent specification parts
 // have been visited.  This deferred processing enables the use of forward
 // references in these circumstances.
 class DeferredCheckVisitor {
 public:

flang/test/Lower/program-units-fir-mangling.f90

 ! CHECK-LABEL: func @bar() attributes {fir.sym_name = "_QPsome_entry"} {
  entry some_entry() bind(c, name="bar")
 ! CHECK-LABEL: func @_QPnormal_entry() {
  entry normal_entry()
 ! CHECK-LABEL: func @some_other_entry() attributes {fir.sym_name = "_QPsome_other_entry"} {
  entry some_other_entry() bind(c)
 end subroutine
 
+! Test that semantics constructs binding labels with local name resolution
+module testMod3
+  character*(*), parameter :: foo = "bad!!"
+  character*(*), parameter :: ok = "ok"
+  interface
+    real function f1() bind(c,name=ok//'1')
+      import ok
+    end function
+    subroutine s1() bind(c,name=ok//'2')
+      import ok
+    end subroutine
+  end interface
+ contains
+! CHECK-LABEL: func @ok3() -> f32 attributes {fir.sym_name = "_QMtestmod3Pf2"} {
+  real function f2() bind(c,name=foo//'3')
+    character*(*), parameter :: foo = ok
+! CHECK: fir.call @ok1() : () -> f32
+! CHECK-LABEL: func @ok4() -> f32 attributes {fir.sym_name = "_QMtestmod3Pf3"} {
+    entry f3() bind(c,name=foo//'4')
+! CHECK: fir.call @ok1() : () -> f32
+    f2 = f1()
+  end function
+! CHECK-LABEL: func @ok5() attributes {fir.sym_name = "_QMtestmod3Ps2"} {
+  subroutine s2() bind(c,name=foo//'5')
+    character*(*), parameter :: foo = ok
+! CHECK: fir.call @ok2() : () -> ()
+! CHECK-LABEL: func @ok6() attributes {fir.sym_name = "_QMtestmod3Ps3"} {
+    entry s3() bind(c,name=foo//'6')
+! CHECK: fir.call @ok2() : () -> ()
+    continue ! force end of specification part
+! CHECK-LABEL: func @ok7() attributes {fir.sym_name = "_QMtestmod3Ps4"} {
+    entry s4() bind(c,name=foo//'7')
+! CHECK: fir.call @ok2() : () -> ()
+    call s1
+  end subroutine
+end module
+
 ! CHECK-LABEL: fir.global internal @_QFfooEpi : f32 {