From 6bc2c5f2dd368ea51dcde5fb99d8b41debbc8f79 Mon Sep 17 00:00:00 2001 From: Peter Klausler Date: Tue, 1 Apr 2025 16:41:54 -0700 Subject: [PATCH] [flang] Permit unused USE association of subprogram name A function or subroutine can allow an object of the same name to appear in its scope, so long as the name is not used. This is similar to the case of a name being imported from multiple distinct modules, and implemented by the same representation. It's not clear whether this is conforming behavior or a common extension. --- .../include/flang/Support/Fortran-features.h | 2 +- flang/lib/Semantics/resolve-names.cpp | 23 +++++++++++++++--- flang/lib/Semantics/tools.cpp | 24 +++++++++++-------- flang/lib/Support/Fortran-features.cpp | 1 + flang/test/Semantics/resolve18.f90 | 8 +++++-- 5 files changed, 42 insertions(+), 16 deletions(-) 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