diff --git a/flang/include/flang/Support/Fortran-features.h b/flang/include/flang/Support/Fortran-features.h index 356623c643e46..335273100d70e 100644 --- a/flang/include/flang/Support/Fortran-features.h +++ b/flang/include/flang/Support/Fortran-features.h @@ -75,7 +75,7 @@ ENUM_CLASS(UsageWarning, Portability, PointerToUndefinable, VectorSubscriptFinalization, UndefinedFunctionResult, UselessIomsg, MismatchingDummyProcedure, SubscriptedEmptyArray, UnsignedLiteralTruncation, CompatibleDeclarationsFromDistinctModules, - NullActualForDefaultIntentAllocatable) + NullActualForDefaultIntentAllocatable, UseAssociationIntoSameNameSubprogram) using LanguageFeatures = EnumSet; using UsageWarnings = EnumSet; diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp index 8ba476ec547fc..7a66d79304451 100644 --- a/flang/lib/Semantics/resolve-names.cpp +++ b/flang/lib/Semantics/resolve-names.cpp @@ -719,6 +719,7 @@ class ScopeHandler : public ImplicitRulesVisitor { void NotePossibleBadForwardRef(const parser::Name &); std::optional HadForwardRef(const Symbol &) const; bool CheckPossibleBadForwardRef(const Symbol &); + bool ConvertToUseError(Symbol &, const SourceName &, const Symbol &used); bool inSpecificationPart_{false}; bool deferImplicitTyping_{false}; @@ -3335,7 +3336,7 @@ 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( +bool ScopeHandler::ConvertToUseError( Symbol &symbol, const SourceName &location, const Symbol &used) { if (auto *ued{symbol.detailsIf()}) { ued->add_occurrence(location, used); @@ -3353,9 +3354,25 @@ static bool ConvertToUseError( symbol.set_details( UseErrorDetails{*useDetails}.add_occurrence(location, used)); return true; - } else { - return false; } + if (const auto *hostAssocDetails{symbol.detailsIf()}; + hostAssocDetails && hostAssocDetails->symbol().has() && + &symbol.owner() == &currScope() && + &hostAssocDetails->symbol() == currScope().symbol()) { + // Handle USE-association of procedure FOO into function/subroutine FOO, + // replacing its place-holding HostAssocDetails symbol. + context().Warn(common::UsageWarning::UseAssociationIntoSameNameSubprogram, + location, + "'%s' is use-associated into a subprogram of the same name"_port_en_US, + used.name()); + SourceName created{context().GetTempName(currScope())}; + Symbol &tmpUse{MakeSymbol(created, Attrs(), UseDetails{location, used})}; + UseErrorDetails useError{tmpUse.get()}; + useError.add_occurrence(location, hostAssocDetails->symbol()); + symbol.set_details(std::move(useError)); + return true; + } + return false; } // Two ultimate symbols are distinct, but they have the same name and come diff --git a/flang/lib/Semantics/tools.cpp b/flang/lib/Semantics/tools.cpp index 6867777bbcdc0..08d260555f37e 100644 --- a/flang/lib/Semantics/tools.cpp +++ b/flang/lib/Semantics/tools.cpp @@ -1733,16 +1733,20 @@ bool HadUseError( at, "Reference to '%s' is ambiguous"_err_en_US, symbol->name())}; 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()); + if (sym->owner().IsModule()) { + 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()); + } + } else { + msg.Attach(sym->name(), "declared here"_en_US); } } context.SetError(*symbol); diff --git a/flang/lib/Support/Fortran-features.cpp b/flang/lib/Support/Fortran-features.cpp index 4bc92f3924ef6..4f1af27231301 100644 --- a/flang/lib/Support/Fortran-features.cpp +++ b/flang/lib/Support/Fortran-features.cpp @@ -85,6 +85,7 @@ LanguageFeatureControl::LanguageFeatureControl() { warnUsage_.set(UsageWarning::UselessIomsg); warnUsage_.set(UsageWarning::UnsignedLiteralTruncation); warnUsage_.set(UsageWarning::NullActualForDefaultIntentAllocatable); + warnUsage_.set(UsageWarning::UseAssociationIntoSameNameSubprogram); // New warnings, on by default warnLanguage_.set(LanguageFeature::SavedLocalInSpecExpr); warnLanguage_.set(LanguageFeature::NullActualForAllocatable); diff --git a/flang/test/Semantics/resolve18.f90 b/flang/test/Semantics/resolve18.f90 index 467fceb58657e..fef526908bbf9 100644 --- a/flang/test/Semantics/resolve18.f90 +++ b/flang/test/Semantics/resolve18.f90 @@ -22,13 +22,17 @@ subroutine s(i) end module subroutine foo - !ERROR: Cannot use-associate 'foo'; it is already declared in this scope + !PORTABILITY: 'foo' is use-associated into a subprogram of the same name use m1 + !ERROR: Reference to 'foo' is ambiguous + call foo end subroutine bar - !ERROR: Cannot use-associate 'bar'; it is already declared in this scope + !PORTABILITY: 'foo' is use-associated into a subprogram of the same name use m1, bar => foo + !ERROR: Reference to 'bar' is ambiguous + call bar end !OK to use-associate a type with the same name as a generic