[flang] Fix bug with generic and homonymous specific module procedure

[klausler]

Summary

An unconditional EraseSymbol() call was deleting a generic interface symbol
when the generic had a module procedure of the same name as a specific
procedure, and the module procedure's definition appeared in the same
module. Also clean up some applications of the MODULE attribute to
symbols created along the way.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/lib/Semantics/resolve-names.cpp

 
 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,
-      const parser::LanguageBindingSpec * = nullptr);
+      const parser::LanguageBindingSpec * = nullptr,
+      bool hasModulePrefix = false);
   Symbol *GetSpecificFromGeneric(const parser::Name &);
   Symbol &PostSubprogramStmt();
   void CreateDummyArgument(SubprogramDetails &, const parser::Name &);
   void CreateEntry(const parser::EntryStmt &stmt, Symbol &subprogram);
   void PostEntryStmt(const parser::EntryStmt &stmt);
   void HandleLanguageBinding(Symbol *,
       std::optional<parser::CharBlock> stmtSource,
       const std::optional<parser::LanguageBindingSpec> *);
if (subp->cudaClusterDims().empty()) {
       subp->set_cudaClusterDims(std::move(dims));
     } else {
       Say(currStmtSource().value(),
           "CLUSTER_DIMS() may only appear once"_err_en_US);
     }
   }
 }
 
+static bool HasModulePrefix(const std::list<parser::PrefixSpec> &prefixes) {
+  for (const auto &prefix : prefixes) {
+    if (std::holds_alternative<parser::PrefixSpec::Module>(prefix.u)) {
+      return true;
+    }
+  }
+  return false;
+}
+
 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);
+  const auto &stmtTuple{
+      std::get<parser::Statement<parser::SubroutineStmt>>(x.t).statement.t};
+  return BeginSubprogram(std::get<parser::Name>(stmtTuple),
+      Symbol::Flag::Subroutine,
+      HasModulePrefix(std::get<std::list<parser::PrefixSpec>>(stmtTuple)));
 }
 void SubprogramVisitor::Post(const parser::InterfaceBody::Subroutine &x) {
   const auto &stmt{std::get<parser::Statement<parser::SubroutineStmt>>(x.t)};
   EndSubprogram(stmt.source,
       &std::get<std::optional<parser::LanguageBindingSpec>>(stmt.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);
+  const auto &stmtTuple{
+      std::get<parser::Statement<parser::FunctionStmt>>(x.t).statement.t};
+  return BeginSubprogram(std::get<parser::Name>(stmtTuple),
+      Symbol::Flag::Function,
+      HasModulePrefix(std::get<std::list<parser::PrefixSpec>>(stmtTuple)));
 }
 void SubprogramVisitor::Post(const parser::InterfaceBody::Function &x) {
   const auto &stmt{std::get<parser::Statement<parser::FunctionStmt>>(x.t)};
   const auto &maybeSuffix{
       std::get<std::optional<parser::Suffix>>(stmt.statement.t)};
   EndSubprogram(stmt.source, maybeSuffix ? &maybeSuffix->binding : nullptr);
 }
 
if (hasModulePrefix && currScope().IsGlobal()) { // C1547
     return false;
   }
   Symbol *moduleInterface{nullptr};
   if (hasModulePrefix && !inInterfaceBlock()) {
     moduleInterface = FindSeparateModuleProcedureInterface(name);
     if (moduleInterface && &moduleInterface->owner() == &currScope()) {
       // Subprogram is MODULE FUNCTION or MODULE SUBROUTINE with an interface
       // previously defined in the same scope.
+      if (GenericDetails *
+          generic{DEREF(FindSymbol(name)).detailsIf<GenericDetails>()}) {
+        generic->clear_specific();
+      } else {
         EraseSymbol(name);
       }
     }
-  Symbol &newSymbol{PushSubprogramScope(name, subpFlag, bindingSpec)};
+  }
+  Symbol &newSymbol{
+      PushSubprogramScope(name, subpFlag, bindingSpec, hasModulePrefix)};
   if (moduleInterface) {
     newSymbol.get<SubprogramDetails>().set_moduleInterface(*moduleInterface);
     if (moduleInterface->attrs().test(Attr::PRIVATE)) {
       SetImplicitAttr(newSymbol, Attr::PRIVATE);
     } else if (moduleInterface->attrs().test(Attr::PUBLIC)) {
       SetImplicitAttr(newSymbol, Attr::PUBLIC);
     }
   }
if (IsDummy(*prev)) {
       // 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, const parser::LanguageBindingSpec *bindingSpec) {
+    Symbol::Flag subpFlag, const parser::LanguageBindingSpec *bindingSpec,
+    bool hasModulePrefix) {
   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->ReplaceName(name.source);
   symbol->set(subpFlag);
   PushScope(Scope::Kind::Subprogram, symbol);
   if (subpFlag == Symbol::Flag::Function) {
     funcResultStack().Push(currScope());
   }
   if (inInterfaceBlock()) {
     auto &details{symbol->get<SubprogramDetails>()};
     details.set_isInterface();
     if (isAbstract()) {
       SetExplicitAttr(*symbol, Attr::ABSTRACT);
+    } else if (hasModulePrefix) {
+      SetExplicitAttr(*symbol, Attr::MODULE);
     } else {
       MakeExternal(*symbol);
     }
     if (isGeneric()) {
       Symbol &genericSymbol{GetGenericSymbol()};
       if (auto *details{genericSymbol.detailsIf<GenericDetails>()}) {
         details->AddSpecificProc(*symbol, name.source);
       } else {
         CHECK(context().HasError(genericSymbol));
       }
     }
     set_inheritFromParent(false);
   }
-  FindSymbol(name)->set(subpFlag); // PushScope() created symbol
+  if (Symbol * found{FindSymbol(name)};
+      found && found->has<HostAssocDetails>()) {
+    found->set(subpFlag); // PushScope() created symbol
+  }
   return *symbol;
 }
 
 void SubprogramVisitor::PushBlockDataScope(const parser::Name &name) {
   if (auto *prev{FindSymbol(name)}) {
     if (prev->attrs().test(Attr::EXTERNAL) && prev->has<ProcEntityDetails>()) {
       if (prev->test(Symbol::Flag::Subroutine) ||
           prev->test(Symbol::Flag::Function)) {
if (symbol->has<SubprogramNameDetails>()) {
       if (inInterfaceBlock()) {
         // Subtle: clear any MODULE flag so that the new interface
         // symbol doesn't inherit it and ruin the ability to check it.
         symbol->attrs().reset(Attr::MODULE);
       }
     } else if (auto *details{symbol->detailsIf<GenericDetails>()}) {
       // found generic, want specific procedure
       auto *specific{details->specific()};
+      Attrs moduleAttr;
       if (inInterfaceBlock()) {
         if (specific) {
           // Defining an interface in a generic of the same name which is
           // already shadowing another procedure.  In some cases, the shadowed
           // procedure is about to be replaced.
           if (specific->has<SubprogramNameDetails>() &&
               specific->attrs().test(Attr::MODULE)) {
             // The shadowed procedure is a separate module procedure that is
             // actually defined later in this (sub)module.
             // Define its interface now as a new symbol.
+            moduleAttr.set(Attr::MODULE);
             specific = nullptr;
           } else if (&specific->owner() != &symbol->owner()) {
             // The shadowed procedure was from an enclosing scope and will be
             // overridden by this interface definition.
             specific = nullptr;
           }
           if (!specific) {
             details->clear_specific();
           }
         } else if (const auto *dType{details->derivedType()}) {
           if (&dType->owner() != &symbol->owner()) {
             // The shadowed derived type was from an enclosing scope and
             // will be overridden by this interface definition.
             details->clear_derivedType();
           }
         }
       }
       if (!specific) {
-        specific =
-            &currScope().MakeSymbol(name.source, Attrs{}, SubprogramDetails{});
+        specific = &currScope().MakeSymbol(
+            name.source, std::move(moduleAttr), SubprogramDetails{});
         if (details->derivedType()) {
           // A specific procedure with the same name as a derived type
           SayAlreadyDeclared(name, *details->derivedType());
         } else {
           details->set_specific(Resolve(name, *specific));
         }
       } else if (isGeneric()) {
         SayAlreadyDeclared(name, *specific);

flang/test/Semantics/symbol28.f90

+! RUN: %python %S/test_symbols.py %s %flang_fc1
+!DEF: /m1 Module
+module m1
+ !DEF: /m1/s PUBLIC (Subroutine) Generic
+ interface s
+  !DEF: /m1/s MODULE (Subroutine) Subprogram
+  module subroutine s
+  end subroutine
+  !DEF: /m1/s2 MODULE, PUBLIC (Subroutine) Subprogram
+  !DEF: /m1/s2/j INTENT(IN) ObjectEntity INTEGER(4)
+  module subroutine s2 (j)
+   !REF: /m1/s2/j
+   integer, intent(in) :: j
+  end subroutine
+ end interface
+contains
+ !DEF: /m1/s MODULE (Subroutine) SubprogramName
+ module subroutine s
+ end subroutine
+ !REF: /m1/s2
+ module procedure s2
+ end procedure
+ !DEF: /m1/test PUBLIC (Subroutine) Subprogram
+ subroutine test
+  !REF: /m1/s
+  call s
+  !REF: /m1/s2
+  call s(1)
+ end subroutine
+end module
+!DEF: /m2 Module
+module m2
+ !DEF: /m2/s PUBLIC (Subroutine) Generic
+ interface s
+  !DEF: /m2/s MODULE (Subroutine) Subprogram
+  module subroutine s
+  end subroutine
+  !DEF: /m2/s2 MODULE, PUBLIC (Subroutine) Subprogram
+  !DEF: /m2/s2/j INTENT(IN) ObjectEntity INTEGER(4)
+  module subroutine s2 (j)
+   !REF: /m2/s2/j
+   integer, intent(in) :: j
+  end subroutine
+ end interface
+contains
+ !DEF: /m2/s MODULE SubprogramName
+ module procedure s
+ end procedure
+ !DEF: /m2/s2 MODULE, PUBLIC (Subroutine) Subprogram
+ !DEF: /m2/s2/j INTENT(IN) ObjectEntity INTEGER(4)
+ module subroutine s2 (j)
+  !REF: /m2/s2/j
+  integer, intent(in) :: j
+ end subroutine
+ !DEF: /m2/test PUBLIC (Subroutine) Subprogram
+ subroutine test
+  !REF: /m2/s
+  call s
+  !REF: /m2/s2
+  call s(1)
+ end subroutine
+end module