diff --git a/flang/include/flang/Semantics/symbol-set-closure.h b/flang/include/flang/Semantics/symbol-set-closure.h new file mode 100644 index 0000000000000..030aec44d1648 --- /dev/null +++ b/flang/include/flang/Semantics/symbol-set-closure.h @@ -0,0 +1,35 @@ +//===-- include/flang/Semantics/symbol-set-closure.h ------------*- C++ -*-===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#ifndef FORTRAN_SEMANTICS_SYMBOLS_SET_CLOSURE_H_ +#define FORTRAN_SEMANTICS_SYMBOLS_SET_CLOSURE_H_ + +#include "flang/Semantics/symbol.h" + +namespace Fortran::semantics { + +// For a set or scope of symbols, computes the transitive closure of their +// dependences due to their types, bounds, specific procedures, interfaces, +// initialization, storage association, &c. Includes the original symbol +// or members of the original set. Does not include dependences from +// subprogram definitions, only their interfaces. +enum DependenceCollectionFlags { + NoDependenceCollectionFlags = 0, + IncludeOriginalSymbols = 1 << 0, + FollowUseAssociations = 1 << 1, + IncludeSpecificsOfGenerics = 1 << 2, + IncludeComponentsInExprs = 1 << 3, +}; + +SymbolVector CollectAllDependences( + const UnorderedSymbolSet &, int = NoDependenceCollectionFlags); +SymbolVector CollectAllDependences( + const Scope &, int = NoDependenceCollectionFlags); + +} // namespace Fortran::semantics +#endif // FORTRAN_SEMANTICS_SYMBOLS_SET_CLOSURE_H_ diff --git a/flang/lib/Semantics/CMakeLists.txt b/flang/lib/Semantics/CMakeLists.txt index c0fda3631c01f..84e2f3f22f63b 100644 --- a/flang/lib/Semantics/CMakeLists.txt +++ b/flang/lib/Semantics/CMakeLists.txt @@ -45,6 +45,7 @@ add_flang_library(FortranSemantics scope.cpp semantics.cpp symbol.cpp + symbol-set-closure.cpp tools.cpp type.cpp unparse-with-symbols.cpp diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp index 82c8536902eb2..b1474974b4219 100644 --- a/flang/lib/Semantics/mod-file.cpp +++ b/flang/lib/Semantics/mod-file.cpp @@ -15,6 +15,7 @@ #include "flang/Parser/unparse.h" #include "flang/Semantics/scope.h" #include "flang/Semantics/semantics.h" +#include "flang/Semantics/symbol-set-closure.h" #include "flang/Semantics/symbol.h" #include "flang/Semantics/tools.h" #include "llvm/Support/FileSystem.h" @@ -130,7 +131,7 @@ static std::string ModFileName(const SourceName &name, return ancestorName.empty() ? result : ancestorName + '-' + result; } -// Write the module file for symbol, which must be a module or submodule. +// Writes the module file for symbol, which must be a module or submodule. void ModFileWriter::Write(const Symbol &symbol) { const auto &module{symbol.get()}; if (symbol.test(Symbol::Flag::ModFile) || module.moduleFileHash()) { @@ -142,26 +143,14 @@ void ModFileWriter::Write(const Symbol &symbol) { std::string path{context_.moduleDirectory() + '/' + ModFileName(symbol.name(), ancestorName, context_.moduleFileSuffix())}; - std::set hermeticModuleNames; - hermeticModuleNames.insert(symbol.name().ToString()); - UnorderedSymbolSet additionalModules; - PutSymbols(DEREF(symbol.scope()), - hermeticModuleFileOutput_ ? &additionalModules : nullptr); - auto asStr{GetAsString(symbol)}; - while (!additionalModules.empty()) { - UnorderedSymbolSet nextPass{std::move(additionalModules)}; - additionalModules.clear(); - for (const Symbol &modSym : nextPass) { - if (!modSym.owner().IsIntrinsicModules() && - hermeticModuleNames.find(modSym.name().ToString()) == - hermeticModuleNames.end()) { - hermeticModuleNames.insert(modSym.name().ToString()); - PutSymbols(DEREF(modSym.scope()), &additionalModules); - asStr += GetAsString(modSym); - } - } + SymbolVector dependenceClosure; + if (hermeticModuleFileOutput_) { + dependenceClosure = CollectAllDependences(DEREF(symbol.scope()), + FollowUseAssociations | IncludeSpecificsOfGenerics); } - + PutSymbols(DEREF(symbol.scope()), hermeticModuleFileOutput_); + auto asStr{GetAsString(&symbol, symbol.name().ToString())}; + asStr += PutDependencyModules(symbol.name().ToString(), dependenceClosure); ModuleCheckSumType checkSum; if (std::error_code error{ WriteFile(path, asStr, checkSum, context_.debugModuleWriter())}) { @@ -177,9 +166,9 @@ void ModFileWriter::WriteClosure(llvm::raw_ostream &out, const Symbol &symbol, !nonIntrinsicModulesWritten.insert(symbol).second) { return; } - PutSymbols(DEREF(symbol.scope()), /*hermeticModules=*/nullptr); + PutSymbols(DEREF(symbol.scope()), /*omitModules=*/false); needsBuf_.clear(); // omit module checksums - auto str{GetAsString(symbol)}; + auto str{GetAsString(&symbol, symbol.name().ToString())}; for (auto depRef : std::move(usedNonIntrinsicModules_)) { WriteClosure(out, *depRef, nonIntrinsicModulesWritten); } @@ -188,22 +177,23 @@ void ModFileWriter::WriteClosure(llvm::raw_ostream &out, const Symbol &symbol, // Return the entire body of the module file // and clear saved uses, decls, and contains. -std::string ModFileWriter::GetAsString(const Symbol &symbol) { +std::string ModFileWriter::GetAsString(const Symbol *symbol, std::string name) { std::string buf; llvm::raw_string_ostream all{buf}; all << needs_.str(); needs_.str().clear(); - auto &details{symbol.get()}; - if (!details.isSubmodule()) { - all << "module " << symbol.name(); + const ModuleDetails *details{ + symbol ? &symbol->get() : nullptr}; + if (!details || !details->isSubmodule()) { + all << "module " << name; } else { - auto *parent{details.parent()->symbol()}; - auto *ancestor{details.ancestor()->symbol()}; + auto *parent{details->parent()->symbol()}; + auto *ancestor{details->ancestor()->symbol()}; all << "submodule(" << ancestor->name(); if (parent != ancestor) { all << ':' << parent->name(); } - all << ") " << symbol.name(); + all << ") " << name; } all << '\n' << uses_.str(); uses_.str().clear(); @@ -223,78 +213,17 @@ std::string ModFileWriter::GetAsString(const Symbol &symbol) { // Collect symbols from constant and specification expressions that are being // referenced directly from other modules; they may require new USE // associations. -static void HarvestSymbolsNeededFromOtherModules( - SourceOrderedSymbolSet &, const Scope &); -static void HarvestSymbolsNeededFromOtherModules( - SourceOrderedSymbolSet &set, const Symbol &symbol, const Scope &scope) { - auto HarvestBound{[&](const Bound &bound) { - if (const auto &expr{bound.GetExplicit()}) { - for (SymbolRef ref : evaluate::CollectSymbols(*expr)) { - set.emplace(*ref); - } - } - }}; - auto HarvestShapeSpec{[&](const ShapeSpec &shapeSpec) { - HarvestBound(shapeSpec.lbound()); - HarvestBound(shapeSpec.ubound()); - }}; - auto HarvestArraySpec{[&](const ArraySpec &arraySpec) { - for (const auto &shapeSpec : arraySpec) { - HarvestShapeSpec(shapeSpec); - } - }}; - - if (symbol.has()) { - 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 { - CHECK(dtSym.has() || dtSym.has()); - } - } else if (const auto *object{symbol.detailsIf()}) { - HarvestArraySpec(object->shape()); - HarvestArraySpec(object->coshape()); - if (IsNamedConstant(symbol) || scope.IsDerivedType()) { - if (object->init()) { - for (SymbolRef ref : evaluate::CollectSymbols(*object->init())) { - set.emplace(*ref); - } - } - } - } else if (const auto *proc{symbol.detailsIf()}) { - if (proc->init() && *proc->init() && scope.IsDerivedType()) { - set.emplace(**proc->init()); - } - } else if (const auto *subp{symbol.detailsIf()}) { - for (const Symbol *dummy : subp->dummyArgs()) { - if (dummy) { - HarvestSymbolsNeededFromOtherModules(set, *dummy, scope); - } - } - if (subp->isFunction()) { - HarvestSymbolsNeededFromOtherModules(set, subp->result(), scope); - } - } -} - static void HarvestSymbolsNeededFromOtherModules( SourceOrderedSymbolSet &set, const Scope &scope) { - for (const auto &[_, symbol] : scope) { - HarvestSymbolsNeededFromOtherModules(set, *symbol, scope); + for (const Symbol &symbol : CollectAllDependences(scope)) { + set.insert(symbol); } } void ModFileWriter::PrepareRenamings(const Scope &scope) { // Identify use-associated symbols already in scope under some name std::map useMap; - for (const auto &[name, symbolRef] : scope) { + for (const auto &[_, symbolRef] : scope) { const Symbol *symbol{&*symbolRef}; while (const auto *hostAssoc{symbol->detailsIf()}) { symbol = &hostAssoc->symbol(); @@ -309,38 +238,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 &sym : symbolsNeeded) { + if (sym.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(sym.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(&sym)}; iter != useMap.end()) { + renamings.emplace(&sym, iter->second->name()); continue; } - SourceName rename{s->name()}; - if (const Symbol * found{scope.FindSymbol(s->name())}) { - if (found == &*s) { + SourceName rename{sym.name()}; + if (const Symbol *found{scope.FindSymbol(sym.name())}) { + if (found == &sym) { continue; // available in scope } if (const auto *generic{found->detailsIf()}) { - if (generic->derivedType() == &*s || generic->specific() == &*s) { + if (generic->derivedType() == &sym || generic->specific() == &sym) { continue; } } else if (found->has()) { - if (&found->GetUltimate() == &*s) { + if (&found->GetUltimate() == &sym) { continue; // already use-associated with same name } } - if (&s->owner() != &found->owner()) { // Symbol needs renaming + if (&sym.owner() != &found->owner()) { // Symbol needs renaming rename = scope.context().SaveTempName( DEREF(sMod->symbol()).name().ToString() + "$" + - s->name().ToString()); + sym.name().ToString()); } } // Symbol is used in this scope but not visible under its name @@ -350,18 +279,17 @@ void ModFileWriter::PrepareRenamings(const Scope &scope) { uses_ << "use "; } uses_ << DEREF(sMod->symbol()).name() << ",only:"; - if (rename != s->name()) { + if (rename != sym.name()) { uses_ << rename << "=>"; - renamings.emplace(&s->GetUltimate(), rename); + renamings.emplace(&sym.GetUltimate(), rename); } - uses_ << s->name() << '\n'; + uses_ << sym.name() << '\n'; useExtraAttrs_ << "private::" << rename << '\n'; } } // Put out the visible symbols from scope. -void ModFileWriter::PutSymbols( - const Scope &scope, UnorderedSymbolSet *hermeticModules) { +void ModFileWriter::PutSymbols(const Scope &scope, bool omitModules) { SymbolVector sorted; SymbolVector uses; auto &renamings{context_.moduleFileOutputRenamings()}; @@ -369,12 +297,10 @@ void ModFileWriter::PutSymbols( PrepareRenamings(scope); SourceOrderedSymbolSet modules; CollectSymbols(scope, sorted, uses, modules); - // Write module files for dependencies first so that their + // Write module files for compiled dependency modules first so that their // hashes are known. - for (const Symbol &mod : modules) { - if (hermeticModules) { - hermeticModules->insert(mod); - } else { + if (!omitModules) { + for (const Symbol &mod : modules) { Write(mod); // It's possible that the module's file already existed and // without its own hash due to being embedded in a hermetic @@ -412,6 +338,86 @@ void ModFileWriter::PutSymbols( renamings = std::move(previousRenamings); } +std::string ModFileWriter::PutDependencyModules( + std::string originalModuleName, const SymbolVector &revOrder) { + // Partition symbols by module name. + // Ignore symbols from intrinsic modules and the original module. + std::map perModuleName; + for (const Symbol &symbol : revOrder) { + if (const Scope *module{FindModuleContaining(symbol.owner())}) { + if (!module->parent().IsIntrinsicModules()) { + if (auto name{module->GetName()}) { + if (getenv("PMK") && name->ToString() == originalModuleName) + llvm::errs() << "pmk: from original module: " << symbol << '\n'; + perModuleName[name->ToString()].emplace_back(symbol); + } + } + } + } + std::string result; + for (const auto &[moduleName, symbols] : perModuleName) { + if (moduleName != originalModuleName) { + result += PutDependencyModule(moduleName, symbols); + } + } + return result; +} + +std::string ModFileWriter::PutDependencyModule( + const std::string &moduleName, const SymbolVector &symbols) { + SymbolVector order, namelists, generics; + std::set names, commonNames, genericNames; + order.reserve(symbols.size()); + for (const Symbol &symbol : symbols) { + std::string symbolName{symbol.name().ToString()}; + if (symbol.test(Symbol::Flag::ParentComp) || + symbol.test(Symbol::Flag::CompilerCreated) || + !symbol.owner().IsModule()) { + } else if (symbol.has()) { + if (commonNames.find(symbolName) == commonNames.end()) { + order.push_back(symbol); + commonNames.insert(symbolName); + } + } else if (const auto *generic{symbol.detailsIf()}) { + if (names.find(symbolName) == names.end()) { + if (generic->specific() && + &generic->specific()->owner() == &symbol.owner()) { + order.push_back(*generic->specific()); + names.insert(symbolName); + } else if (generic->derivedType() && + &generic->derivedType()->owner() == &symbol.owner()) { + order.push_back(*generic->derivedType()); + names.insert(symbolName); + } + } + if (genericNames.find(symbolName) == genericNames.end()) { + generics.push_back(symbol); + genericNames.insert(symbolName); + } + } else if (names.find(symbolName) != names.end()) { + } else if (symbol.has()) { + namelists.push_back(symbol); + names.insert(symbolName); + } else { + order.push_back(symbol); + names.insert(symbolName); + } + } + order.insert(order.end(), generics.begin(), generics.end()); + order.insert(order.end(), namelists.begin(), namelists.end()); + // Emit the symbols + std::string buf; + llvm::raw_string_ostream typeBindings{buf}; + for (const Symbol &symbol : order) { + if (getenv("PMK")) + llvm::errs() << "pmk: putting " << symbol << '\n'; + PutSymbol(typeBindings, symbol); + } + // pmk TODO: equivalence sets + CHECK(typeBindings.str().empty()); + return GetAsString(nullptr, moduleName); +} + // Emit components in order bool ModFileWriter::PutComponents(const Symbol &typeSymbol) { const auto &scope{DEREF(typeSymbol.scope())}; diff --git a/flang/lib/Semantics/mod-file.h b/flang/lib/Semantics/mod-file.h index 9e5724089b3c5..98884f3067f3e 100644 --- a/flang/lib/Semantics/mod-file.h +++ b/flang/lib/Semantics/mod-file.h @@ -66,9 +66,13 @@ class ModFileWriter { void WriteAll(const Scope &); void WriteOne(const Scope &); void Write(const Symbol &); - std::string GetAsString(const Symbol &); + std::string GetAsString(const Symbol *, std::string); void PrepareRenamings(const Scope &); - void PutSymbols(const Scope &, UnorderedSymbolSet *hermetic); + void PutSymbols(const Scope &, bool omitModules); + std::string PutDependencyModules( + std::string originalModuleName, const SymbolVector &); + std::string PutDependencyModule( + const std::string &modName, const SymbolVector &); // Returns true if a derived type with bindings and "contains" was emitted bool PutComponents(const Symbol &); void PutSymbol(llvm::raw_ostream &, const Symbol &); diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 9e465f8ff3e1e..d9177dcb80694 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -7416,7 +7416,8 @@ void DeclarationVisitor::SetType( std::optional DeclarationVisitor::ResolveDerivedType( const parser::Name &name) { Scope &outer{NonDerivedTypeScope()}; - Symbol *symbol{FindSymbol(outer, name)}; + Symbol *original{FindSymbol(outer, name)}; + Symbol *symbol{original}; Symbol *ultimate{symbol ? &symbol->GetUltimate() : nullptr}; auto *generic{ultimate ? ultimate->detailsIf() : nullptr}; if (generic) { @@ -7429,11 +7430,12 @@ std::optional DeclarationVisitor::ResolveDerivedType( (generic && &ultimate->owner() == &outer)) { if (allowForwardReferenceToDerivedType()) { if (!symbol) { - symbol = &MakeSymbol(outer, name.source, Attrs{}); + symbol = original = &MakeSymbol(outer, name.source, Attrs{}); Resolve(name, *symbol); } else if (generic) { // forward ref to type with later homonymous generic - symbol = &outer.MakeSymbol(name.source, Attrs{}, UnknownDetails{}); + symbol = original = + &outer.MakeSymbol(name.source, Attrs{}, UnknownDetails{}); generic->set_derivedType(*symbol); name.symbol = symbol; } @@ -7453,7 +7455,7 @@ std::optional DeclarationVisitor::ResolveDerivedType( if (CheckUseError(name)) { return std::nullopt; } else if (symbol->GetUltimate().has()) { - return DerivedTypeSpec{name.source, *symbol}; + return DerivedTypeSpec{name.source, *original}; } else { Say(name, "'%s' is not a derived type"_err_en_US); return std::nullopt; diff --git a/flang/lib/Semantics/semantics.cpp b/flang/lib/Semantics/semantics.cpp index e07054f8ec564..efcba47a12f67 100644 --- a/flang/lib/Semantics/semantics.cpp +++ b/flang/lib/Semantics/semantics.cpp @@ -648,7 +648,8 @@ bool Semantics::Perform() { PerformStatementSemantics(context_, program_) && CanonicalizeDirectives(context_.messages(), program_) && ModFileWriter{context_} - .set_hermeticModuleFileOutput(hermeticModuleFileOutput_) + .set_hermeticModuleFileOutput( + hermeticModuleFileOutput_ || getenv("PMK_HERMETIC")) .WriteAll(); } diff --git a/flang/lib/Semantics/symbol-set-closure.cpp b/flang/lib/Semantics/symbol-set-closure.cpp new file mode 100644 index 0000000000000..3a7792ae7854b --- /dev/null +++ b/flang/lib/Semantics/symbol-set-closure.cpp @@ -0,0 +1,207 @@ +//===-- lib/Semantics/symbol-set-closure.cpp ------------------------------===// +// +// Part of the LLVM Project, under the Apache License v2.0 with LLVM Exceptions. +// See https://llvm.org/LICENSE.txt for license information. +// SPDX-License-Identifier: Apache-2.0 WITH LLVM-exception +// +//===----------------------------------------------------------------------===// + +#include "flang/Semantics/symbol-set-closure.h" +#include "flang/Common/idioms.h" +#include "flang/Common/visit.h" + +namespace Fortran::semantics { + +class Collector { +public: + explicit Collector(int flags) : flags_{flags} {} + + SymbolVector CollectedVector() { return std::move(vector_); } + + void operator()(const Symbol &x) { + if (set_.insert(x).second) { + vector_.emplace_back(x); + } + } + void operator()(SymbolRef x) { (*this)(*x); } + template void operator()(const std::optional &x) { + if (x) { + (*this)(*x); + } + } + template void operator()(const A *x) { + if (x) { + (*this)(*x); + } + } + void operator()(const UnorderedSymbolSet &x) { + for (const Symbol &symbol : x) { + (*this)(symbol); + } + } + void operator()(const SourceOrderedSymbolSet &x) { + for (const Symbol &symbol : x) { + (*this)(symbol); + } + } + void operator()(const Scope &x) { + for (const auto &[_, ref] : x) { + (*this)(*ref); + } + } + template void operator()(const evaluate::Expr &x) { + UnorderedSymbolSet exprSyms{evaluate::CollectSymbols(x)}; + for (const Symbol &sym : exprSyms) { + if (!sym.owner().IsDerivedType() || sym.has() || + (flags_ & IncludeComponentsInExprs)) { + (*this)(sym); + } + } + } + void operator()(const DeclTypeSpec &type) { + if (type.category() == DeclTypeSpec::Category::Character) { + (*this)(type.characterTypeSpec().length()); + } else { + (*this)(type.AsDerived()); + } + } + void operator()(const DerivedTypeSpec &type) { + (*this)(type.originalTypeSymbol()); + for (const auto &[_, value] : type.parameters()) { + (*this)(value); + } + } + void operator()(const ParamValue &x) { (*this)(x.GetExplicit()); } + void operator()(const Bound &x) { (*this)(x.GetExplicit()); } + void operator()(const ShapeSpec &x) { + (*this)(x.lbound()); + (*this)(x.ubound()); + } + void operator()(const ArraySpec &x) { + for (const ShapeSpec &shapeSpec : x) { + (*this)(shapeSpec); + } + } + +private: + UnorderedSymbolSet set_; + SymbolVector vector_; + int flags_{NoDependenceCollectionFlags}; +}; + +SymbolVector CollectAllDependences(const Scope &scope, int flags) { + UnorderedSymbolSet basis; + for (const auto &[_, symbol] : scope) { + basis.insert(*symbol); + } + return CollectAllDependences(basis, flags); +} + +SymbolVector CollectAllDependences( + const UnorderedSymbolSet &original, int flags) { + UnorderedSymbolSet resultSet; + SymbolVector resultVector; + SymbolVector work; + if (flags & IncludeOriginalSymbols) { + resultSet = original; + } + for (const Symbol &symbol : original) { + work.emplace_back(symbol); + if (flags & IncludeOriginalSymbols) { + resultVector.emplace_back(symbol); + } + } + // Sort the initial work list by source position to make the module + // file output order deterministic. + std::sort(work.begin(), work.end(), SymbolSourcePositionCompare{}); + while (!work.empty()) { + Collector collect{flags}; + for (const Symbol &symbol : work) { + if (symbol.test(Symbol::Flag::CompilerCreated)) { + continue; + } + collect(symbol.GetType()); + common::visit( + common::visitors{ + [&collect, &symbol](const ObjectEntityDetails &x) { + collect(x.shape()); + collect(x.coshape()); + if (IsNamedConstant(symbol) || symbol.owner().IsDerivedType()) { + collect(x.init()); + } + collect(x.commonBlock()); + if (const auto *set{FindEquivalenceSet(symbol)}) { + for (const EquivalenceObject &equivObject : *set) { + collect(equivObject.symbol); + } + } + }, + [&collect, &symbol](const ProcEntityDetails &x) { + collect(x.rawProcInterface()); + if (symbol.owner().IsDerivedType()) { + collect(x.init()); + } + // TODO: worry about procedure pointers in common blocks? + }, + [&collect](const ProcBindingDetails &x) { collect(x.symbol()); }, + [&collect](const SubprogramDetails &x) { + for (const Symbol *dummy : x.dummyArgs()) { + collect(dummy); + } + if (x.isFunction()) { + collect(x.result()); + } + }, + [&collect, &symbol](const DerivedTypeDetails &x) { + collect(symbol.scope()); + for (const auto &[_, symbolRef] : x.finals()) { + collect(*symbolRef); + } + }, + [&collect, flags](const GenericDetails &x) { + collect(x.derivedType()); + collect(x.specific()); + for (const Symbol &use : x.uses()) { + collect(use); + } + if (flags & IncludeSpecificsOfGenerics) { + for (const Symbol &specific : x.specificProcs()) { + collect(specific); + } + } + }, + [&collect](const NamelistDetails &x) { + for (const Symbol &symbol : x.objects()) { + collect(symbol); + } + }, + [&collect](const CommonBlockDetails &x) { + for (auto ref : x.objects()) { + collect(*ref); + } + }, + [&collect, &symbol, flags](const UseDetails &x) { + if (flags & FollowUseAssociations) { + collect(x.symbol()); + } + }, + [&collect](const HostAssocDetails &x) { collect(x.symbol()); }, + [](const auto &) {}, + }, + symbol.details()); + } + work.clear(); + for (const Symbol &symbol : collect.CollectedVector()) { + if (resultSet.find(symbol) == resultSet.end() && + ((flags & IncludeOriginalSymbols) || + original.find(symbol) == original.end())) { + resultSet.insert(symbol); + resultVector.emplace_back(symbol); + work.emplace_back(symbol); + } + } + } + return resultVector; +} + +} // namespace Fortran::semantics diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp index bf520d04a50cc..adaad89b0bcfd 100644 --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -6,15 +6,15 @@ // //===----------------------------------------------------------------------===// -#include "flang/Parser/tools.h" +#include "flang/Semantics/tools.h" #include "flang/Common/indirection.h" #include "flang/Parser/dump-parse-tree.h" #include "flang/Parser/message.h" #include "flang/Parser/parse-tree.h" +#include "flang/Parser/tools.h" #include "flang/Semantics/scope.h" #include "flang/Semantics/semantics.h" #include "flang/Semantics/symbol.h" -#include "flang/Semantics/tools.h" #include "flang/Semantics/type.h" #include "flang/Support/Fortran.h" #include "llvm/ADT/StringSwitch.h" @@ -2117,4 +2117,4 @@ bool IsSameOrConvertOf(const SomeExpr &expr, const SomeExpr &x) { return false; } } -} // namespace Fortran::semantics \ No newline at end of file +} // namespace Fortran::semantics diff --git a/flang/lib/Semantics/type.cpp b/flang/lib/Semantics/type.cpp index 964a37e1c822b..4a56902524417 100644 --- a/flang/lib/Semantics/type.cpp +++ b/flang/lib/Semantics/type.cpp @@ -22,9 +22,19 @@ namespace Fortran::semantics { +static const Symbol &ResolveOriginalTypeSymbol(const Symbol *symbol) { + symbol = &symbol->GetUltimate(); + if (const auto *generic{symbol->detailsIf()}) { + CHECK(generic->derivedType() != nullptr); + return generic->derivedType()->GetUltimate(); + } else { + return *symbol; + } +} + DerivedTypeSpec::DerivedTypeSpec(SourceName name, const Symbol &typeSymbol) : name_{name}, originalTypeSymbol_{typeSymbol}, - typeSymbol_{typeSymbol.GetUltimate()} { + typeSymbol_{ResolveOriginalTypeSymbol(&typeSymbol)} { CHECK(typeSymbol_.has()); } DerivedTypeSpec::DerivedTypeSpec(const DerivedTypeSpec &that) = default; diff --git a/flang/test/Semantics/modfile65.f90 b/flang/test/Semantics/modfile65.f90 index 249255e02129f..3eabf47d4d55e 100644 --- a/flang/test/Semantics/modfile65.f90 +++ b/flang/test/Semantics/modfile65.f90 @@ -42,12 +42,12 @@ module m4 !use m2,only:n !use m3,only:m !end +!module m1 +!integer(4),parameter::n=123_4 +!end !module m2 !use m1,only:n !end !module m3 !use m1,only:m=>n !end -!module m1 -!integer(4),parameter::n=123_4 -!end diff --git a/flang/test/Semantics/modfile78.F90 b/flang/test/Semantics/modfile78.F90 index 19b9ac39de934..f612c2fa30d64 100644 --- a/flang/test/Semantics/modfile78.F90 +++ b/flang/test/Semantics/modfile78.F90 @@ -27,7 +27,6 @@ module modfile78c !CHECK: integer(4)::global_variable !CHECK: end !CHECK: module modfile78b -!CHECK: use modfile78a,only:global_variable !CHECK: contains !CHECK: subroutine test() !CHECK: end