[flang] Fix some module file issues exposed by Whizard

[klausler]

Summary

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().

[klausler]

Merged with Tim's fix from earlier today (test was failing)

flang/lib/Semantics/mod-file.cpp

if (auto str{typeBindings.str()}; !str.empty()) {
     CHECK(scope.IsDerivedType());
     decls_ << "contains\n" << str;
     return true;
   } else {
     return false;
   }
 }
 
+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(
     llvm::raw_ostream &typeBindings, const Symbol &symbol) {
   std::visit(common::visitors{
                  [&](const ModuleDetails &) { /* should be current module */ },
                  [&](const DerivedTypeDetails &) { PutDerivedType(symbol); },
                  [&](const SubprogramDetails &) { PutSubprogram(symbol); },
                  [&](const GenericDetails &x) {
                    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);
                      if (x.specific()) {
                        PutSymbol(typeBindings, *x.specific());
                      }
                      if (x.derivedType()) {
                        PutSymbol(typeBindings, *x.derivedType());

 static bool IsIntrinsicOp(const Symbol &symbol) {
   if (const auto *details{symbol.GetUltimate().detailsIf<GenericDetails>()}) {
     return details->kind().IsIntrinsicOperator();
   } else {
     return false;
   }
 }
 
-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>()};
   PutGenericName(decls_ << "interface ", symbol) << '\n';
   for (const Symbol &specific : details.specificProcs()) {
     if (specific.owner() == genericOwner) {
       decls_ << "procedure::" << specific.name() << '\n';
     }
void ModFileWriter::PutUse(const Symbol &symbol) {
   uses_ << "use " << GetUsedModule(details).name();
   PutGenericName(uses_ << ",only:", symbol);
   // Can have intrinsic op with different local-name and use-name
   // (e.g. `operator(<)` and `operator(.lt.)`) but rename is not allowed
   if (!IsIntrinsicOp(symbol) && use.name() != symbol.name()) {
     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
 // (i.e. on local but not on use), also write it out in the mod file.
 void ModFileWriter::PutUseExtraAttr(
     Attr attr, const Symbol &local, const Symbol &use) {
   if (local.attrs().test(attr) && !use.attrs().test(attr)) {
     PutAttr(useExtraAttrs_, attr) << "::";
     useExtraAttrs_ << local.name() << '\n';
   }
 }
 
+// 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(
     const Scope &scope, SymbolVector &sorted, SymbolVector &uses) {
   SymbolVector namelist;
   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 {
         sorted.push_back(symbol);
       }
       if (const auto *details{symbol->detailsIf<GenericDetails>()}) {
         uses.insert(uses.end(), details->uses().begin(), details->uses().end());
       }
     }
   }
   // 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()) {
     sorted.push_back(*pair.second);
   }
   std::sort(sorted.end() - commonSize, sorted.end());
 }
 
Scope *ModFileReader::Read(const SourceName &name, Scope *ancestor) {
   Scope *parentScope; // the scope this module/submodule goes into
   if (!ancestor) {
     parentScope = &context_.globalScope();
   } else if (std::optional<SourceName> parent{GetSubmoduleParent(*parseTree)}) {
     parentScope = Read(*parent, 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();
 }
 
 parser::Message &ModFileReader::Say(const SourceName &name,
     const std::string &ancestor, parser::MessageFixedText &&msg,
     const std::string &arg) {
   return context_
       .Say(name,
void SubprogramSymbolCollector::DoParamValue(const ParamValue &paramValue) {
   }
 }
 
 // Do we need a IMPORT of this symbol into an interface block?
 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;
   }
 }
 
 } // namespace Fortran::semantics

flang/test/Semantics/modfile35.f90

contains
   end
 end
 !Expect: m3.mod
 !module m3
 !  type::t1
 !  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)
 !    class(t1),intent(in)::x
 !    integer(4),intent(in)::y
 !    integer(8)::f1
 !  end
 !  pure function f2(x,y)

flang/test/Semantics/modfile37.f90

+! 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

flang/test/Semantics/modfile38.f90

+! 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