[flang-commits] [flang] [flang] Support nested hermetic modules in hermetic module files (PR #142658)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Fri Jun 6 15:56:27 PDT 2025
https://github.com/klausler updated https://github.com/llvm/llvm-project/pull/142658
>From a319744bde9c0e36ac659e2497c5919ea5de51ab Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Mon, 2 Jun 2025 13:54:55 -0700
Subject: [PATCH] [flang] Support nested hermetic modules in hermetic module
files
When a module is built with -fhermetic-module-files, the non-intrinsic
modules on which it depends are copied into its module file so
that they don't have to be available on any search path when the
module file is parsed. When one of these nested modules was itself
built hermetically, its dependencies also need to be copied.
This can lead to problems with duplication. This patch adds
compiler directives to the module file to preserve the nesting
structure.
---
flang/docs/ModFiles.md | 5 +
flang/include/flang/Parser/dump-parse-tree.h | 2 +
flang/include/flang/Parser/parse-tree.h | 9 +-
flang/include/flang/Semantics/symbol.h | 12 +-
flang/lib/Parser/Fortran-parsers.cpp | 31 ++-
flang/lib/Parser/unparse.cpp | 6 +
flang/lib/Semantics/mod-file.cpp | 248 +++++++++++++------
flang/lib/Semantics/mod-file.h | 1 +
flang/lib/Semantics/resolve-names.cpp | 30 +--
flang/lib/Semantics/symbol.cpp | 48 ++--
flang/test/Semantics/modfile07.f90 | 64 ++++-
flang/test/Semantics/modfile69.f90 | 1 -
flang/test/Semantics/modfile76.F90 | 26 ++
flang/test/Semantics/modfile77.F90 | 37 +++
14 files changed, 384 insertions(+), 136 deletions(-)
create mode 100644 flang/test/Semantics/modfile76.F90
create mode 100644 flang/test/Semantics/modfile77.F90
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$ <anything else>
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<std::list<IgnoreTKR>, LoopCount, std::list<AssumeAligned>,
- VectorAlways, std::list<NameValue>, Unroll, UnrollAndJam, Unrecognized,
- NoVector, NoUnroll, NoUnrollAndJam>
+ VectorAlways, std::list<NameValue>, 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<ModuleCheckSumType> 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<SourceName> &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<UseDetails> 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<SourceName> 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<UseDetails> 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<StatOrErrmsg>("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$ <anything else>
constexpr auto ignore_tkr{
"IGNORE_TKR" >> optionalList(construct<CompilerDirective::IgnoreTKR>(
@@ -1315,18 +1317,23 @@ constexpr auto nounroll{"NOUNROLL" >> construct<CompilerDirective::NoUnroll>()};
constexpr auto nounrollAndJam{
"NOUNROLL_AND_JAM" >> construct<CompilerDirective::NoUnrollAndJam>()};
TYPE_PARSER(beginDirective >> "DIR$ "_tok >>
- sourced((construct<CompilerDirective>(ignore_tkr) ||
- construct<CompilerDirective>(loopCount) ||
- construct<CompilerDirective>(assumeAligned) ||
- construct<CompilerDirective>(vectorAlways) ||
- construct<CompilerDirective>(unrollAndJam) ||
- construct<CompilerDirective>(unroll) ||
- construct<CompilerDirective>(novector) ||
- construct<CompilerDirective>(nounrollAndJam) ||
- construct<CompilerDirective>(nounroll) ||
- construct<CompilerDirective>(
- many(construct<CompilerDirective::NameValue>(
- name, maybe(("="_tok || ":"_tok) >> digitString64))))) /
+ sourced(
+ (construct<CompilerDirective>(ignore_tkr) ||
+ construct<CompilerDirective>(loopCount) ||
+ construct<CompilerDirective>(assumeAligned) ||
+ construct<CompilerDirective>(vectorAlways) ||
+ construct<CompilerDirective>(unrollAndJam) ||
+ construct<CompilerDirective>(unroll) ||
+ construct<CompilerDirective>(novector) ||
+ construct<CompilerDirective>(nounrollAndJam) ||
+ construct<CompilerDirective>(nounroll) ||
+ construct<CompilerDirective>("BEGIN_NESTED_HERMETIC_MODULE" >>
+ construct<CompilerDirective::BeginNestedHermeticModule>()) ||
+ construct<CompilerDirective>("End_NESTED_HERMETIC_MODULE" >>
+ construct<CompilerDirective::EndNestedHermeticModule>()) ||
+ construct<CompilerDirective>(
+ many(construct<CompilerDirective::NameValue>(
+ name, maybe(("="_tok || ":"_tok) >> digitString64))))) /
endOfStmt ||
construct<CompilerDirective>(pure<CompilerDirective::Unrecognized>()) /
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..55fcb435ba91e 100644
--- a/flang/lib/Semantics/mod-file.cpp
+++ b/flang/lib/Semantics/mod-file.cpp
@@ -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<ModuleDetails &>(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<ModuleDetails>().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<ModuleDetails>() || symbol.owner().IsIntrinsicModules() ||
@@ -245,15 +254,18 @@ static void HarvestSymbolsNeededFromOtherModules(
if (symbol.scope()) {
HarvestSymbolsNeededFromOtherModules(set, *symbol.scope());
}
- } else if (const auto &generic{symbol.detailsIf<GenericDetails>()};
- generic && generic->derivedType()) {
- const Symbol &dtSym{*generic->derivedType()};
- if (dtSym.has<DerivedTypeDetails>()) {
- if (dtSym.scope()) {
- HarvestSymbolsNeededFromOtherModules(set, *dtSym.scope());
+ } else if (const auto *generic{symbol.detailsIf<GenericDetails>()}) {
+ if (const Symbol *dtSym{generic->derivedType()}) {
+ if (dtSym->has<DerivedTypeDetails>()) {
+ if (dtSym->scope()) {
+ HarvestSymbolsNeededFromOtherModules(set, *dtSym->scope());
+ }
+ } else {
+ CHECK(dtSym->has<UseDetails>() || dtSym->has<UseErrorDetails>());
}
- } else {
- CHECK(dtSym.has<UseDetails>() || dtSym.has<UseErrorDetails>());
+ }
+ for (const Symbol &specific : generic->specificProcs()) {
+ set.emplace(specific);
}
} else if (const auto *object{symbol.detailsIf<ObjectEntityDetails>()}) {
HarvestArraySpec(object->shape());
@@ -306,38 +318,38 @@ 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<GenericDetails>()}) {
- if (generic->derivedType() == &*s || generic->specific() == &*s) {
- continue;
- }
- } else if (found->has<UseDetails>()) {
- if (&found->GetUltimate() == &*s) {
+ if (found->has<UseDetails>()) {
+ if (&found->GetUltimate() == &s) {
continue; // already use-associated with same name
}
+ } else if (const auto *generic{found->detailsIf<GenericDetails>()}) {
+ if (generic->derivedType() == &s || generic->specific() == &s) {
+ continue;
+ }
}
- 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 +359,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';
}
}
@@ -794,11 +806,13 @@ static bool IsIntrinsicOp(const Symbol &symbol) {
}
void ModFileWriter::PutGeneric(const Symbol &symbol) {
- const auto &genericOwner{symbol.owner()};
auto &details{symbol.get<GenericDetails>()};
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';
}
}
@@ -852,19 +866,13 @@ void CollectSymbols(const Scope &scope, SymbolVector &sorted,
std::size_t commonSize{scope.commonBlocks().size()};
sorted.reserve(symbols.size() + commonSize);
for (SymbolRef symbol : symbols) {
- const auto *generic{symbol->detailsIf<GenericDetails>()};
- if (generic) {
- uses.insert(uses.end(), generic->uses().begin(), generic->uses().end());
- for (auto ref : generic->uses()) {
- modules.insert(GetUsedModule(ref->get<UseDetails>()));
- }
- } else if (const auto *use{symbol->detailsIf<UseDetails>()}) {
+ if (const auto *use{symbol->detailsIf<UseDetails>()}) {
modules.insert(GetUsedModule(*use));
}
if (symbol->test(Symbol::Flag::ParentComp)) {
} else if (symbol->has<NamelistDetails>()) {
namelist.push_back(symbol);
- } else if (generic) {
+ } else if (const auto *generic{symbol->detailsIf<GenericDetails>()}) {
if (generic->specific() &&
&generic->specific()->owner() == &symbol->owner()) {
sorted.push_back(*generic->specific());
@@ -1342,6 +1350,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<parser::ProgramUnit> &progUnits) {
+ // Extract the first module into its own Program.
+ std::list<parser::ProgramUnit> justFirst;
+ CHECK(!progUnits.empty() &&
+ std::holds_alternative<common::Indirection<parser::Module>>(
+ 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<parser::ProgramUnit> normals, hermetics;
+ while (!progUnits.empty()) {
+ if (const auto *dir{
+ std::get_if<common::Indirection<parser::CompilerDirective>>(
+ &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<parser::ProgramUnit> nested;
+ while (!progUnits.empty()) {
+ if (auto *dir{
+ std::get_if<common::Indirection<parser::CompilerDirective>>(
+ &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<ModuleDetails>().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<ModuleDetails>());
+ 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<bool> isIntrinsic,
Scope *ancestor, bool silent) {
std::string ancestorName; // empty for module
@@ -1548,23 +1664,14 @@ Scope *ModFileReader::Read(SourceName name, std::optional<bool> 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<ModuleDetails>());
- 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 +1689,7 @@ Scope *ModFileReader::Read(SourceName name, std::optional<bool> isIntrinsic,
auto &details{moduleSymbol->get<ModuleDetails>()};
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..cb9bbc13ccee4 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<UseDetails>()};
- if (!useDetails) {
- if (auto *genericDetails{symbol.detailsIf<GenericDetails>()}) {
- if (!genericDetails->uses().empty()) {
- useDetails = &genericDetails->uses().at(0)->get<UseDetails>();
- }
- }
- }
- if (useDetails) {
+ if (const auto *useDetails{symbol.detailsIf<UseDetails>()}) {
symbol.set_details(
UseErrorDetails{*useDetails}.add_occurrence(location, used));
return true;
}
+ if (const auto *genericDetails{symbol.detailsIf<GenericDetails>()}) {
+ 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 && hostAssocDetails->symbol().has<SubprogramDetails>() &&
&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<GenericDetails>();
- localGeneric->AddUse(*localSymbol);
+ localGeneric->set_originalUseDetails(localSymbol->get<UseDetails>());
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<GenericDetails>()};
- 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
diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp
index 52f74035bd6a8..b4465e9f1839c 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<UseDetails>());
- uses_.push_back(use);
-}
-
const Symbol *GenericDetails::CheckSpecific() const {
return const_cast<GenericDetails *>(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<SourceName> 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]);
}
@@ -553,17 +569,6 @@ 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 << ')';
- }
os << " procs:";
DumpSymbolVector(os, x.specificProcs());
return os;
@@ -593,6 +598,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
More information about the flang-commits
mailing list