diff --git a/flang/docs/ModFiles.md b/flang/docs/ModFiles.md index fc05c2677fc26..b9047431c60ba 100644 --- a/flang/docs/ModFiles.md +++ b/flang/docs/ModFiles.md @@ -172,6 +172,11 @@ When the compiler reads a hermetic module file, the copies of the dependent modules are read into their own scope, and will not conflict with other modules of the same name that client code might `USE`. +The copies of the module files can be copies of hermetic modules as well, +in which case they and their dependencies are surrounded by compiler directives +(`!DIR$ BEGIN_NESTED_HERMETIC_MODULE` and `!DIR$ END_NESTED_HERMETIC_MODULE`) +to represent the nesting. + One can use the `-fhermetic-module-files` option when building the top-level module files of a library for which not all of the implementation modules will (or can) be shipped. diff --git a/flang/include/flang/Parser/dump-parse-tree.h b/flang/include/flang/Parser/dump-parse-tree.h index df9278697346f..24f3b42a1c5c8 100644 --- a/flang/include/flang/Parser/dump-parse-tree.h +++ b/flang/include/flang/Parser/dump-parse-tree.h @@ -214,6 +214,8 @@ class ParseTreeDumper { NODE(CompilerDirective, NoVector) NODE(CompilerDirective, NoUnroll) NODE(CompilerDirective, NoUnrollAndJam) + NODE(CompilerDirective, BeginNestedHermeticModule) + NODE(CompilerDirective, EndNestedHermeticModule) NODE(parser, ComplexLiteralConstant) NODE(parser, ComplexPart) NODE(parser, ComponentArraySpec) diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h index c99006f0c1c22..0459ad46bab82 100644 --- a/flang/include/flang/Parser/parse-tree.h +++ b/flang/include/flang/Parser/parse-tree.h @@ -3354,6 +3354,8 @@ struct StmtFunctionStmt { // !DIR$ NOVECTOR // !DIR$ NOUNROLL // !DIR$ NOUNROLL_AND_JAM +// !DIR$ BEGIN_NESTED_HERMETIC_MODULE +// !DIR$ END_NESTED_HERMETIC_MODULE // !DIR$ struct CompilerDirective { UNION_CLASS_BOILERPLATE(CompilerDirective); @@ -3382,11 +3384,14 @@ struct CompilerDirective { EMPTY_CLASS(NoVector); EMPTY_CLASS(NoUnroll); EMPTY_CLASS(NoUnrollAndJam); + EMPTY_CLASS(BeginNestedHermeticModule); + EMPTY_CLASS(EndNestedHermeticModule); EMPTY_CLASS(Unrecognized); CharBlock source; std::variant, LoopCount, std::list, - VectorAlways, std::list, Unroll, UnrollAndJam, Unrecognized, - NoVector, NoUnroll, NoUnrollAndJam> + VectorAlways, std::list, Unroll, UnrollAndJam, NoVector, + NoUnroll, NoUnrollAndJam, BeginNestedHermeticModule, + EndNestedHermeticModule, Unrecognized> u; }; diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h index cec212f0eae37..03314c114d1c2 100644 --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -94,6 +94,8 @@ class ModuleDetails : public WithOmpDeclarative { void set_moduleFileHash(ModuleCheckSumType x) { moduleFileHash_ = x; } const Symbol *previous() const { return previous_; } void set_previous(const Symbol *p) { previous_ = p; } + bool isHermetic() const { return isHermetic_; } + void set_isHermetic(bool yes = true) { isHermetic_ = yes; } private: bool isSubmodule_; @@ -101,6 +103,7 @@ class ModuleDetails : public WithOmpDeclarative { const Scope *scope_{nullptr}; std::optional moduleFileHash_; const Symbol *previous_{nullptr}; // same name, different module file hash + bool isHermetic_{false}; }; class MainProgramDetails : public WithOmpDeclarative { @@ -690,7 +693,6 @@ class GenericDetails { const SymbolVector &specificProcs() const { return specificProcs_; } const std::vector &bindingNames() const { return bindingNames_; } 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 in @@ -704,7 +706,10 @@ class GenericDetails { const Symbol *derivedType() const { return derivedType_; } void set_derivedType(Symbol &derivedType); void clear_derivedType(); - void AddUse(const Symbol &); + const std::optional originalUseDetails() const { + return originalUseDetails_; + } + void set_originalUseDetails(const UseDetails &x) { originalUseDetails_ = x; } // Copy in specificProcs, specific, and derivedType from another generic void CopyFrom(const GenericDetails &); @@ -719,12 +724,11 @@ class GenericDetails { // all of the specific procedures for this generic SymbolVector specificProcs_; std::vector bindingNames_; - // Symbols used from other modules merged into this one - SymbolVector uses_; // a specific procedure with the same name as this generic, if any Symbol *specific_{nullptr}; // a derived type with the same name as this generic, if any Symbol *derivedType_{nullptr}; + std::optional originalUseDetails_; }; llvm::raw_ostream &operator<<(llvm::raw_ostream &, const GenericDetails &); diff --git a/flang/lib/Parser/Fortran-parsers.cpp b/flang/lib/Parser/Fortran-parsers.cpp index fbe629ab52935..d4c2fe8284b37 100644 --- a/flang/lib/Parser/Fortran-parsers.cpp +++ b/flang/lib/Parser/Fortran-parsers.cpp @@ -1294,6 +1294,8 @@ TYPE_PARSER(construct("STAT =" >> statVariable) || // !DIR$ LOOP COUNT (n1[, n2]...) // !DIR$ name[=value] [, name[=value]]... // !DIR$ UNROLL [n] +// !DIR$ BEGIN_NESTED_HERMETIC_MODULE +// !DIR$ END_NESTED_HERMETIC_MODULE // !DIR$ constexpr auto ignore_tkr{ "IGNORE_TKR" >> optionalList(construct( @@ -1315,18 +1317,23 @@ constexpr auto nounroll{"NOUNROLL" >> construct()}; constexpr auto nounrollAndJam{ "NOUNROLL_AND_JAM" >> construct()}; TYPE_PARSER(beginDirective >> "DIR$ "_tok >> - sourced((construct(ignore_tkr) || - construct(loopCount) || - construct(assumeAligned) || - construct(vectorAlways) || - construct(unrollAndJam) || - construct(unroll) || - construct(novector) || - construct(nounrollAndJam) || - construct(nounroll) || - construct( - many(construct( - name, maybe(("="_tok || ":"_tok) >> digitString64))))) / + sourced( + (construct(ignore_tkr) || + construct(loopCount) || + construct(assumeAligned) || + construct(vectorAlways) || + construct(unrollAndJam) || + construct(unroll) || + construct(novector) || + construct(nounrollAndJam) || + construct(nounroll) || + construct("BEGIN_NESTED_HERMETIC_MODULE" >> + construct()) || + construct("End_NESTED_HERMETIC_MODULE" >> + construct()) || + construct( + many(construct( + name, maybe(("="_tok || ":"_tok) >> digitString64))))) / endOfStmt || construct(pure()) / SkipTo<'\n'>{})) diff --git a/flang/lib/Parser/unparse.cpp b/flang/lib/Parser/unparse.cpp index 0784a6703bbde..146f212b1027e 100644 --- a/flang/lib/Parser/unparse.cpp +++ b/flang/lib/Parser/unparse.cpp @@ -1867,6 +1867,12 @@ class UnparseVisitor { [&](const CompilerDirective::NoUnrollAndJam &) { Word("!DIR$ NOUNROLL_AND_JAM"); }, + [&](const CompilerDirective::BeginNestedHermeticModule &) { + Word("!DIR$ BEGIN_NESTED_HERMETIC_MODULE"); + }, + [&](const CompilerDirective::EndNestedHermeticModule &) { + Word("!DIR$ END_NESTED_HERMETIC_MODULE"); + }, [&](const CompilerDirective::Unrecognized &) { Word("!DIR$ "); Word(x.source.ToString()); diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp index a1ec956562204..0ba4d0e0fd452 100644 --- a/flang/lib/Semantics/mod-file.cpp +++ b/flang/lib/Semantics/mod-file.cpp @@ -48,7 +48,7 @@ struct ModHeader { static std::optional GetSubmoduleParent(const parser::Program &); static void CollectSymbols( - const Scope &, SymbolVector &, SymbolVector &, SourceOrderedSymbolSet &); + const Scope &, SymbolVector &, SourceOrderedSymbolSet &); static void PutPassName(llvm::raw_ostream &, const std::optional &); static void PutInit(llvm::raw_ostream &, const Symbol &, const MaybeExpr &, const parser::Expr *, SemanticsContext &); @@ -142,23 +142,7 @@ void ModFileWriter::Write(const Symbol &symbol) { auto ancestorName{ancestor ? ancestor->GetName().value().ToString() : ""s}; std::string path{context_.moduleDirectory() + '/' + ModFileName(symbol.name(), ancestorName, context_.moduleFileSuffix())}; - - UnorderedSymbolSet hermeticModules; - hermeticModules.insert(symbol); - UnorderedSymbolSet additionalModules; - PutSymbols(DEREF(symbol.scope()), - hermeticModuleFileOutput_ ? &additionalModules : nullptr); - auto asStr{GetAsString(symbol)}; - while (!additionalModules.empty()) { - for (auto ref : UnorderedSymbolSet{std::move(additionalModules)}) { - if (hermeticModules.insert(*ref).second && - !ref->owner().IsIntrinsicModules()) { - PutSymbols(DEREF(ref->scope()), &additionalModules); - asStr += GetAsString(*ref); - } - } - } - + std::string asStr{WriteModuleAndDependents(symbol)}; ModuleCheckSumType checkSum; if (std::error_code error{ WriteFile(path, asStr, checkSum, context_.debugModuleWriter())}) { @@ -168,6 +152,31 @@ void ModFileWriter::Write(const Symbol &symbol) { const_cast(module).set_moduleFileHash(checkSum); } +std::string ModFileWriter::WriteModuleAndDependents(const Symbol &symbol) { + UnorderedSymbolSet done, more; + done.insert(symbol); + PutSymbols( + DEREF(symbol.scope()), hermeticModuleFileOutput_ ? &more : nullptr); + auto asStr{GetAsString(symbol)}; + while (!more.empty()) { + UnorderedSymbolSet toProcess{std::move(more)}; + more.clear(); + for (auto ref : toProcess) { + if (done.insert(*ref).second && !ref->owner().IsIntrinsicModules()) { + if (ref->get().isHermetic()) { + asStr += "!dir$ begin_nested_hermetic_module\n"; + asStr += WriteModuleAndDependents(*ref); + asStr += "!dir$ end_nested_hermetic_module\n"; + } else { + PutSymbols(DEREF(ref->scope()), &more); + asStr += GetAsString(*ref); + } + } + } + } + return asStr; +} + void ModFileWriter::WriteClosure(llvm::raw_ostream &out, const Symbol &symbol, UnorderedSymbolSet &nonIntrinsicModulesWritten) { if (!symbol.has() || symbol.owner().IsIntrinsicModules() || @@ -245,15 +254,18 @@ static void HarvestSymbolsNeededFromOtherModules( if (symbol.scope()) { HarvestSymbolsNeededFromOtherModules(set, *symbol.scope()); } - } else if (const auto &generic{symbol.detailsIf()}; - generic && generic->derivedType()) { - const Symbol &dtSym{*generic->derivedType()}; - if (dtSym.has()) { - if (dtSym.scope()) { - HarvestSymbolsNeededFromOtherModules(set, *dtSym.scope()); + } else if (const auto *generic{symbol.detailsIf()}) { + if (const Symbol *dtSym{generic->derivedType()}) { + if (dtSym->has()) { + if (dtSym->scope()) { + HarvestSymbolsNeededFromOtherModules(set, *dtSym->scope()); + } + } else { + CHECK(dtSym->has() || dtSym->has()); } - } else { - CHECK(dtSym.has() || dtSym.has()); + } + for (const Symbol &specific : generic->specificProcs()) { + set.emplace(specific); } } else if (const auto *object{symbol.detailsIf()}) { HarvestArraySpec(object->shape()); @@ -306,38 +318,34 @@ void ModFileWriter::PrepareRenamings(const Scope &scope) { // Establish any necessary renamings of symbols in other modules // to their names in this scope, creating those new names when needed. auto &renamings{context_.moduleFileOutputRenamings()}; - for (SymbolRef s : symbolsNeeded) { - if (s->owner().kind() != Scope::Kind::Module) { + for (const Symbol &s : symbolsNeeded) { + if (s.owner().kind() != Scope::Kind::Module) { // Not a USE'able name from a module's top scope; // component, binding, dummy argument, &c. continue; } - const Scope *sMod{FindModuleContaining(s->owner())}; + const Scope *sMod{FindModuleContaining(s.owner())}; if (!sMod || sMod == &scope) { continue; } - if (auto iter{useMap.find(&*s)}; iter != useMap.end()) { - renamings.emplace(&*s, iter->second->name()); + if (auto iter{useMap.find(&s)}; iter != useMap.end()) { + renamings.emplace(&s, iter->second->name()); continue; } - SourceName rename{s->name()}; - if (const Symbol * found{scope.FindSymbol(s->name())}) { - if (found == &*s) { + SourceName rename{s.name()}; + if (const Symbol *found{scope.FindSymbol(s.name())}) { + if (found == &s) { continue; // available in scope } - if (const auto *generic{found->detailsIf()}) { - if (generic->derivedType() == &*s || generic->specific() == &*s) { - continue; - } - } else if (found->has()) { - if (&found->GetUltimate() == &*s) { + if (found->has()) { + if (&found->GetUltimate() == &s) { continue; // already use-associated with same name } } - if (&s->owner() != &found->owner()) { // Symbol needs renaming + if (&s.owner() != &found->owner()) { // Symbol needs renaming rename = scope.context().SaveTempName( DEREF(sMod->symbol()).name().ToString() + "$" + - s->name().ToString()); + s.name().ToString()); } } // Symbol is used in this scope but not visible under its name @@ -347,11 +355,11 @@ void ModFileWriter::PrepareRenamings(const Scope &scope) { uses_ << "use "; } uses_ << DEREF(sMod->symbol()).name() << ",only:"; - if (rename != s->name()) { + if (rename != s.name()) { uses_ << rename << "=>"; - renamings.emplace(&s->GetUltimate(), rename); + renamings.emplace(&s.GetUltimate(), rename); } - uses_ << s->name() << '\n'; + uses_ << s.name() << '\n'; useExtraAttrs_ << "private::" << rename << '\n'; } } @@ -360,12 +368,11 @@ void ModFileWriter::PrepareRenamings(const Scope &scope) { void ModFileWriter::PutSymbols( const Scope &scope, UnorderedSymbolSet *hermeticModules) { SymbolVector sorted; - SymbolVector uses; auto &renamings{context_.moduleFileOutputRenamings()}; auto previousRenamings{std::move(renamings)}; PrepareRenamings(scope); SourceOrderedSymbolSet modules; - CollectSymbols(scope, sorted, uses, modules); + CollectSymbols(scope, sorted, modules); // Write module files for dependencies first so that their // hashes are known. for (auto ref : modules) { @@ -387,9 +394,6 @@ void ModFileWriter::PutSymbols( PutSymbol(typeBindings, symbol); } } - for (const Symbol &symbol : uses) { - PutUse(symbol); - } for (const auto &set : scope.equivalenceSets()) { if (!set.empty() && !set.front().symbol.test(Symbol::Flag::CompilerCreated)) { @@ -794,11 +798,13 @@ static bool IsIntrinsicOp(const Symbol &symbol) { } void ModFileWriter::PutGeneric(const Symbol &symbol) { - const auto &genericOwner{symbol.owner()}; auto &details{symbol.get()}; PutGenericName(decls_ << "interface ", symbol) << '\n'; + const auto &renamings{context_.moduleFileOutputRenamings()}; for (const Symbol &specific : details.specificProcs()) { - if (specific.owner() == genericOwner) { + if (auto iter{renamings.find(&specific)}; iter != renamings.end()) { + decls_ << "procedure::" << iter->second << '\n'; + } else { decls_ << "procedure::" << specific.name() << '\n'; } } @@ -845,31 +851,25 @@ void ModFileWriter::PutUseExtraAttr( // Collect the symbols of this scope sorted by their original order, not name. // Generics and namelists are exceptions: they are sorted after other symbols. -void CollectSymbols(const Scope &scope, SymbolVector &sorted, - SymbolVector &uses, SourceOrderedSymbolSet &modules) { +void CollectSymbols( + const Scope &scope, SymbolVector &sorted, SourceOrderedSymbolSet &modules) { SymbolVector namelist, generics; auto symbols{scope.GetSymbols()}; std::size_t commonSize{scope.commonBlocks().size()}; sorted.reserve(symbols.size() + commonSize); - for (SymbolRef symbol : symbols) { - const auto *generic{symbol->detailsIf()}; - if (generic) { - uses.insert(uses.end(), generic->uses().begin(), generic->uses().end()); - for (auto ref : generic->uses()) { - modules.insert(GetUsedModule(ref->get())); - } - } else if (const auto *use{symbol->detailsIf()}) { + for (const Symbol &symbol : symbols) { + if (const auto *use{symbol.detailsIf()}) { modules.insert(GetUsedModule(*use)); } - if (symbol->test(Symbol::Flag::ParentComp)) { - } else if (symbol->has()) { + if (symbol.test(Symbol::Flag::ParentComp)) { + } else if (symbol.has()) { namelist.push_back(symbol); - } else if (generic) { + } else if (const auto *generic{symbol.detailsIf()}) { if (generic->specific() && - &generic->specific()->owner() == &symbol->owner()) { + &generic->specific()->owner() == &symbol.owner()) { sorted.push_back(*generic->specific()); } else if (generic->derivedType() && - &generic->derivedType()->owner() == &symbol->owner()) { + &generic->derivedType()->owner() == &symbol.owner()) { sorted.push_back(*generic->derivedType()); } generics.push_back(symbol); @@ -1342,6 +1342,114 @@ static void GetModuleDependences( } } +// Given a list of program units (modules or compiler directives) parsed from +// a module file, read the first module and the dependent modules that were +// packaged with it. The dependent modules can themselves be hermetic, +// so this routine is recursive. The list of program units is broken apart +// and later stitched back together to make these recursive calls possible. +static void ReadHermeticModule(SemanticsContext &context, Scope &scope, + std::list &progUnits) { + // Extract the first module into its own Program. + std::list justFirst; + CHECK(!progUnits.empty() && + std::holds_alternative>( + progUnits.front().u)); + justFirst.emplace_back(std::move(progUnits.front())); + progUnits.pop_front(); + // The following modules are read into a new scope that's visible to name + // resolution only via a pointer in the SemanticsContext. + Scope &hermeticScope{scope.MakeScope(Scope::Kind::Global)}; + // Handle nested hermetic modules recursively first; put non-hermetic nested + // modules on a "normals" list to be handled later. + std::list normals, hermetics; + while (!progUnits.empty()) { + if (const auto *dir{ + std::get_if>( + &progUnits.front().u)}; + dir && + std::holds_alternative< + parser::CompilerDirective::BeginNestedHermeticModule>( + dir->value().u)) { + // There's a nested hermetic module sequence delimited by directives. + // !DIR$ BEGIN_NESTED_HERMETIC_MODULE + // module nested + // use dependency1 + // use dependency2 + // end + // module dependency1; end + // module dependency2; end + // !DIR$ NESTED_NESTED_HERMETIC_MODULE + int nesting{1}; + hermetics.emplace_back(std::move(progUnits.front())); // !DIR$ BEGIN + progUnits.pop_front(); + std::list nested; + while (!progUnits.empty()) { + if (auto *dir{ + std::get_if>( + &progUnits.front().u)}) { + if (std::holds_alternative< + parser::CompilerDirective::BeginNestedHermeticModule>( + dir->value().u)) { + ++nesting; + } else if (std::holds_alternative< + parser::CompilerDirective::EndNestedHermeticModule>( + dir->value().u)) { + CHECK(nesting > 0); + if (nesting-- == 1) { + // "nested" contains the nested hermetic module and its + // dependences, which may also be nested. + CHECK(!nested.empty()); + ReadHermeticModule(context, hermeticScope, nested); + for (; !nested.empty(); nested.pop_front()) { + hermetics.emplace_back(std::move(nested.front())); + } + hermetics.emplace_back(std::move(progUnits.front())); // !DIR$ END + progUnits.pop_front(); + break; + } + } + } + nested.emplace_back(std::move(progUnits.front())); + progUnits.pop_front(); + } + CHECK(nesting == 0); + CHECK(nested.empty()); + } else { + normals.emplace_back(std::move(progUnits.front())); + progUnits.pop_front(); + } + } + // Mark the nested hermetic modules as being such. + for (auto &[_, ref] : hermeticScope) { + ref->get().set_isHermetic(true); + } + // Handle non-hermetic nested modules now + Scope *previousHermeticScope{context.currentHermeticModuleFileScope()}; + context.set_currentHermeticModuleFileScope(&hermeticScope); + if (!normals.empty()) { + parser::Program program{std::move(normals)}; + ResolveNames(context, program, hermeticScope); + normals = std::move(program.v); + } + for (auto &[_, ref] : hermeticScope) { + CHECK(ref->has()); + ref->set(Symbol::Flag::ModFile); + } + // Now finally process the first module in the original list. + parser::Program firstModuleOnly{std::move(justFirst)}; + ResolveNames(context, firstModuleOnly, scope); + context.set_currentHermeticModuleFileScope(previousHermeticScope); + // Reconstruct the progUnits list so parse tree dumps don't look weird. + progUnits.clear(); + progUnits.emplace_back(std::move(firstModuleOnly.v.front())); + for (; !hermetics.empty(); hermetics.pop_front()) { + progUnits.emplace_back(std::move(hermetics.front())); + } + for (; !normals.empty(); normals.pop_front()) { + progUnits.emplace_back(std::move(normals.front())); + } +} + Scope *ModFileReader::Read(SourceName name, std::optional isIntrinsic, Scope *ancestor, bool silent) { std::string ancestorName; // empty for module @@ -1548,23 +1656,14 @@ Scope *ModFileReader::Read(SourceName name, std::optional isIntrinsic, // created under -fhermetic-module-files? If so, process them first in // their own nested scope that will be visible only to USE statements // within the module file. - Scope *previousHermetic{context_.currentHermeticModuleFileScope()}; - if (parseTree.v.size() > 1) { - parser::Program hermeticModules{std::move(parseTree.v)}; - parseTree.v.emplace_back(std::move(hermeticModules.v.front())); - hermeticModules.v.pop_front(); - Scope &hermeticScope{topScope.MakeScope(Scope::Kind::Global)}; - context_.set_currentHermeticModuleFileScope(&hermeticScope); - ResolveNames(context_, hermeticModules, hermeticScope); - for (auto &[_, ref] : hermeticScope) { - CHECK(ref->has()); - ref->set(Symbol::Flag::ModFile); - } - } - GetModuleDependences(context_.moduleDependences(), sourceFile->content()); - ResolveNames(context_, parseTree, topScope); + bool isHermetic{parseTree.v.size() > 1}; + if (isHermetic) { + ReadHermeticModule(context_, topScope, parseTree.v); + } else { + GetModuleDependences(context_.moduleDependences(), sourceFile->content()); + ResolveNames(context_, parseTree, topScope); + } context_.foldingContext().set_moduleFileName(wasModuleFileName); - context_.set_currentHermeticModuleFileScope(previousHermetic); if (!moduleSymbol) { // Submodule symbols' storage are owned by their parents' scopes, // but their names are not in their parents' dictionaries -- we @@ -1582,6 +1681,7 @@ Scope *ModFileReader::Read(SourceName name, std::optional isIntrinsic, auto &details{moduleSymbol->get()}; details.set_moduleFileHash(checkSum.value()); details.set_previous(previousModuleSymbol); + details.set_isHermetic(isHermetic); if (isIntrinsic.value_or(false)) { moduleSymbol->attrs().set(Attr::INTRINSIC); } diff --git a/flang/lib/Semantics/mod-file.h b/flang/lib/Semantics/mod-file.h index 82538fb510873..6258fea4d1fc0 100644 --- a/flang/lib/Semantics/mod-file.h +++ b/flang/lib/Semantics/mod-file.h @@ -66,6 +66,7 @@ class ModFileWriter { void WriteAll(const Scope &); void WriteOne(const Scope &); void Write(const Symbol &); + std::string WriteModuleAndDependents(const Symbol &); std::string GetAsString(const Symbol &); void PrepareRenamings(const Scope &); void PutSymbols(const Scope &, UnorderedSymbolSet *hermetic); diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 297007bcbde67..6458588839a23 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -3404,19 +3404,18 @@ bool ScopeHandler::ConvertToUseError( ued->add_occurrence(location, used); return true; } - const auto *useDetails{symbol.detailsIf()}; - if (!useDetails) { - if (auto *genericDetails{symbol.detailsIf()}) { - if (!genericDetails->uses().empty()) { - useDetails = &genericDetails->uses().at(0)->get(); - } - } - } - if (useDetails) { + if (const auto *useDetails{symbol.detailsIf()}) { symbol.set_details( UseErrorDetails{*useDetails}.add_occurrence(location, used)); return true; } + if (const auto *genericDetails{symbol.detailsIf()}) { + if (const auto &useDetails{genericDetails->originalUseDetails()}) { + symbol.set_details( + UseErrorDetails{*useDetails}.add_occurrence(location, used)); + return true; + } + } if (const auto *hostAssocDetails{symbol.detailsIf()}; hostAssocDetails && hostAssocDetails->symbol().has() && &symbol.owner() == &currScope() && @@ -3846,7 +3845,7 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, localSymbol->name(), localSymbol->attrs(), std::move(generic))}; newSymbol.flags() = localSymbol->flags(); localGeneric = &newSymbol.get(); - localGeneric->AddUse(*localSymbol); + localGeneric->set_originalUseDetails(localSymbol->get()); localSymbol = &newSymbol; } if (useGeneric) { @@ -3854,7 +3853,8 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, localSymbol->attrs() = useSymbol.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE}; localSymbol->flags() = useSymbol.flags(); - AddGenericUse(*localGeneric, localName, useUltimate); + // Resolved to ultimate during module file emission + AddGenericUse(*localGeneric, localName, useSymbol); localGeneric->clear_derivedType(); localGeneric->CopyFrom(*useGeneric); } @@ -3878,8 +3878,7 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, std::move(generic))}; newSymbol.flags() = useUltimate.flags(); auto &newUseGeneric{newSymbol.get()}; - AddGenericUse(newUseGeneric, localName, useUltimate); - newUseGeneric.AddUse(*localSymbol); + AddGenericUse(newUseGeneric, localName, useSymbol); if (combinedDerivedType) { if (const auto *oldDT{newUseGeneric.derivedType()}) { CHECK(&oldDT->GetUltimate() == &combinedDerivedType->GetUltimate()); @@ -3905,10 +3904,7 @@ void ModuleVisitor::AddUse(const GenericSpecInfo &info) { // Create a UseDetails symbol for this USE and add it to generic Symbol &ModuleVisitor::AddGenericUse( GenericDetails &generic, const SourceName &name, const Symbol &useSymbol) { - Symbol &newSymbol{ - currScope().MakeSymbol(name, {}, UseDetails{name, useSymbol})}; - generic.AddUse(newSymbol); - return newSymbol; + return currScope().MakeSymbol(name, {}, UseDetails{name, useSymbol}); } // Enforce F'2023 C1406 as a warning @@ -4179,7 +4175,7 @@ void GenericHandler::ResolveSpecificsInGeneric( Say(name->source, "Procedure '%s' is already specified in generic '%s'"_err_en_US, name->source, MakeOpName(generic.name())); - } else { + } else if (!InModuleFile()) { Say(name->source, "Procedure '%s' from module '%s' is already specified in generic '%s'"_err_en_US, ultimate->name(), ultimate->owner().GetName().value(), diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp index 52f74035bd6a8..73af01bae4dc8 100644 --- a/flang/lib/Semantics/symbol.cpp +++ b/flang/lib/Semantics/symbol.cpp @@ -247,11 +247,6 @@ void GenericDetails::set_derivedType(Symbol &derivedType) { derivedType_ = &derivedType; } void GenericDetails::clear_derivedType() { derivedType_ = nullptr; } -void GenericDetails::AddUse(const Symbol &use) { - CHECK(use.has()); - uses_.push_back(use); -} - const Symbol *GenericDetails::CheckSpecific() const { return const_cast(this)->CheckSpecific(); } @@ -278,10 +273,31 @@ void GenericDetails::CopyFrom(const GenericDetails &from) { derivedType_ = from.derivedType_; } for (std::size_t i{0}; i < from.specificProcs_.size(); ++i) { - if (llvm::none_of(specificProcs_, [&](const Symbol &mySymbol) { - return &mySymbol.GetUltimate() == - &from.specificProcs_[i]->GetUltimate(); - })) { + const Symbol &ultimate{from.specificProcs_[i]->GetUltimate()}; + std::optional ultimateModuleName; + if (const Scope *ultimateModule{FindModuleContaining(ultimate.owner())}) { + ultimateModuleName = ultimateModule->GetName(); + } + auto iter{specificProcs_.begin()}; + for (; iter != specificProcs_.end(); ++iter) { + const Symbol &specificUltimate{(*iter)->GetUltimate()}; + if (&ultimate == &specificUltimate) { + break; + } + if (ultimate.name() == specificUltimate.name() && ultimateModuleName) { + if (const Scope *specificUltimateModule{ + FindModuleContaining(specificUltimate.owner())}) { + if (auto specificUltimateModuleName{ + specificUltimateModule->GetName()}) { + if (*ultimateModuleName == *specificUltimateModuleName) { + // same module$procedure external name + break; + } + } + } + } + } + if (iter == specificProcs_.end()) { specificProcs_.push_back(from.specificProcs_[i]); bindingNames_.push_back(from.bindingNames_[i]); } @@ -551,18 +567,10 @@ llvm::raw_ostream &operator<<( llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const GenericDetails &x) { os << ' ' << x.kind().ToString(); - DumpBool(os, "(specific)", x.specific() != nullptr); - DumpBool(os, "(derivedType)", x.derivedType() != nullptr); - if (const auto &uses{x.uses()}; !uses.empty()) { - os << " (uses:"; - char sep{' '}; - for (const Symbol &use : uses) { - const Symbol &ultimate{use.GetUltimate()}; - os << sep << ultimate.name() << "->" - << ultimate.owner().GetName().value(); - sep = ','; - } - os << ')'; + if (x.specific()) { + os << " (specific " << *x.specific() << ")"; + } else if (x.derivedType()) { + os << " (derivedType)" << *x.derivedType() << ")"; } os << " procs:"; DumpSymbolVector(os, x.specificProcs()); @@ -593,6 +601,9 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const Details &details) { if (x.isDefaultPrivate()) { os << " isDefaultPrivate"; } + if (x.isHermetic()) { + os << " isHermetic"; + } }, [&](const SubprogramNameDetails &x) { os << ' ' << EnumToString(x.kind()); diff --git a/flang/test/Semantics/modfile07.f90 b/flang/test/Semantics/modfile07.f90 index 90c35a9a69377..71d597d1e7d25 100644 --- a/flang/test/Semantics/modfile07.f90 +++ b/flang/test/Semantics/modfile07.f90 @@ -399,10 +399,14 @@ subroutine test() end !Expect: m7c.mod !module m7c -! use m7a, only: g => g_integer -! use m7b, only: g => g_real +! usem7a, only: m7a$s=>s +! usem7b, only: m7b$s=>s +! private::m7a$s +! private::m7b$s ! private :: s ! interface g +! procedure :: m7a$s +! procedure :: m7b$s ! procedure :: s ! end interface !contains @@ -481,10 +485,14 @@ subroutine test() end !Expect: m8c.mod !module m8c -! use m8a, only: g -! use m8b, only: g +! usem8a,only:m8a$s=>s +! usem8b,only:m8b$s=>s +! private::m8a$s +! private::m8b$s ! private :: s ! interface g +! procedure::m8a$s +! procedure::m8b$s ! procedure :: s ! end interface !contains @@ -536,10 +544,12 @@ subroutine test() end !Expect: m9b.mod !module m9b -! use m9a,only:g +! use m9a,only:m9a$s=>s +! private::m9a$s ! private::s ! interface g -! procedure::s +! procedure::m9a$s +! procedure::s ! end interface !contains ! subroutine s(x) @@ -553,22 +563,48 @@ subroutine test() module m10a interface operator(.ne.) + module procedure proc end interface + contains + elemental logical function proc(x, y) + logical, intent(in) :: x + integer, intent(in) :: y + end end !Expect: m10a.mod !module m10a ! interface operator(.ne.) +! procedure::proc ! end interface +!contains +! elementalfunctionproc(x,y) +! logical(4),intent(in)::x +! integer(4),intent(in)::y +! logical(4)::proc +! end !end module m10b interface operator(<>) + module procedure proc end interface + contains + elemental logical function proc(x, y) + logical, intent(in) :: x + real, intent(in) :: y + end end !Expect: m10b.mod !module m10b ! interface operator(<>) +! procedure::proc ! end interface +!contains +! elementalfunctionproc(x,y) +! logical(4),intent(in)::x +! real(4),intent(in)::y +! logical(4)::proc +! end !end module m10c @@ -579,9 +615,13 @@ module m10c end !Expect: m10c.mod !module m10c -! use m10a,only:operator(.ne.) -! use m10b,only:operator(.ne.) +! usem10a,only:m10a$proc=>proc +! usem10b,only:m10b$proc=>proc +! private::m10a$proc +! private::m10b$proc ! interface operator(.ne.) +! procedure::m10a$proc +! procedure::m10b$proc ! end interface !end @@ -592,9 +632,13 @@ module m10d end !Expect: m10d.mod !module m10d -! use m10a,only:operator(.ne.) -! use m10c,only:operator(.ne.) +! usem10a,only:m10a$proc=>proc +! usem10b,only:m10b$proc=>proc +! private::m10a$proc +! private::m10b$proc ! interface operator(.ne.) +! procedure::m10a$proc +! procedure::m10b$proc ! end interface ! private::operator(.ne.) !end diff --git a/flang/test/Semantics/modfile69.f90 b/flang/test/Semantics/modfile69.f90 index 6586e0524f5ea..bfd274277cc3e 100644 --- a/flang/test/Semantics/modfile69.f90 +++ b/flang/test/Semantics/modfile69.f90 @@ -21,7 +21,6 @@ module m2 !Expect: m2.mod !module m2 !use m1,only:bar=>foo -!use m1,only:bar=>foo !interface bar !end interface !end diff --git a/flang/test/Semantics/modfile76.F90 b/flang/test/Semantics/modfile76.F90 new file mode 100644 index 0000000000000..80267b9326b01 --- /dev/null +++ b/flang/test/Semantics/modfile76.F90 @@ -0,0 +1,26 @@ +!RUN: %flang -c -fhermetic-module-files -DWHICH=1 %s && %flang -c -fhermetic-module-files -DWHICH=2 %s && %flang -c -fhermetic-module-files %s && cat modfile76c.mod | FileCheck %s + +#if WHICH == 1 +module modfile76a + integer :: global_variable = 0 +end +#elif WHICH == 2 +module modfile76b + use modfile76a + contains + subroutine test + end +end +#else +module modfile76c + use modfile76a + use modfile76b +end +#endif + +!CHECK: module modfile76c +!CHECK: module modfile76a +!CHECK: !dir$ begin_nested_hermetic_module +!CHECK: module modfile76b +!CHECK: module modfile76a +!CHECK: !dir$ end_nested_hermetic_module diff --git a/flang/test/Semantics/modfile77.F90 b/flang/test/Semantics/modfile77.F90 new file mode 100644 index 0000000000000..923723289247a --- /dev/null +++ b/flang/test/Semantics/modfile77.F90 @@ -0,0 +1,37 @@ +!RUN: %flang -c -fhermetic-module-files -DWHICH=1 %s && %flang -c -fhermetic-module-files -DWHICH=2 %s && %flang -c -fhermetic-module-files %s && cat modfile77c.mod | FileCheck %s + +#if WHICH == 1 +module modfile77a + interface gen + procedure proc + end interface + contains + subroutine proc + print *, 'ok' + end +end +#elif WHICH == 2 +module modfile77b + use modfile77a +end +#else +module modfile77c + use modfile77a + use modfile77b +end +#endif + +!CHECK: module modfile77c +!CHECK: use modfile77a,only:proc +!CHECK: interface gen +!CHECK: procedure::proc +!CHECK: end interface +!CHECK: end +!CHECK: module modfile77a +!CHECK: interface gen +!CHECK: procedure::proc +!CHECK: end interface +!CHECK: contains +!CHECK: subroutine proc() +!CHECK: end +!CHECK: end