diff --git a/flang/docs/ModFiles.md b/flang/docs/ModFiles.md index 7463454c8563a..a4c2395d308fb 100644 --- a/flang/docs/ModFiles.md +++ b/flang/docs/ModFiles.md @@ -164,3 +164,13 @@ a diagnostic but we still wouldn't have line numbers. To provide line numbers and character positions or source lines as the user wrote them we would have to save some amount of provenance information in the module file as well. + +## Hermetic modules files + +Top-level module files for libraries can be build with `-fhermetic-module-files`. +This option causes these module files to contain copies of all of the non-intrinsic +modules on which they depend, so that non-top-level local modules and the +modules of dependent libraries need not also be packaged with the library. +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`. diff --git a/flang/include/flang/Common/Fortran-features.h b/flang/include/flang/Common/Fortran-features.h index 44f88009f8f2c..9549e8bfbbef0 100644 --- a/flang/include/flang/Common/Fortran-features.h +++ b/flang/include/flang/Common/Fortran-features.h @@ -73,7 +73,8 @@ ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable, PreviousScalarUse, RedeclaredInaccessibleComponent, ImplicitShared, IndexVarRedefinition, IncompatibleImplicitInterfaces, BadTypeForTarget, VectorSubscriptFinalization, UndefinedFunctionResult, UselessIomsg, - MismatchingDummyProcedure, SubscriptedEmptyArray, UnsignedLiteralTruncation) + MismatchingDummyProcedure, SubscriptedEmptyArray, UnsignedLiteralTruncation, + CompatibleDeclarationsFromDistinctModules) using LanguageFeatures = EnumSet; using UsageWarnings = EnumSet; diff --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h index 1f9296ac4fea7..a4afe49d6077a 100644 --- a/flang/include/flang/Evaluate/type.h +++ b/flang/include/flang/Evaluate/type.h @@ -510,6 +510,8 @@ bool AreSameDerivedType( const semantics::DerivedTypeSpec &, const semantics::DerivedTypeSpec &); bool AreSameDerivedTypeIgnoringTypeParameters( const semantics::DerivedTypeSpec &, const semantics::DerivedTypeSpec &); +bool AreSameDerivedTypeIgnoringSequence( + const semantics::DerivedTypeSpec &, const semantics::DerivedTypeSpec &); // For generating "[extern] template class", &c. boilerplate #define EXPAND_FOR_EACH_INTEGER_KIND(M, P, S) \ diff --git a/flang/include/flang/Semantics/semantics.h b/flang/include/flang/Semantics/semantics.h index c981d86fbd94c..821ce021b3226 100644 --- a/flang/include/flang/Semantics/semantics.h +++ b/flang/include/flang/Semantics/semantics.h @@ -110,6 +110,12 @@ class SemanticsContext { } Scope &globalScope() { return globalScope_; } Scope &intrinsicModulesScope() { return intrinsicModulesScope_; } + Scope *currentHermeticModuleFileScope() { + return currentHermeticModuleFileScope_; + } + void set_currentHermeticModuleFileScope(Scope *scope) { + currentHermeticModuleFileScope_ = scope; + } parser::Messages &messages() { return messages_; } evaluate::FoldingContext &foldingContext() { return foldingContext_; } parser::AllCookedSources &allCookedSources() { return allCookedSources_; } @@ -313,6 +319,7 @@ class SemanticsContext { evaluate::TargetCharacteristics targetCharacteristics_; Scope globalScope_; Scope &intrinsicModulesScope_; + Scope *currentHermeticModuleFileScope_{nullptr}; ScopeIndex scopeIndex_; parser::Messages messages_; evaluate::FoldingContext foldingContext_; diff --git a/flang/include/flang/Semantics/symbol.h b/flang/include/flang/Semantics/symbol.h index bc6abccac1bb8..235fade1ed937 100644 --- a/flang/include/flang/Semantics/symbol.h +++ b/flang/include/flang/Semantics/symbol.h @@ -605,12 +605,12 @@ class UseDetails { class UseErrorDetails { public: UseErrorDetails(const UseDetails &); - UseErrorDetails &add_occurrence(const SourceName &, const Scope &); - using listType = std::list>; - const listType occurrences() const { return occurrences_; }; + UseErrorDetails &add_occurrence(const SourceName &, const Symbol &); + using ListType = std::list>; + const ListType occurrences() const { return occurrences_; }; private: - listType occurrences_; + ListType occurrences_; }; // A symbol host-associated from an enclosing scope. diff --git a/flang/lib/Evaluate/type.cpp b/flang/lib/Evaluate/type.cpp index 0c2784d9cbe30..c8f75f91ed9c6 100644 --- a/flang/lib/Evaluate/type.cpp +++ b/flang/lib/Evaluate/type.cpp @@ -293,11 +293,13 @@ using SetOfDerivedTypePairs = static bool AreSameDerivedType(const semantics::DerivedTypeSpec &, const semantics::DerivedTypeSpec &, bool ignoreTypeParameterValues, - bool ignoreLenParameters, SetOfDerivedTypePairs &inProgress); + bool ignoreLenParameters, bool ignoreSequence, + SetOfDerivedTypePairs &inProgress); // F2023 7.5.3.2 static bool AreSameComponent(const semantics::Symbol &x, - const semantics::Symbol &y, SetOfDerivedTypePairs &inProgress) { + const semantics::Symbol &y, bool ignoreSequence, + SetOfDerivedTypePairs &inProgress) { if (x.attrs() != y.attrs()) { return false; } @@ -325,7 +327,8 @@ static bool AreSameComponent(const semantics::Symbol &x, !yType->IsUnlimitedPolymorphic() || (!xType->IsUnlimitedPolymorphic() && !AreSameDerivedType(xType->GetDerivedTypeSpec(), - yType->GetDerivedTypeSpec(), false, false, inProgress))) { + yType->GetDerivedTypeSpec(), false, false, ignoreSequence, + inProgress))) { return false; } } else if (!xType->IsTkLenCompatibleWith(*yType)) { @@ -449,7 +452,8 @@ static bool AreTypeParamCompatible(const semantics::DerivedTypeSpec &x, // F2023 7.5.3.2 static bool AreSameDerivedType(const semantics::DerivedTypeSpec &x, const semantics::DerivedTypeSpec &y, bool ignoreTypeParameterValues, - bool ignoreLenParameters, SetOfDerivedTypePairs &inProgress) { + bool ignoreLenParameters, bool ignoreSequence, + SetOfDerivedTypePairs &inProgress) { if (&x == &y) { return true; } @@ -472,7 +476,12 @@ static bool AreSameDerivedType(const semantics::DerivedTypeSpec &x, inProgress.insert(thisQuery); const auto &xDetails{xSymbol.get()}; const auto &yDetails{ySymbol.get()}; - if (!(xDetails.sequence() && yDetails.sequence()) && + if (xDetails.sequence() != yDetails.sequence() || + xSymbol.attrs().test(semantics::Attr::BIND_C) != + ySymbol.attrs().test(semantics::Attr::BIND_C)) { + return false; + } + if (!ignoreSequence && !(xDetails.sequence() && yDetails.sequence()) && !(xSymbol.attrs().test(semantics::Attr::BIND_C) && ySymbol.attrs().test(semantics::Attr::BIND_C))) { // PGI does not enforce this requirement; all other Fortran @@ -493,7 +502,8 @@ static bool AreSameDerivedType(const semantics::DerivedTypeSpec &x, const auto yLookup{ySymbol.scope()->find(*yComponentName)}; if (xLookup == xSymbol.scope()->end() || yLookup == ySymbol.scope()->end() || - !AreSameComponent(*xLookup->second, *yLookup->second, inProgress)) { + !AreSameComponent( + *xLookup->second, *yLookup->second, ignoreSequence, inProgress)) { return false; } } @@ -503,13 +513,19 @@ static bool AreSameDerivedType(const semantics::DerivedTypeSpec &x, bool AreSameDerivedType( const semantics::DerivedTypeSpec &x, const semantics::DerivedTypeSpec &y) { SetOfDerivedTypePairs inProgress; - return AreSameDerivedType(x, y, false, false, inProgress); + return AreSameDerivedType(x, y, false, false, false, inProgress); } bool AreSameDerivedTypeIgnoringTypeParameters( const semantics::DerivedTypeSpec &x, const semantics::DerivedTypeSpec &y) { SetOfDerivedTypePairs inProgress; - return AreSameDerivedType(x, y, true, true, inProgress); + return AreSameDerivedType(x, y, true, true, false, inProgress); +} + +bool AreSameDerivedTypeIgnoringSequence( + const semantics::DerivedTypeSpec &x, const semantics::DerivedTypeSpec &y) { + SetOfDerivedTypePairs inProgress; + return AreSameDerivedType(x, y, false, false, true, inProgress); } static bool AreSameDerivedType( @@ -536,7 +552,7 @@ static bool AreCompatibleDerivedTypes(const semantics::DerivedTypeSpec *x, } else { SetOfDerivedTypePairs inProgress; if (AreSameDerivedType(*x, *y, ignoreTypeParameterValues, - ignoreLenTypeParameters, inProgress)) { + ignoreLenTypeParameters, false, inProgress)) { return true; } else { return isPolymorphic && diff --git a/flang/lib/Semantics/mod-file.cpp b/flang/lib/Semantics/mod-file.cpp index 51ff70c3ed834..4367dd1dab395 100644 --- a/flang/lib/Semantics/mod-file.cpp +++ b/flang/lib/Semantics/mod-file.cpp @@ -1366,6 +1366,12 @@ Scope *ModFileReader::Read(SourceName name, std::optional isIntrinsic, name.ToString(), isIntrinsic.value_or(false))}; if (!isIntrinsic.value_or(false) && !ancestor) { // Already present in the symbol table as a usable non-intrinsic module? + if (Scope * hermeticScope{context_.currentHermeticModuleFileScope()}) { + auto it{hermeticScope->find(name)}; + if (it != hermeticScope->end()) { + return it->second->scope(); + } + } auto it{context_.globalScope().find(name)}; if (it != context_.globalScope().end()) { Scope *scope{it->second->scope()}; @@ -1544,9 +1550,22 @@ Scope *ModFileReader::Read(SourceName name, std::optional isIntrinsic, // Process declarations from the module file auto wasModuleFileName{context_.foldingContext().moduleFileName()}; context_.foldingContext().set_moduleFileName(name); + // Are there multiple modules in the module file due to it having been + // 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. + 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); + } GetModuleDependences(context_.moduleDependences(), sourceFile->content()); ResolveNames(context_, parseTree, topScope); context_.foldingContext().set_moduleFileName(wasModuleFileName); + context_.set_currentHermeticModuleFileScope(nullptr); if (!moduleSymbol) { // Submodule symbols' storage are owned by their parents' scopes, // but their names are not in their parents' dictionaries -- we diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index f3c2a5bf094d0..f4405855b43f3 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -2548,9 +2548,11 @@ void ScopeHandler::PopScope() { ConvertToObjectEntity(*pair.second); } funcResultStack_.Pop(); - // If popping back into a global scope, pop back to the main global scope. - SetScope(currScope_->parent().IsGlobal() ? context().globalScope() - : currScope_->parent()); + // If popping back into a global scope, pop back to the top scope. + Scope *hermetic{context().currentHermeticModuleFileScope()}; + SetScope(currScope_->parent().IsGlobal() + ? (hermetic ? *hermetic : context().globalScope()) + : currScope_->parent()); } void ScopeHandler::SetScope(Scope &scope) { currScope_ = &scope; @@ -3161,9 +3163,9 @@ ModuleVisitor::SymbolRename ModuleVisitor::AddUse( // symbol must be either a Use or a Generic formed by merging two uses. // Convert it to a UseError with this additional location. static bool ConvertToUseError( - Symbol &symbol, const SourceName &location, const Scope &module) { + Symbol &symbol, const SourceName &location, const Symbol &used) { if (auto *ued{symbol.detailsIf()}) { - ued->add_occurrence(location, module); + ued->add_occurrence(location, used); return true; } const auto *useDetails{symbol.detailsIf()}; @@ -3176,18 +3178,104 @@ static bool ConvertToUseError( } if (useDetails) { symbol.set_details( - UseErrorDetails{*useDetails}.add_occurrence(location, module)); + UseErrorDetails{*useDetails}.add_occurrence(location, used)); return true; } else { return false; } } +// Two ultimate symbols are distinct, but they have the same name and come +// from modules with the same name. At link time, their mangled names +// would conflict, so they had better resolve to the same definition. +// Check whether the two ultimate symbols have compatible definitions. +// Returns true if no further processing is required in DoAddUse(). +static bool CheckCompatibleDistinctUltimates(SemanticsContext &context, + SourceName location, SourceName localName, const Symbol &localSymbol, + const Symbol &localUltimate, const Symbol &useUltimate, bool &isError) { + isError = false; + if (localUltimate.has()) { + if (useUltimate.has() || + useUltimate.has() || + useUltimate.has()) { + return false; // can try to merge them + } else { + isError = true; + } + } else if (useUltimate.has()) { + if (localUltimate.has() || + localUltimate.has()) { + return false; // can try to merge them + } else { + isError = true; + } + } else if (localUltimate.has()) { + if (useUltimate.has()) { + auto localCharacteristics{ + evaluate::characteristics::Procedure::Characterize( + localUltimate, context.foldingContext())}; + auto useCharacteristics{ + evaluate::characteristics::Procedure::Characterize( + useUltimate, context.foldingContext())}; + if ((localCharacteristics && + (!useCharacteristics || + *localCharacteristics != *useCharacteristics)) || + (!localCharacteristics && useCharacteristics)) { + isError = true; + } + } else { + isError = true; + } + } else if (useUltimate.has()) { + isError = true; + } else if (const auto *localObject{ + localUltimate.detailsIf()}) { + if (const auto *useObject{useUltimate.detailsIf()}) { + auto localType{evaluate::DynamicType::From(localUltimate)}; + auto useType{evaluate::DynamicType::From(useUltimate)}; + if (localUltimate.size() != useUltimate.size() || + (localType && + (!useType || !localType->IsTkLenCompatibleWith(*useType) || + !useType->IsTkLenCompatibleWith(*localType))) || + (!localType && useType)) { + isError = true; + } else if (IsNamedConstant(localUltimate)) { + isError = !IsNamedConstant(useUltimate) || + !(*localObject->init() == *useObject->init()); + } else { + isError = IsNamedConstant(useUltimate); + } + } else { + isError = true; + } + } else if (useUltimate.has()) { + isError = true; + } else if (IsProcedurePointer(localUltimate)) { + isError = !IsProcedurePointer(useUltimate); + } else if (IsProcedurePointer(useUltimate)) { + isError = true; + } else if (localUltimate.has()) { + isError = !(useUltimate.has() && + evaluate::AreSameDerivedTypeIgnoringSequence( + DerivedTypeSpec{localUltimate.name(), localUltimate}, + DerivedTypeSpec{useUltimate.name(), useUltimate})); + } else if (useUltimate.has()) { + isError = true; + } else if (localUltimate.has() && + useUltimate.has()) { + } else if (localUltimate.has() && + useUltimate.has()) { + } else { + isError = true; + } + return true; // don't try to merge generics (or whatever) +} + void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, Symbol &originalLocal, const Symbol &useSymbol) { Symbol *localSymbol{&originalLocal}; if (auto *details{localSymbol->detailsIf()}) { - details->add_occurrence(location, *useModuleScope_); + details->add_occurrence(location, useSymbol); return; } const Symbol &useUltimate{useSymbol.GetUltimate()}; @@ -3224,6 +3312,40 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, return; } + if (localUltimate.name() == useUltimate.name() && + localUltimate.owner().IsModule() && useUltimate.owner().IsModule() && + localUltimate.owner().GetName() && + localUltimate.owner().GetName() == useUltimate.owner().GetName()) { + bool isError{false}; + if (CheckCompatibleDistinctUltimates(context(), location, localName, + *localSymbol, localUltimate, useUltimate, isError)) { + if (isError) { + // Convert the local symbol to a UseErrorDetails, if possible; + // otherwise emit a fatal error. + if (!ConvertToUseError(*localSymbol, location, useSymbol)) { + context() + .Say(location, + "'%s' use-associated from '%s' in module '%s' is incompatible with '%s' from another module"_err_en_US, + localName, useUltimate.name(), + useUltimate.owner().GetName().value(), localUltimate.name()) + .Attach(useUltimate.name(), "First declaration"_en_US) + .Attach(localUltimate.name(), "Other declaration"_en_US); + return; + } + } + if (auto *msg{context().Warn( + common::UsageWarning::CompatibleDeclarationsFromDistinctModules, + location, + "'%s' is use-associated from '%s' in two distinct instances of module '%s'"_warn_en_US, + localName, localUltimate.name(), + localUltimate.owner().GetName().value())}) { + msg->Attach(localUltimate.name(), "Previous declaration"_en_US) + .Attach(useUltimate.name(), "Later declaration"_en_US); + } + return; + } + } + // There are many possible combinations of symbol types that could arrive // with the same (local) name vie USE association from distinct modules. // Fortran allows a generic interface to share its name with a derived type, @@ -3285,7 +3407,7 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, EraseSymbol(*localSymbol); CHECK(localSymbol->has()); UseErrorDetails details{localSymbol->get()}; - details.add_occurrence(location, *useModuleScope_); + details.add_occurrence(location, useSymbol); Symbol *newSymbol{&MakeSymbol(localName, Attrs{}, std::move(details))}; // Restore *localSymbol in currScope auto iter{currScope().find(localName)}; @@ -3322,7 +3444,7 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, if (localGeneric) { combinedDerivedType = CreateLocalUseError(); } else { - ConvertToUseError(*localSymbol, location, *useModuleScope_); + ConvertToUseError(*localSymbol, location, useSymbol); localDerivedType = nullptr; localGeneric = nullptr; combinedDerivedType = localSymbol; @@ -3430,7 +3552,7 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName, // If symbols are not combinable, create a use error. if (cantCombine) { - if (!ConvertToUseError(*localSymbol, location, *useModuleScope_)) { + if (!ConvertToUseError(*localSymbol, location, useSymbol)) { Say(location, "Cannot use-associate '%s'; it is already declared in this scope"_err_en_US, localName) @@ -9376,6 +9498,12 @@ template std::set GetUses(const A &x) { } bool ResolveNamesVisitor::Pre(const parser::Program &x) { + if (Scope * hermetic{context().currentHermeticModuleFileScope()}) { + // Processing either the dependent modules or first module of a + // hermetic module file; ensure that the hermetic module scope has + // its implicit rules map entry. + ImplicitRulesVisitor::BeginScope(*hermetic); + } std::map modules; std::set uses; bool disordered{false}; diff --git a/flang/lib/Semantics/symbol.cpp b/flang/lib/Semantics/symbol.cpp index 14d6564664f2c..61982295f323a 100644 --- a/flang/lib/Semantics/symbol.cpp +++ b/flang/lib/Semantics/symbol.cpp @@ -177,11 +177,11 @@ ProcEntityDetails::ProcEntityDetails(EntityDetails &&d) : EntityDetails(std::move(d)) {} UseErrorDetails::UseErrorDetails(const UseDetails &useDetails) { - add_occurrence(useDetails.location(), *GetUsedModule(useDetails).scope()); + add_occurrence(useDetails.location(), useDetails.symbol()); } UseErrorDetails &UseErrorDetails::add_occurrence( - const SourceName &location, const Scope &module) { - occurrences_.push_back(std::make_pair(location, &module)); + const SourceName &location, const Symbol &used) { + occurrences_.push_back(std::make_pair(location, &used)); return *this; } @@ -557,9 +557,8 @@ llvm::raw_ostream &operator<<(llvm::raw_ostream &os, const Details &details) { [&](const UseErrorDetails &x) { os << " uses:"; char sep{':'}; - for (const auto &[location, module] : x.occurrences()) { - os << sep << " from " << module->GetName().value() << " at " - << location; + for (const auto &[location, sym] : x.occurrences()) { + os << sep << " from " << sym->name() << " at " << location; sep = ','; } }, diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp index 052d71be43472..8a1e856e0cd95 100644 --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -1764,9 +1764,19 @@ bool HadUseError( symbol ? symbol->detailsIf() : nullptr}) { auto &msg{context.Say( at, "Reference to '%s' is ambiguous"_err_en_US, symbol->name())}; - for (const auto &[location, module] : details->occurrences()) { - msg.Attach(location, "'%s' was use-associated from module '%s'"_en_US, at, - module->GetName().value()); + for (const auto &[location, sym] : details->occurrences()) { + const Symbol &ultimate{sym->GetUltimate()}; + auto &attachment{ + msg.Attach(location, "'%s' was use-associated from module '%s'"_en_US, + at, sym->owner().GetName().value())}; + if (&*sym != &ultimate) { + // For incompatible definitions where one comes from a hermetic + // module file's incorporated dependences and the other from another + // module of the same name. + attachment.Attach(ultimate.name(), + "ultimately from '%s' in module '%s'"_en_US, ultimate.name(), + ultimate.owner().GetName().value()); + } } context.SetError(*symbol); return true; diff --git a/flang/test/Semantics/modfile71.F90 b/flang/test/Semantics/modfile71.F90 new file mode 100644 index 0000000000000..7c3c7f5b48958 --- /dev/null +++ b/flang/test/Semantics/modfile71.F90 @@ -0,0 +1,121 @@ +!RUN: %flang_fc1 -fsyntax-only -fhermetic-module-files -DSTEP=1 %s +!RUN: %flang_fc1 -fsyntax-only -DSTEP=2 %s +!RUN: not %flang_fc1 -fsyntax-only -pedantic %s 2>&1 | FileCheck %s + +! Tests that a module captured in a hermetic module file is compatible when +! USE'd with a module of the same name USE'd directly. + +#if STEP == 1 +module modfile71a + ! not errors + integer, parameter :: good_named_const = 123 + integer :: good_var = 1 + type :: good_derived + integer component + end type + procedure(), pointer :: good_proc_ptr + generic :: gen => bad_subroutine + ! bad, but okay if unused + integer, parameter :: unused_bad_named_const = 123 + integer :: unused_bad_var = 1 + type :: unused_bad_derived + integer component + end type + procedure(), pointer :: unused_bad_proc_ptr + ! errors + integer, parameter :: bad_named_const = 123 + integer :: bad_var = 1 + type :: bad_derived + integer component + end type + procedure(), pointer :: bad_proc_ptr + contains + subroutine good_subroutine + end + subroutine unused_bad_subroutine(x) + integer x + end + subroutine bad_subroutine(x) + integer x + end +end + +module modfile71b + use modfile71a ! capture hermetically +end + +#elif STEP == 2 +module modfile71a + ! not errors + integer, parameter :: good_named_const = 123 + integer :: good_var = 1 + type :: good_derived + integer component + end type + procedure(), pointer :: good_proc_ptr + generic :: gen => bad_subroutine + ! bad, but okay if unused + integer, parameter :: unused_bad_named_const = 666 + real :: unused_bad_var = 1. + type :: unused_bad_derived + real component + end type + real, pointer :: unused_bad_proc_ptr + ! errors + integer, parameter :: bad_named_const = 666 + real :: bad_var = 1. + type :: bad_derived + real component + end type + real, pointer :: bad_proc_ptr + contains + subroutine good_subroutine + end + subroutine unused_bad_subroutine(x) + real x + end + subroutine bad_subroutine(x) + real x + end +end + +#else + +!CHECK: warning: 'bad_derived' is use-associated from 'bad_derived' in two distinct instances of module 'modfile71a' +!CHECK: warning: 'bad_named_const' is use-associated from 'bad_named_const' in two distinct instances of module 'modfile71a' +!CHECK: warning: 'bad_proc_ptr' is use-associated from 'bad_proc_ptr' in two distinct instances of module 'modfile71a' +!CHECK: warning: 'bad_subroutine' is use-associated from 'bad_subroutine' in two distinct instances of module 'modfile71a' +!CHECK: warning: 'bad_var' is use-associated from 'bad_var' in two distinct instances of module 'modfile71a' +!CHECK: warning: 'good_derived' is use-associated from 'good_derived' in two distinct instances of module 'modfile71a' +!CHECK: warning: 'good_named_const' is use-associated from 'good_named_const' in two distinct instances of module 'modfile71a' +!CHECK: warning: 'good_proc_ptr' is use-associated from 'good_proc_ptr' in two distinct instances of module 'modfile71a' +!CHECK: warning: 'good_subroutine' is use-associated from 'good_subroutine' in two distinct instances of module 'modfile71a' +!CHECK: warning: 'good_var' is use-associated from 'good_var' in two distinct instances of module 'modfile71a' +!CHECK: warning: 'unused_bad_derived' is use-associated from 'unused_bad_derived' in two distinct instances of module 'modfile71a' +!CHECK: warning: 'unused_bad_named_const' is use-associated from 'unused_bad_named_const' in two distinct instances of module 'modfile71a' +!CHECK: warning: 'unused_bad_proc_ptr' is use-associated from 'unused_bad_proc_ptr' in two distinct instances of module 'modfile71a' +!CHECK: warning: 'unused_bad_subroutine' is use-associated from 'unused_bad_subroutine' in two distinct instances of module 'modfile71a' +!CHECK: warning: 'unused_bad_var' is use-associated from 'unused_bad_var' in two distinct instances of module 'modfile71a' +!CHECK: error: Reference to 'bad_derived' is ambiguous +!CHECK: error: Reference to 'bad_named_const' is ambiguous +!CHECK: error: Reference to 'bad_var' is ambiguous +!CHECK: error: Reference to 'bad_proc_ptr' is ambiguous +!CHECK: error: Reference to 'bad_subroutine' is ambiguous +!CHECK-NOT: error: +!CHECK-NOT: warning: + +program main + use modfile71a + use modfile71b + type(good_derived) goodx + type(bad_derived) badx + print *, good_named_const + good_var = 1 + good_proc_ptr => null() + call good_subroutine + print *, bad_named_const + print *, bad_var + bad_proc_ptr => null() + call bad_subroutine(1) +end +#endif