[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.

Author: klausler

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<LanguageFeature, LanguageFeature_enumSize>;
 using UsageWarnings = EnumSet<UsageWarning, UsageWarning_enumSize>;

flang/lib/Semantics/resolve-names.cpp

@@ -719,6 +719,7 @@ class ScopeHandler : public ImplicitRulesVisitor {
   void NotePossibleBadForwardRef(const parser::Name &);
   std::optional<SourceName> 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<UseErrorDetails>()}) {
     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 && hostAssocDetails->symbol().has<SubprogramDetails>() &&
+      &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<UseDetails>()};
+    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

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);

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);

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