[flang] Allow reference to earlier generic in later interface

Name resolutions defers all resolution and checking of specific procedures
in non-type-bound generic interfaces to the end of the specification part.
This prevents expression analysis of references to generic functions in
specification expressions in interfaces from resolving.

Example (now a new test case in modfile07.f90):
```
  module m12
    interface generic
      module procedure specific
    end interface
    interface
      module subroutine s(a1,a2)
        character(*) a1
        character(generic(a1)) a2   ! <--
      end
    end interface
   contains
    pure integer function specific(x)
      character(*), intent(in) :: x
      specific = len(x)
    end
  end
```

The solution is to partially resolve specific procedures as they are
defined for each generic, when they can be resolved, with the final
pass at the end of the specification part to finish up any forward
references and emit the necessary error messages.

Making this fix caused some issues in module file output, which have
all been resolved by making this simplifying change: generics are
now all emitted to module file specification parts as their own
group of declarations at the end of the specification part,
followed only by namelists and COMMON blocks.

Differential Revision: https://reviews.llvm.org/D157346

Author: klausler

flang/lib/Semantics/mod-file.cpp

@@ -271,13 +271,6 @@ void ModFileWriter::PutSymbol(
               }
             } else {
               PutGeneric(symbol);
-              if (x.specific() && &x.specific()->owner() == &symbol.owner()) {
-                PutSymbol(typeBindings, *x.specific());
-              }
-              if (x.derivedType() &&
-                  &x.derivedType()->owner() == &symbol.owner()) {
-                PutSymbol(typeBindings, *x.derivedType());
-              }
             }
           },
           [&](const UseDetails &) { PutUse(symbol); },
@@ -583,21 +576,8 @@ void ModFileWriter::PutUseExtraAttr(
   }
 }
 
-// When a generic interface has the same name as a derived type
-// in the same scope, the generic shadows the derived type.
-// If the derived type were declared first, emit the generic
-// interface at the position of derived type's declaration.
-// (ReplaceName() is not used for this purpose because doing so
-// would confusingly position error messages pertaining to the generic
-// interface upon the derived type's declaration.)
 static inline SourceName NameInModuleFile(const Symbol &symbol) {
-  if (const auto *generic{symbol.detailsIf<GenericDetails>()}) {
-    if (const auto *derivedTypeOverload{generic->derivedType()}) {
-      if (derivedTypeOverload->name().begin() < symbol.name().begin()) {
-        return derivedTypeOverload->name();
-      }
-    }
-  } else if (const auto *use{symbol.detailsIf<UseDetails>()}) {
+  if (const auto *use{symbol.detailsIf<UseDetails>()}) {
     if (use->symbol().attrs().test(Attr::PRIVATE)) {
       // Avoid the use in sorting of names created to access private
       // specific procedures as a result of generic resolution;
@@ -609,17 +589,26 @@ static inline SourceName NameInModuleFile(const Symbol &symbol) {
 }
 
 // Collect the symbols of this scope sorted by their original order, not name.
-// Namelists are an exception: they are sorted after other symbols.
+// Generics and namelists are exceptions: they are sorted after other symbols.
 void CollectSymbols(
     const Scope &scope, SymbolVector &sorted, SymbolVector &uses) {
-  SymbolVector namelist;
+  SymbolVector namelist, generics;
   std::size_t commonSize{scope.commonBlocks().size()};
   auto symbols{scope.GetSymbols()};
   sorted.reserve(symbols.size() + commonSize);
   for (SymbolRef symbol : symbols) {
     if (!symbol->test(Symbol::Flag::ParentComp)) {
       if (symbol->has<NamelistDetails>()) {
         namelist.push_back(symbol);
+      } else if (const auto *generic{symbol->detailsIf<GenericDetails>()}) {
+        if (generic->specific() &&
+            &generic->specific()->owner() == &symbol->owner()) {
+          sorted.push_back(*generic->specific());
+        } else if (generic->derivedType() &&
+            &generic->derivedType()->owner() == &symbol->owner()) {
+          sorted.push_back(*generic->derivedType());
+        }
+        generics.push_back(symbol);
       } else {
         sorted.push_back(symbol);
       }
@@ -630,9 +619,12 @@ void CollectSymbols(
   }
   // Sort most symbols by name: use of Symbol::ReplaceName ensures the source
   // location of a symbol's name is the first "real" use.
-  std::sort(sorted.begin(), sorted.end(), [](SymbolRef x, SymbolRef y) {
-    return NameInModuleFile(x).begin() < NameInModuleFile(y).begin();
-  });
+  auto sorter{[](SymbolRef x, SymbolRef y) {
+    return NameInModuleFile(*x).begin() < NameInModuleFile(*y).begin();
+  }};
+  std::sort(sorted.begin(), sorted.end(), sorter);
+  std::sort(generics.begin(), generics.end(), sorter);
+  sorted.insert(sorted.end(), generics.begin(), generics.end());
   sorted.insert(sorted.end(), namelist.begin(), namelist.end());
   for (const auto &pair : scope.commonBlocks()) {
     sorted.push_back(*pair.second);

flang/lib/Semantics/resolve-names.cpp

@@ -843,11 +843,13 @@ class InterfaceVisitor : public virtual ScopeHandler {
 
   using ProcedureKind = parser::ProcedureStmt::Kind;
   // mapping of generic to its specific proc names and kinds
-  std::multimap<Symbol *, std::pair<const parser::Name *, ProcedureKind>>
-      specificProcs_;
+  using SpecificProcMapType =
+      std::multimap<Symbol *, std::pair<const parser::Name *, ProcedureKind>>;
+  SpecificProcMapType specificProcs_;
 
   void AddSpecificProcs(const std::list<parser::Name> &, ProcedureKind);
-  void ResolveSpecificsInGeneric(Symbol &generic);
+  void ResolveSpecificsInGeneric(Symbol &, bool isEndOfSpecificationPart);
+  void ResolveNewSpecifics();
 };
 
 class SubprogramVisitor : public virtual ScopeHandler, public InterfaceVisitor {
@@ -3258,6 +3260,7 @@ bool InterfaceVisitor::Pre(const parser::InterfaceStmt &x) {
 void InterfaceVisitor::Post(const parser::InterfaceStmt &) { EndAttrs(); }
 
 void InterfaceVisitor::Post(const parser::EndInterfaceStmt &) {
+  ResolveNewSpecifics();
   genericInfo_.pop();
 }
 
@@ -3277,11 +3280,11 @@ bool InterfaceVisitor::Pre(const parser::GenericSpec &x) {
 bool InterfaceVisitor::Pre(const parser::ProcedureStmt &x) {
   if (!isGeneric()) {
     Say("A PROCEDURE statement is only allowed in a generic interface block"_err_en_US);
-    return false;
+  } else {
+    auto kind{std::get<parser::ProcedureStmt::Kind>(x.t)};
+    const auto &names{std::get<std::list<parser::Name>>(x.t)};
+    AddSpecificProcs(names, kind);
   }
-  auto kind{std::get<parser::ProcedureStmt::Kind>(x.t)};
-  const auto &names{std::get<std::list<parser::Name>>(x.t)};
-  AddSpecificProcs(names, kind);
   return false;
 }
 
@@ -3295,6 +3298,7 @@ void InterfaceVisitor::Post(const parser::GenericStmt &x) {
   }
   const auto &names{std::get<std::list<parser::Name>>(x.t)};
   AddSpecificProcs(names, ProcedureKind::Procedure);
+  ResolveNewSpecifics();
   genericInfo_.pop();
 }
 
@@ -3318,36 +3322,48 @@ void InterfaceVisitor::AddSpecificProcs(
 
 // By now we should have seen all specific procedures referenced by name in
 // this generic interface. Resolve those names to symbols.
-void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) {
+void InterfaceVisitor::ResolveSpecificsInGeneric(
+    Symbol &generic, bool isEndOfSpecificationPart) {
   auto &details{generic.get<GenericDetails>()};
   UnorderedSymbolSet symbolsSeen;
   for (const Symbol &symbol : details.specificProcs()) {
     symbolsSeen.insert(symbol.GetUltimate());
   }
   auto range{specificProcs_.equal_range(&generic)};
+  SpecificProcMapType retain;
   for (auto it{range.first}; it != range.second; ++it) {
     const parser::Name *name{it->second.first};
     auto kind{it->second.second};
-    const auto *symbol{FindSymbol(*name)};
-    if (!symbol) {
-      Say(*name, "Procedure '%s' not found"_err_en_US);
+    const Symbol *symbol{FindSymbol(*name)};
+    if (!isEndOfSpecificationPart && symbol &&
+        &symbol->owner() != &generic.owner()) {
+      // Don't mistakenly use a name from the enclosing scope while there's
+      // still a chance that it could be overridden by a later declaration in
+      // this scope.
+      retain.emplace(&generic, std::make_pair(name, kind));
       continue;
     }
-    // Subtlety: when *symbol is a use- or host-association, the specific
-    // procedure that is recorded in the GenericDetails below must be *symbol,
-    // not the specific procedure shadowed by a generic, because that specific
-    // procedure may be a symbol from another module and its name unavailable to
-    // emit to a module file.
-    const Symbol &bypassed{BypassGeneric(*symbol)};
-    const Symbol &specific{
-        symbol == &symbol->GetUltimate() ? bypassed : *symbol};
-    const Symbol &ultimate{bypassed.GetUltimate()};
-    ProcedureDefinitionClass defClass{ClassifyProcedure(ultimate)};
+    ProcedureDefinitionClass defClass{ProcedureDefinitionClass::None};
+    const Symbol *specific{symbol};
+    const Symbol *ultimate{nullptr};
+    if (symbol) {
+      // Subtlety: when *symbol is a use- or host-association, the specific
+      // procedure that is recorded in the GenericDetails below must be *symbol,
+      // not the specific procedure shadowed by a generic, because that specific
+      // procedure may be a symbol from another module and its name unavailable
+      // to emit to a module file.
+      const Symbol &bypassed{BypassGeneric(*symbol)};
+      if (symbol == &symbol->GetUltimate()) {
+        specific = &bypassed;
+      }
+      ultimate = &bypassed.GetUltimate();
+      defClass = ClassifyProcedure(*ultimate);
+    }
+    std::optional<MessageFixedText> error;
     if (defClass == ProcedureDefinitionClass::Module) {
       // ok
     } else if (kind == ProcedureKind::ModuleProcedure) {
-      Say(*name, "'%s' is not a module procedure"_err_en_US);
-      continue;
+      error = "'%s' is not a module procedure"_err_en_US;
     } else {
       switch (defClass) {
       case ProcedureDefinitionClass::Intrinsic:
@@ -3357,47 +3373,58 @@ void InterfaceVisitor::ResolveSpecificsInGeneric(Symbol &generic) {
       case ProcedureDefinitionClass::Pointer:
         break;
       case ProcedureDefinitionClass::None:
-        Say(*name, "'%s' is not a procedure"_err_en_US);
-        continue;
+        error = "'%s' is not a procedure"_err_en_US;
+        break;
       default:
-        Say(*name,
-            "'%s' is not a procedure that can appear in a generic interface"_err_en_US);
-        continue;
+        error =
+            "'%s' is not a procedure that can appear in a generic interface"_err_en_US;
+        break;
       }
     }
-    if (symbolsSeen.insert(ultimate).second /*true if added*/) {
+    if (error) {
+      if (isEndOfSpecificationPart) {
+        Say(*name, std::move(*error));
+      } else {
+        // possible forward reference, catch it later
+        retain.emplace(&generic, std::make_pair(name, kind));
+      }
+    } else if (!ultimate) {
+    } else if (symbolsSeen.insert(*ultimate).second /*true if added*/) {
       // When a specific procedure is a USE association, that association
       // is saved in the generic's specifics, not its ultimate symbol,
       // so that module file output of interfaces can distinguish them.
-      details.AddSpecificProc(specific, name->source);
-    } else if (&specific == &ultimate) {
+      details.AddSpecificProc(*specific, name->source);
+    } else if (specific == ultimate) {
       Say(name->source,
           "Procedure '%s' is already specified in generic '%s'"_err_en_US,
           name->source, MakeOpName(generic.name()));
     } else {
       Say(name->source,
           "Procedure '%s' from module '%s' is already specified in generic '%s'"_err_en_US,
-          ultimate.name(), ultimate.owner().GetName().value(),
+          ultimate->name(), ultimate->owner().GetName().value(),
           MakeOpName(generic.name()));
     }
   }
   specificProcs_.erase(range.first, range.second);
+  specificProcs_.merge(std::move(retain));
+}
+
+void InterfaceVisitor::ResolveNewSpecifics() {
+  if (Symbol * generic{genericInfo_.top().symbol};
+      generic && generic->has<GenericDetails>()) {
+    ResolveSpecificsInGeneric(*generic, false);
+  }
 }
 
 // Mixed interfaces are allowed by the standard.
 // If there is a derived type with the same name, they must all be functions.
 void InterfaceVisitor::CheckGenericProcedures(Symbol &generic) {
-  ResolveSpecificsInGeneric(generic);
+  ResolveSpecificsInGeneric(generic, true);
   auto &details{generic.get<GenericDetails>()};
   if (auto *proc{details.CheckSpecific()}) {
-    auto msg{
-        "'%s' should not be the name of both a generic interface and a"
-        " procedure unless it is a specific procedure of the generic"_warn_en_US};
-    if (proc->name().begin() > generic.name().begin()) {
-      Say(proc->name(), std::move(msg));
-    } else {
-      Say(generic.name(), std::move(msg));
-    }
+    Say(proc->name().begin() > generic.name().begin() ? proc->name()
+                                                      : generic.name(),
+        "'%s' should not be the name of both a generic interface and a procedure unless it is a specific procedure of the generic"_warn_en_US);
   }
   auto &specifics{details.specificProcs()};
   if (specifics.empty()) {