flang] Fix spurious errors from MODULE subprograms

[klausler]

Summary

[When an explicit MODULE procedure is defined in the same (sub)module
as its interface, and the interface was defined in a generic
interface of the same name, bogus errors about symbols already
having been defined will ensue. Cleaning up this aspect of name
resolution and symbol table management requires marking the
place-holding SubprogramNameDetails symbols of explicit MODULE
subprograms as such, ensuring that that attribute is not inherited
if the SubprogramNameDetails symbol is recycled as a SubprogramDetails,
and gathering some code that should have been common between
BeginSubprogram() and BeginMpSubprogram() together in one
new routine.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/include/flang/Semantics/symbol.h

public:
   void AddSpecificProc(const Symbol &, SourceName bindingName);
   const SymbolVector &uses() const { return uses_; }
 
   // specific and derivedType indicate a specific procedure or derived type
   // with the same name as this generic. Only one of them may be set.
   Symbol *specific() { return specific_; }
   const Symbol *specific() const { return specific_; }
   void set_specific(Symbol &specific);
+  void clear_specific();
   Symbol *derivedType() { return derivedType_; }
   const Symbol *derivedType() const { return derivedType_; }
   void set_derivedType(Symbol &derivedType);
   void AddUse(const Symbol &);
 
   // Copy in specificProcs, specific, and derivedType from another generic
   void CopyFrom(const GenericDetails &);
 

flang/lib/Semantics/program-tree.cpp

 }
 
 Symbol::Flag ProgramTree::GetSubpFlag() const {
   return GetKind() == Kind::Function ? Symbol::Flag::Function
                                      : Symbol::Flag::Subroutine;
 }
 
 bool ProgramTree::HasModulePrefix() const {
+  if (std::holds_alternative<
+          const parser::Statement<parser::MpSubprogramStmt> *>(stmt_)) {
+    return true; // MODULE PROCEDURE foo
+  }
   using ListType = std::list<parser::PrefixSpec>;
   const auto *prefixes{common::visit(
       common::visitors{
           [](const parser::Statement<parser::FunctionStmt> *x) {
             return &std::get<ListType>(x->statement.t);
           },
           [](const parser::Statement<parser::SubroutineStmt> *x) {
             return &std::get<ListType>(x->statement.t);

flang/lib/Semantics/resolve-names.cpp

public:
   Symbol *FindInScope(const Scope &, const parser::Name &);
   Symbol *FindInScope(const Scope &, const SourceName &);
   template <typename T> Symbol *FindInScope(const T &name) {
     return FindInScope(currScope(), name);
   }
   // Search for name in a derived type scope and its parents.
   Symbol *FindInTypeOrParents(const Scope &, const parser::Name &);
   Symbol *FindInTypeOrParents(const parser::Name &);
+  Symbol *FindSeparateModuleProcedureInterface(const parser::Name &);
   void EraseSymbol(const parser::Name &);
   void EraseSymbol(const Symbol &symbol) { currScope().erase(symbol.name()); }
   // Make a new symbol with the name and attrs of an existing one
   Symbol &CopySymbol(const SourceName &, const Symbol &);
 
   // Make symbols in the current or named scope
   Symbol &MakeSymbol(Scope &, const SourceName &, Attrs);
   Symbol &MakeSymbol(const SourceName &, Attrs = Attrs{});
if constexpr (std::is_same_v<DerivedTypeDetails, D>) {
           return *derivedType;
         }
       }
     }
     if (symbol->CanReplaceDetails(details)) {
       // update the existing symbol
       symbol->attrs() |= attrs;
       if constexpr (std::is_same_v<SubprogramDetails, D>) {
-        // Dummy argument defined by explicit interface
+        // Dummy argument defined by explicit interface?
         details.set_isDummy(IsDummy(*symbol));
       }
       symbol->set_details(std::move(details));
       return *symbol;
     } else if constexpr (std::is_same_v<UnknownDetails, D>) {
       symbol->attrs() |= attrs;
       return *symbol;
     } else {
if (const auto *dummyName{std::get_if<parser::Name>(&dummyArg.u)}) {
             "ENTRY in a function may not have an alternate return dummy argument"_err_en_US);
         break;
       }
       entryDetails.add_alternateReturn();
     }
   }
 }
 
-// A subprogram declared with MODULE PROCEDURE
-bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) {
+Symbol *ScopeHandler::FindSeparateModuleProcedureInterface(
+    const parser::Name &name) {
   auto *symbol{FindSymbol(name)};
   if (symbol && symbol->has<SubprogramNameDetails>()) {
     symbol = FindSymbol(currScope().parent(), name);
   }
+  if (symbol) {
+    if (auto *generic{symbol->detailsIf<GenericDetails>()}) {
+      symbol = generic->specific();
+    }
+  }
   if (!IsSeparateModuleProcedureInterface(symbol)) {
     Say(name, "'%s' was not declared a separate module procedure"_err_en_US);
+    symbol = nullptr;
+  }
+  return symbol;
+}
+
+// A subprogram declared with MODULE PROCEDURE
+bool SubprogramVisitor::BeginMpSubprogram(const parser::Name &name) {
+  Symbol *symbol{FindSeparateModuleProcedureInterface(name)};
+  if (!symbol) {
     return false;
   }
   if (symbol->owner() == currScope() && symbol->scope()) {
     // This is a MODULE PROCEDURE whose interface appears in its host.
     // Convert the module procedure's interface into a subprogram.
     SetScope(DEREF(symbol->scope()));
     symbol->get<SubprogramDetails>().set_isInterface(false);
   } else {
bool SubprogramVisitor::BeginSubprogram(const parser::Name &name,
   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()) {
-    moduleInterface = FindSymbol(currScope(), name);
-    if (IsSeparateModuleProcedureInterface(moduleInterface)) {
+    moduleInterface = FindSeparateModuleProcedureInterface(name);
+    if (moduleInterface && &moduleInterface->owner() == &currScope()) {
       // Subprogram is MODULE FUNCTION or MODULE SUBROUTINE with an interface
       // previously defined in the same scope.
       currScope().erase(moduleInterface->name());
-    } else {
-      moduleInterface = nullptr;
-    }
-    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, 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)) {
if (name.source.empty()) {
     PushScope(Scope::Kind::BlockData, &MakeSymbol(name, SubprogramDetails{}));
   }
 }
 
 // If name is a generic, return specific subprogram with the same name.
 Symbol *SubprogramVisitor::GetSpecificFromGeneric(const parser::Name &name) {
   // Search for the name but don't resolve it
   if (auto *symbol{currScope().FindSymbol(name.source)}) {
-    if (auto *details{symbol->detailsIf<GenericDetails>()}) {
-      // found generic, want subprogram
+    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()};
+      if (specific && inInterfaceBlock() &&
+          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.
+        details->clear_specific();
+        specific = nullptr;
+      }
       if (!specific) {
         specific =
             &currScope().MakeSymbol(name.source, Attrs{}, 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);
       }
-      if (!specific->has<SubprogramDetails>()) {
-        specific->set_details(SubprogramDetails{});
+      if (specific->has<SubprogramNameDetails>()) {
+        specific->set_details(Details{SubprogramDetails{}});
       }
       return specific;
     }
   }
   return nullptr;
 }
 
 // DeclarationVisitor implementation

 
 // Add SubprogramNameDetails symbols for module and internal subprograms and
 // their ENTRY statements.
 void ResolveNamesVisitor::AddSubpNames(ProgramTree &node) {
   auto kind{
       node.IsModule() ? SubprogramKind::Module : SubprogramKind::Internal};
   for (auto &child : node.children()) {
     auto &symbol{MakeSymbol(child.name(), SubprogramNameDetails{kind, child})};
+    if (child.HasModulePrefix()) {
+      symbol.attrs().set(Attr::MODULE);
+    }
     auto childKind{child.GetKind()};
     if (childKind == ProgramTree::Kind::Function) {
       symbol.set(Symbol::Flag::Function);
     } else if (childKind == ProgramTree::Kind::Subroutine) {
       symbol.set(Symbol::Flag::Subroutine);
     } else {
       continue; // make ENTRY symbols only where valid
     }
     for (const auto &entryStmt : child.entryStmts()) {
       SubprogramNameDetails details{kind, child};
       auto &symbol{
           MakeSymbol(std::get<parser::Name>(entryStmt->t), std::move(details))};
       symbol.set(child.GetSubpFlag());
+      if (child.HasModulePrefix()) {
+        symbol.attrs().set(Attr::MODULE);
+      }
     }
   }
   for (const auto &generic : node.genericSpecs()) {
     if (const auto *name{std::get_if<parser::Name>(&generic->u)}) {
       if (currScope().find(name->source) != currScope().end()) {
         // If this scope has both a generic interface and a contained
         // subprogram with the same name, create the generic's symbol
         // now so that any other generics of the same name that are pulled

flang/lib/Semantics/symbol.cpp

void GenericDetails::AddSpecificProc(
   specificProcs_.push_back(proc);
   bindingNames_.push_back(bindingName);
 }
 void GenericDetails::set_specific(Symbol &specific) {
   CHECK(!specific_);
   CHECK(!derivedType_);
   specific_ = &specific;
 }
+void GenericDetails::clear_specific() { specific_ = nullptr; }
 void GenericDetails::set_derivedType(Symbol &derivedType) {
   CHECK(!specific_);
   CHECK(!derivedType_);
   derivedType_ = &derivedType;
 }
 void GenericDetails::AddUse(const Symbol &use) {
   CHECK(use.has<UseDetails>());
   uses_.push_back(use);

flang/test/Semantics/nullify02.f90

 module badNullify
   interface
     function ptrFun()
       integer, pointer :: ptrFun
     end function
   end interface
 contains
   !ERROR: 'ptrfun' was not declared a separate module procedure
+  !ERROR: 'ptrfun' is already declared in this scoping unit
   module function ptrFun()
     integer, pointer :: ptrFun
     real :: realVar
     nullify(ptrFun)
+    !ERROR: name in NULLIFY statement must have the POINTER attribute
     nullify(realVar)
   end function
 end module