[flang] Improve USE merging of homonymous types, interfaces, and proc…

flang/include/flang/Semantics/symbol.h

@@ -637,7 +637,9 @@ class GenericDetails {
   const SymbolVector &uses() const { return uses_; }
 
   // specific and derivedType indicate a specific procedure or derived type
-  // with the same name as this generic. Only one of them may be set.
+  // with the same name as this generic. Only one of them may be set in
+  // a scope that declares them, but both can be set during USE association
+  // when generics are combined.
   Symbol *specific() { return specific_; }
   const Symbol *specific() const { return specific_; }
   void set_specific(Symbol &specific);

flang/include/flang/Semantics/tools.h

@@ -692,5 +692,8 @@ std::string GetModuleOrSubmoduleName(const Symbol &);
 // Return the assembly name emitted for a common block.
 std::string GetCommonBlockObjectName(const Symbol &, bool underscoring);
 
+// Check for ambiguous USE associations
+bool HadUseError(SemanticsContext &, SourceName at, const Symbol *);
+
 } // namespace Fortran::semantics
 #endif // FORTRAN_SEMANTICS_TOOLS_H_

flang/lib/Semantics/expression.cpp

@@ -235,6 +235,9 @@ MaybeExpr ExpressionAnalyzer::Designate(DataRef &&ref) {
     return std::nullopt;
   } else if (MaybeExpr result{AsGenericExpr(std::move(ref))}) {
     return result;
+  } else if (semantics::HadUseError(
+                 context_, GetContextualMessages().at(), &symbol)) {
+    return std::nullopt;
   } else {
     if (!context_.HasError(last) && !context_.HasError(symbol)) {
       AttachDeclaration(

flang/lib/Semantics/symbol.cpp

@@ -192,12 +192,10 @@ void GenericDetails::AddSpecificProc(
 }
 void GenericDetails::set_specific(Symbol &specific) {
   CHECK(!specific_);
-  CHECK(!derivedType_);
   specific_ = &specific;
 }
 void GenericDetails::clear_specific() { specific_ = nullptr; }
 void GenericDetails::set_derivedType(Symbol &derivedType) {
-  CHECK(!specific_);
   CHECK(!derivedType_);
   derivedType_ = &derivedType;
 }
@@ -211,7 +209,7 @@ const Symbol *GenericDetails::CheckSpecific() const {
   return const_cast<GenericDetails *>(this)->CheckSpecific();
 }
 Symbol *GenericDetails::CheckSpecific() {
-  if (specific_) {
+  if (specific_ && !specific_->has<UseErrorDetails>()) {
     for (const Symbol &proc : specificProcs_) {
       if (&proc == specific_) {
         return nullptr;

flang/lib/Semantics/tools.cpp

@@ -1685,4 +1685,21 @@ std::string GetCommonBlockObjectName(const Symbol &common, bool underscoring) {
                       : common.name().ToString();
 }
 
+bool HadUseError(
+    SemanticsContext &context, SourceName at, const Symbol *symbol) {
+  if (const auto *details{
+          symbol ? symbol->detailsIf<UseErrorDetails>() : nullptr}) {
+    auto &msg{context.Say(
+        at, "Reference to '%s' is ambiguous"_err_en_US, symbol->name())};
+    for (const auto &[location, module] : details->occurrences()) {
+      msg.Attach(location, "'%s' was use-associated from module '%s'"_en_US, at,
+          module->GetName().value());
+    }
+    context.SetError(*symbol);
+    return true;
+  } else {
+    return false;
+  }
+}
+
 } // namespace Fortran::semantics

flang/test/Semantics/resolve17.f90

@@ -175,29 +175,14 @@ module m9b
   interface g
     module procedure g
   end interface
-contains
-  subroutine g(x)
-    real :: x
-  end
-end module
-module m9c
-  interface g
-    module procedure g
-  end interface
 contains
   subroutine g()
   end
 end module
-subroutine s9a
-  use m9a
-  !ERROR: Cannot use-associate generic interface 'g' with specific procedure of the same name when another such interface and procedure are in scope
-  use m9b
-end
-subroutine s9b
+subroutine s9
   !ERROR: USE-associated generic 'g' may not have specific procedures 'g' and 'g' as their interfaces are not distinguishable
   use m9a
-  !ERROR: Cannot use-associate generic interface 'g' with specific procedure of the same name when another such interface and procedure are in scope
-  use m9c
+  use m9b
 end
 
 module m10a
@@ -223,24 +208,6 @@ subroutine s(x)
   end
 end
 
-module m11a
-  interface g
-  end interface
-  type g
-  end type
-end module
-module m11b
-  interface g
-  end interface
-  type g
-  end type
-end module
-module m11c
-  use m11a
-  !ERROR: Generic interface 'g' has ambiguous derived types from modules 'm11a' and 'm11b'
-  use m11b
-end module
-
 module m12a
   interface ga
     module procedure sa

flang/test/Semantics/resolve18.f90

@@ -229,10 +229,10 @@ function foo(x)
 
 subroutine test15
   use m15a
-  !ERROR: Cannot use-associate generic interface 'foo' with specific procedure of the same name when another such interface and procedure are in scope
-  use m15b
+  use m15b ! ok
 end
 
+
 module m16a
   type foo
     integer j
@@ -259,18 +259,110 @@ function bar(x,y)
 
 subroutine test16
   use m16a
-  !ERROR: Generic interface 'foo' has ambiguous derived types from modules 'm16a' and 'm16b'
-  use m16b
+  use m16b ! ok
 end
 
 subroutine test17
   use m15a
-  !ERROR: Cannot use-associate generic interface 'foo' with derived type of the same name when another such interface and procedure are in scope
-  use m16a
+  use m16a ! ok
 end
 
 subroutine test18
   use m16a
-  !ERROR: Cannot use-associate generic interface 'foo' with specific procedure of the same name when another such interface and derived type are in scope
-  use m15a
+  use m15a ! ok
+end
+
+module m21
+  type foo
+    integer a
+  end type
+  interface foo
+    module procedure f1
+  end interface
+ contains
+  function f1(a)
+    f1 = a
+  end
+end
+
+module m22
+  type foo
+    real b
+  end type
+  interface foo
+    module procedure f2
+  end interface
+ contains
+  function f2(a,b)
+    f2 = a + b
+  end
+end
+
+module m23
+  interface foo
+    module procedure foo
+    module procedure f3
+  end interface
+ contains
+  function foo()
+    foo = 0.
+  end
+  function f3(a,b,c)
+    f3 = a + b + c
+  end
+end
+
+module m24
+  interface foo
+    module procedure foo
+    module procedure f4
+  end interface
+ contains
+  function foo(a)
+    foo = a
+  end
+  function f4(a,b,c,d)
+    f4 = a + b + c +d
+  end
+end
+
+subroutine s_21_22_a
+  use m21
+  use m22
+  print *, foo(1.) ! Intel error
+  print *, foo(1.,2.) ! Intel error
+end
+
+subroutine s_21_22_b
+  use m21
+  use m22
+  !ERROR: 'foo' is not a derived type
+  type(foo) x ! definite error: GNU and Intel catch
+end
+
+subroutine s_21_23
+  use m21
+  use m23
+  type(foo) x ! Intel and NAG error
+  print *, foo(1.) ! Intel error
+  print *, foo(1.,2.,3.) ! Intel error
+  call ext(foo) ! GNU and Intel error
+end
+
+subroutine s_22_23
+  use m22
+  use m23
+  type(foo) x ! Intel and NAG error
+  print *, foo(1.,2.) ! Intel error
+  print *, foo(1.,2.,3.) ! Intel error
+  call ext(foo) ! Intel error
+end
+
+subroutine s_23_24
+  use m23
+  use m24
+  print *, foo(1.,2.,3.) ! NAG error
+  print *, foo(1.,2.,3.,4.) ! XLF error
+  !ERROR: 'foo' is not a specific procedure
+  call ext(foo) ! definite error
 end

flang/test/Semantics/symbol27.f90

@@ -28,7 +28,7 @@ subroutine test1a
  !DEF: /test1a/foo (Function) Generic
  !DEF: /test1a/x ObjectEntity TYPE(foo)
  type(foo) :: x
- !DEF: /test1a/foo Use
+ !REF: /m1a/foo
  !REF: /m1b/bar
  print *, foo(1), foo()
 end subroutine
@@ -41,7 +41,7 @@ subroutine test1b
  !DEF: /test1b/foo (Function) Generic
  !DEF: /test1b/x ObjectEntity TYPE(foo)
  type(foo) :: x
- !DEF: /test1b/foo Use
+ !REF: /m1a/foo
  !REF: /m1b/bar
  print *, foo(1), foo()
 end subroutine