diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp --- a/flang/lib/Semantics/mod-file.cpp +++ b/flang/lib/Semantics/mod-file.cpp @@ -198,6 +198,15 @@ } } +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 @@ 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 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()}; @@ -430,6 +430,9 @@ 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 +445,31 @@ } } +// 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()}) { + if (const auto *derivedTypeOverload{generic->derivedType()}) { + if (derivedTypeOverload->name().begin() < symbol.name().begin()) { + return derivedTypeOverload->name(); + } + } + } else if (const auto *use{symbol.detailsIf()}) { + 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 +493,7 @@ // 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 +847,15 @@ } 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()); + CHECK(modSymbol.test(Symbol::Flag::ModFile)); return modSymbol.scope(); } @@ -974,14 +1004,16 @@ 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()); - return found && found->has() && 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() && found->owner() != scope_; + } else { + // "found" can be null in the case of a use-associated derived type's parent + // type + CHECK(symbol.has()); + return false; } } diff --git a/flang/test/Semantics/modfile35.f90 b/flang/test/Semantics/modfile35.f90 --- a/flang/test/Semantics/modfile35.f90 +++ b/flang/test/Semantics/modfile35.f90 @@ -205,13 +205,13 @@ ! 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 --- /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 --- /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