[flang] Accept unambiguous USE name clashes

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

Differential Revision: https://reviews.llvm.org/D132682

flang/lib/Semantics/check-declarations.cpp

@@ -813,16 +813,17 @@ void CheckHelper::CheckProcEntity(
   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,

flang/lib/Semantics/resolve-names.cpp

@@ -2834,6 +2834,25 @@ void ModuleVisitor::DoAddUse(SourceName location, SourceName localName,
       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_)) {
@@ -4775,7 +4794,7 @@ void DeclarationVisitor::Post(const parser::ProcComponentDefStmt &) {
 }
 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;
 }
@@ -5762,7 +5781,9 @@ Symbol *DeclarationVisitor::NoteInterfaceName(const parser::Name &name) {
 
 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,
@@ -6790,7 +6811,7 @@ void DeclarationVisitor::PointerInitialization(
         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);
           }

flang/test/Semantics/resolve114.f90

@@ -0,0 +1,90 @@
+! 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