[flang] Accept unambiguous USE name clashes

[klausler]

Summary

When, due to one or more USE associations, possibly with renaming,
a symbol conflicts with another of the same name in the same scope,
don't raise an error if both symbols resolve to the same intrinsic
procedure or to the same non-generic external procedure interface --
the usage is unambiguous and safe, and (14.2.2 p8) standard.

(Generic interfaces already work by way of combining their sets of
specific procedures.)

flang/lib/Semantics/check-declarations.cpp

if (!symbol.attrs().test(Attr::POINTER)) { // C756
           "Procedure component '%s' must have POINTER attribute"_err_en_US,
           name);
     }
     CheckPassArg(symbol, details.interface().symbol(), details);
   }
   if (symbol.attrs().test(Attr::POINTER)) {
     CheckPointerInitialization(symbol);
     if (const Symbol * interface{details.interface().symbol()}) {
-      if (interface->attrs().test(Attr::INTRINSIC)) {
+      const Symbol &ultimate{interface->GetUltimate()};
+      if (ultimate.attrs().test(Attr::INTRINSIC)) {
         if (const auto intrinsic{
                 context_.intrinsics().IsSpecificIntrinsicFunction(
-                    interface->name().ToString())};
+                    ultimate.name().ToString())};
             !intrinsic || intrinsic->isRestrictedSpecific) { // C1515
           messages_.Say(
               "Intrinsic procedure '%s' is not an unrestricted specific "
               "intrinsic permitted for use as the definition of the interface "
               "to procedure pointer '%s'"_err_en_US,
-              interface->name(), symbol.name());
+              ultimate.name(), symbol.name());
         }
       } else if (IsElementalProcedure(*interface)) {
         messages_.Say("Procedure pointer '%s' may not be ELEMENTAL"_err_en_US,
             symbol.name()); // C1517
       }
     }
   } else if (symbol.attrs().test(Attr::SAVE)) {
     messages_.Say(

flang/lib/Semantics/resolve-names.cpp

if (localUltimate.has<DerivedTypeDetails>()) {
       // Local is the specific of the used generic; replace it.
       EraseSymbol(localSymbol);
       Symbol &newSymbol{MakeSymbol(localName,
           useUltimate.attrs() & ~Attrs{Attr::PUBLIC, Attr::PRIVATE},
           UseDetails{localName, useUltimate})};
       newSymbol.flags() = useSymbol.flags();
       return;
     }
+  } else {
+    auto localClass{ClassifyProcedure(localUltimate)};
+    auto useClass{ClassifyProcedure(useUltimate)};
+    if (localClass == useClass &&
+        (localClass == ProcedureDefinitionClass::Intrinsic ||
+            localClass == ProcedureDefinitionClass::External) &&
+        localUltimate.name() == useUltimate.name()) {
+      auto localChars{evaluate::characteristics::Procedure::Characterize(
+          localUltimate, GetFoldingContext())};
+      auto useChars{evaluate::characteristics::Procedure::Characterize(
+          useUltimate, GetFoldingContext())};
+      if (localChars && useChars) {
+        if (*localChars == *useChars) {
+          // Same intrinsic or external procedure defined identically in two
+          // modules
+          return;
+        }
+      }
+    }
   }
   if (!combine) {
     if (!ConvertToUseError(localSymbol, location, *useModuleScope_)) {
       Say(location,
           "Cannot use-associate '%s'; it is already declared in this scope"_err_en_US,
           localName)
           .Attach(localSymbol.name(), "Previous declaration of '%s'"_en_US,
               localName);
bool DeclarationVisitor::Pre(const parser::ProcComponentDefStmt &) {
   CHECK(!interfaceName_);
   return true;
 }
 void DeclarationVisitor::Post(const parser::ProcComponentDefStmt &) {
   interfaceName_ = nullptr;
 }
 bool DeclarationVisitor::Pre(const parser::ProcPointerInit &x) {
   if (auto *name{std::get_if<parser::Name>(&x.u)}) {
-    return !NameIsKnownOrIntrinsic(*name);
+    return !NameIsKnownOrIntrinsic(*name) && !CheckUseError(*name);
   }
   return true;
 }
 void DeclarationVisitor::Post(const parser::ProcInterface &x) {
   if (auto *name{std::get_if<parser::Name>(&x.u)}) {
     interfaceName_ = name;
     NoteInterfaceName(*name);
   }
if (!NameIsKnownOrIntrinsic(name)) {
     Symbol &symbol{MakeSymbol(InclusiveScope(), name.source, Attrs{})};
     Resolve(name, symbol);
   }
   return name.symbol;
 }
 
 void DeclarationVisitor::CheckExplicitInterface(const parser::Name &name) {
   if (const Symbol * symbol{name.symbol}) {
-    if (!context().HasError(*symbol) && !symbol->HasExplicitInterface()) {
+    const Symbol &ultimate{symbol->GetUltimate()};
+    if (!context().HasError(*symbol) && !context().HasError(ultimate) &&
+        !ultimate.HasExplicitInterface()) {
       Say(name,
           "'%s' must be an abstract interface or a procedure with "
           "an explicit interface"_err_en_US,
           symbol->name());
     }
   }
 }
 
void DeclarationVisitor::PointerInitialization(
   if (name.symbol) {
     Symbol &ultimate{name.symbol->GetUltimate()};
     if (!context().HasError(ultimate)) {
       if (IsProcedurePointer(ultimate)) {
         auto &details{ultimate.get<ProcEntityDetails>()};
         CHECK(!details.init());
         Walk(target);
         if (const auto *targetName{std::get_if<parser::Name>(&target.u)}) {
-          if (targetName->symbol) {
+          if (!CheckUseError(*targetName) && targetName->symbol) {
             // Validation is done in declaration checking.
             details.set_init(*targetName->symbol);
           }
         } else {
           details.set_init(nullptr); // explicit NULL()
         }
       } else {
         Say(name,

flang/test/Semantics/resolve114.f90

+! RUN: %python %S/test_errors.py %s %flang_fc1
+! Allow the same external or intrinsic procedure to be use-associated
+! by multiple paths when they are unambiguous.
+module m1
+  intrinsic :: sin
+  intrinsic :: iabs
+  interface
+    subroutine ext1(a, b)
+      integer, intent(in) :: a(:)
+      real, intent(in) :: b(:)
+    end subroutine
+    subroutine ext2(a, b)
+      real, intent(in) :: a(:)
+      integer, intent(in) :: b(:)
+    end subroutine
+  end interface
+end module m1
+
+module m2
+  intrinsic :: sin, tan
+  intrinsic :: iabs, idim
+  interface
+    subroutine ext1(a, b)
+      integer, intent(in) :: a(:)
+      real, intent(in) :: b(:)
+    end subroutine
+    subroutine ext2(a, b)
+      real, intent(in) :: a(:)
+      integer, intent(in) :: b(:)
+    end subroutine
+  end interface
+end module m2
+
+subroutine s2a
+  use m1
+  use m2
+  procedure(sin), pointer :: p1 => sin
+  procedure(iabs), pointer :: p2 => iabs
+  procedure(ext1), pointer :: p3 => ext1
+  procedure(ext2), pointer :: p4 => ext2
+end subroutine
+
+subroutine s2b
+  use m1, only: x1 => sin, x2 => iabs, x3 => ext1, x4 => ext2
+  use m2, only: x1 => sin, x2 => iabs, x3 => ext1, x4 => ext2
+  use m1, only: iface1 => sin, iface2 => iabs, iface3 => ext1, iface4 => ext2
+  procedure(iface1), pointer :: p1 => x1
+  procedure(iface2), pointer :: p2 => x2
+  procedure(iface3), pointer :: p3 => x3
+  procedure(iface4), pointer :: p4 => x4
+end subroutine
+
+module m3
+  use m1
+  use m2
+end module
+subroutine s3
+  use m3
+  procedure(sin), pointer :: p1 => sin
+  procedure(iabs), pointer :: p2 => iabs
+  procedure(ext1), pointer :: p3 => ext1
+  procedure(ext2), pointer :: p4 => ext2
+end subroutine
+
+module m4
+  use m1, only: x1 => sin, x2 => iabs, x3 => ext1, x4 => ext2
+  use m2, only: x1 => sin, x2 => iabs, x3 => ext1, x4 => ext2
+end module
+subroutine s4
+  use m4
+  use m1, only: iface1 => sin, iface2 => iabs, iface3 => ext1, iface4 => ext2
+  procedure(iface1), pointer :: p1 => x1
+  procedure(iface2), pointer :: p2 => x2
+  procedure(iface3), pointer :: p3 => x3
+  procedure(iface4), pointer :: p4 => x4
+end subroutine
+
+subroutine s5
+  use m1, only: x1 => sin, x2 => iabs, x3 => ext1, x4 => ext2
+  use m2, only: x1 => tan, x2 => idim, x3 => ext2, x4 => ext1
+  use m1, only: iface1 => sin, iface2 => iabs, iface3 => ext1, iface4 => ext2
+  !ERROR: Reference to 'x1' is ambiguous
+  procedure(iface1), pointer :: p1 => x1
+  !ERROR: Reference to 'x2' is ambiguous
+  procedure(iface2), pointer :: p2 => x2
+  !ERROR: Reference to 'x3' is ambiguous
+  procedure(iface3), pointer :: p3 => x3
+  !ERROR: Reference to 'x4' is ambiguous
+  procedure(iface4), pointer :: p4 => x4
+end subroutine