[flang] Fix some module file issues exposed by Whizard

Generic type-bound interfaces for user-defined operators need to be formatted
as "OPERATOR(.op.)", not just ".op."

PRIVATE generics need to be marked as such.

Declaration ordering: when a generic interface shadows a
derived type of the same name, it needs to be emitted to the
module file at the point of definition of the derived type;
otherwise, the derived type's definition may appear after its
first use.

The module symbol for a module read from a module file needs
to be marked as coming from a module file before semantic
processing is performed on the contents of the module so that
any special handling for declarations in module files can be
properly activated.

IMPORT statements were sometimes missing for use-associated
symbols in surrounding scopes; fine-tune NeedImport().

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

4 files changed, 125 insertions, 27 deletions

diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp
index 23733f9..af3267a1 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -198,6 +198,15 @@ bool ModFileWriter::PutSymbols(const Scope &scope) {
   }
 }
 
+static llvm::raw_ostream &PutGenericName(
+    llvm::raw_ostream &os, const Symbol &symbol) {
+  if (IsGenericDefinedOp(symbol)) {
+    return os << "operator(" << symbol.name() << ')';
+  } else {
+    return os << symbol.name();
+  }
+}
+
 // Emit a symbol to decls_, except for bindings in a derived type (type-bound
 // procedures, type-bound generics, final procedures) which go to typeBindings.
 void ModFileWriter::PutSymbol(
@@ -210,8 +219,8 @@ void ModFileWriter::PutSymbol(
                    if (symbol.owner().IsDerivedType()) {
                      // generic binding
                      for (const Symbol &proc : x.specificProcs()) {
-                       typeBindings << "generic::" << symbol.name() << "=>"
-                                    << proc.name() << '\n';
+                       PutGenericName(typeBindings << "generic::", symbol)
+                           << "=>" << proc.name() << '\n';
                      }
                    } else {
                      PutGeneric(symbol);
@@ -392,15 +401,6 @@ static bool IsIntrinsicOp(const Symbol &symbol) {
   }
 }
 
-static llvm::raw_ostream &PutGenericName(
-    llvm::raw_ostream &os, const Symbol &symbol) {
-  if (IsGenericDefinedOp(symbol)) {
-    return os << "operator(" << symbol.name() << ')';
-  } else {
-    return os << symbol.name();
-  }
-}
-
 void ModFileWriter::PutGeneric(const Symbol &symbol) {
   const auto &genericOwner{symbol.owner()};
   auto &details{symbol.get<GenericDetails>()};
@@ -427,9 +427,11 @@ void ModFileWriter::PutUse(const Symbol &symbol) {
     PutGenericName(uses_ << "=>", use);
   }
   uses_ << '\n';
-  PutUseExtraAttr(Attr::PRIVATE, symbol, use);
   PutUseExtraAttr(Attr::VOLATILE, symbol, use);
   PutUseExtraAttr(Attr::ASYNCHRONOUS, symbol, use);
+  if (symbol.attrs().test(Attr::PRIVATE)) {
+    PutGenericName(useExtraAttrs_ << "private::", symbol) << '\n';
+  }
 }
 
 // We have "USE local => use" in this module. If attr was added locally
@@ -442,6 +444,31 @@ 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 (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;
+      // they're not in the cooked source.
+      return use->symbol().name();
+    }
+  }
+  return symbol.name();
+}
+
 // Collect the symbols of this scope sorted by their original order, not name.
 // Namelists are an exception: they are sorted after other symbols.
 void CollectSymbols(
@@ -465,7 +492,7 @@ 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 x->name().begin() < y->name().begin();
+    return NameInModuleFile(x).begin() < NameInModuleFile(y).begin();
   });
   sorted.insert(sorted.end(), namelist.begin(), namelist.end());
   for (const auto &pair : scope.commonBlocks()) {
@@ -819,13 +846,15 @@ Scope *ModFileReader::Read(const SourceName &name, Scope *ancestor) {
   } else {
     parentScope = ancestor;
   }
-  ResolveNames(context_, *parseTree);
-  const auto &it{parentScope->find(name)};
-  if (it == parentScope->end()) {
+  auto pair{parentScope->try_emplace(name, UnknownDetails{})};
+  if (!pair.second) {
     return nullptr;
   }
-  auto &modSymbol{*it->second};
+  Symbol &modSymbol{*pair.first->second};
   modSymbol.set(Symbol::Flag::ModFile);
+  ResolveNames(context_, *parseTree);
+  CHECK(modSymbol.has<ModuleDetails>());
+  CHECK(modSymbol.test(Symbol::Flag::ModFile));
   return modSymbol.scope();
 }
 
@@ -974,14 +1003,16 @@ bool SubprogramSymbolCollector::NeedImport(
     const SourceName &name, const Symbol &symbol) {
   if (!isInterface_) {
     return false;
-  } else if (symbol.owner() != scope_.parent()) {
-    // detect import from parent of use-associated symbol
-    // can be null in the case of a use-associated derived type's parent type
-    const auto *found{scope_.FindSymbol(name)};
-    CHECK(found || symbol.has<DerivedTypeDetails>());
-    return found && found->has<UseDetails>() && found->owner() != scope_;
-  } else {
+  } else if (symbol.owner().Contains(scope_)) {
     return true;
+  } else if (const Symbol * found{scope_.FindSymbol(name)}) {
+    // detect import from ancestor of use-associated symbol
+    return found->has<UseDetails>() && found->owner() != scope_;
+  } else {
+    // "found" can be null in the case of a use-associated derived type's parent
+    // type
+    CHECK(symbol.has<DerivedTypeDetails>());
+    return false;
   }
 }
 
diff --git a/flang/test/Semantics/modfile35.f90 b/flang/test/Semantics/modfile35.f90
index 928b6c5..1c50bfe 100644
--- a/flang/test/Semantics/modfile35.f90
+++ b/flang/test/Semantics/modfile35.f90
@@ -205,13 +205,13 @@ end
 !  contains
 !    procedure,pass(x)::p1=>f1
 !    procedure::p3=>f3
-!    generic::.binary.=>p1
-!    generic::.unary.=>p3
+!    generic::operator(.binary.)=>p1
+!    generic::operator(.unary.)=>p3
 !  end type
 !  type,extends(t1)::t2
 !  contains
 !    procedure,pass(y)::p2=>f2
-!    generic::.binary.=>p2
+!    generic::operator(.binary.)=>p2
 !  end type
 !contains
 !  pure function f1(x,y)
diff --git a/flang/test/Semantics/modfile37.f90 b/flang/test/Semantics/modfile37.f90
new file mode 100644
index 0000000..61f64fb
--- /dev/null
+++ b/flang/test/Semantics/modfile37.f90
@@ -0,0 +1,32 @@
+! RUN: %S/test_modfile.sh %s %t %f18
+
+! Ensure that a dummy procedure's interface's imports
+! appear in the module file.
+
+module m
+  type :: t
+  end type
+ contains
+  subroutine s1(s2)
+    interface
+      subroutine s2(x)
+        import
+        class(t) :: x
+      end subroutine
+    end interface
+  end subroutine
+end module
+!Expect: m.mod
+!module m
+!type::t
+!end type
+!contains
+!subroutine s1(s2)
+!interface
+!subroutine s2(x)
+!import::t
+!class(t)::x
+!end
+!end interface
+!end
+!end
diff --git a/flang/test/Semantics/modfile38.f90 b/flang/test/Semantics/modfile38.f90
new file mode 100644
index 0000000..c234568
--- /dev/null
+++ b/flang/test/Semantics/modfile38.f90
@@ -0,0 +1,35 @@
+! RUN: %S/test_modfile.sh %s %t %f18
+
+! Ensure that an interface with the same name as a derived type
+! does not cause that shadowed name to be emitted later than its
+! uses in the module file.
+
+module m
+  type :: t
+  end type
+  type :: t2
+    type(t) :: c
+  end type
+  interface t
+    module procedure f
+  end interface
+ contains
+  type(t) function f
+  end function
+end module
+
+!Expect: m.mod
+!module m
+!interface t
+!procedure::f
+!end interface
+!type::t
+!end type
+!type::t2
+!type(t)::c
+!end type
+!contains
+!function f()
+!type(t)::f
+!end
+!end