[flang] Check for another case of ambiguous generic resolution

When specific procedures of a generic have dummy procedures,
underspecified actual procedures can match more than one specific
procedure.  This can happen with actual procedures that are
externals with implicit interfaces, including the completely
unspecified case of a PROCEDURE() or EXTERNAL that doesn't even
differentiate between a subroutine and a function.

Generic resolution can already handle cases of ambiguous resolution
due to the use of NULL() actual arguments with no MOLD= arguments
to define their types.  Extend the handling of ambiguous actual
arguments to include the case of underspecified actual procedures.

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

diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h
index cb38b65..0dc1216 100644 (file)
--- a/flang/include/flang/Semantics/expression.h
+++ b/flang/include/flang/Semantics/expression.h
@@ -352,8 +352,8 @@ private:
   using AdjustActuals =
       std::optional<std::function<bool(const Symbol &, ActualArguments &)>>;
   bool ResolveForward(const Symbol &);
-  std::pair<const Symbol *, bool /* failure due to NULL() actuals */>
-  ResolveGeneric(const Symbol &, const ActualArguments &, const AdjustActuals &,
+  std::pair<const Symbol *, bool /* failure due ambiguity */> ResolveGeneric(
+      const Symbol &, const ActualArguments &, const AdjustActuals &,
       bool isSubroutine, bool mightBeStructureConstructor = false);
   void EmitGenericResolutionError(
       const Symbol &, bool dueToNullActuals, bool isSubroutine);

diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 0d4156d..a6fc906 100644 (file)
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -2251,10 +2251,6 @@ std::pair<const Symbol *, bool> ExpressionAnalyzer::ResolveGeneric(
     }
   }
   if (const auto *details{ultimate.detailsIf<semantics::GenericDetails>()}) {
-    bool anyBareNullActual{
-        std::find_if(actuals.begin(), actuals.end(), [](auto iter) {
-          return IsBareNullPointer(iter->UnwrapExpr());
-        }) != actuals.end()};
     for (const Symbol &specific : details->specificProcs()) {
       if (isSubroutine != !IsFunction(specific)) {
         continue;
@@ -2279,14 +2275,13 @@ std::pair<const Symbol *, bool> ExpressionAnalyzer::ResolveGeneric(
             // 16.9.144(6): a bare NULL() is not allowed as an actual
             // argument to a generic procedure if the specific procedure
             // cannot be unambiguously distinguished
-            return {nullptr, true /* due to NULL actuals */};
+            // Underspecified external procedure actual arguments can
+            // also lead to ambiguity.
+            return {nullptr, true /* due to ambiguity */};
           }
           if (!procedure->IsElemental()) {
             // takes priority over elemental match
             nonElemental = &specific;
-            if (!anyBareNullActual) {
-              break; // unambiguous case
-            }
           } else {
             elemental = &specific;
           }
@@ -2363,9 +2358,9 @@ const Symbol &ExpressionAnalyzer::AccessSpecific(
 }
 
 void ExpressionAnalyzer::EmitGenericResolutionError(
-    const Symbol &symbol, bool dueToNullActuals, bool isSubroutine) {
-  Say(dueToNullActuals
-          ? "One or more NULL() actual arguments to the generic procedure '%s' requires a MOLD= for disambiguation"_err_en_US
+    const Symbol &symbol, bool dueToAmbiguity, bool isSubroutine) {
+  Say(dueToAmbiguity
+          ? "One or more actual arguments to the generic procedure '%s' matched multiple specific procedures, perhaps due to use of NULL() without MOLD= or an actual procedure with an implicit interface"_err_en_US
           : semantics::IsGenericDefinedOp(symbol)
           ? "No specific procedure of generic operator '%s' matches the actual arguments"_err_en_US
           : isSubroutine
@@ -2401,7 +2396,7 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
   }
   const Symbol &ultimate{DEREF(symbol).GetUltimate()};
   CheckForBadRecursion(name.source, ultimate);
-  bool dueToNullActual{false};
+  bool dueToAmbiguity{false};
   bool isGenericInterface{ultimate.has<semantics::GenericDetails>()};
   bool isExplicitIntrinsic{ultimate.attrs().test(semantics::Attr::INTRINSIC)};
   const Symbol *resolution{nullptr};
@@ -2410,7 +2405,7 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
     auto pair{ResolveGeneric(*symbol, arguments, noAdjustment, isSubroutine,
         mightBeStructureConstructor)};
     resolution = pair.first;
-    dueToNullActual = pair.second;
+    dueToAmbiguity = pair.second;
     if (resolution) {
       // re-resolve name to the specific procedure
       name.symbol = const_cast<Symbol *>(resolution);
@@ -2433,7 +2428,7 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
           std::move(specificCall->arguments)};
     } else {
       if (isGenericInterface) {
-        EmitGenericResolutionError(*symbol, dueToNullActual, isSubroutine);
+        EmitGenericResolutionError(*symbol, dueToAmbiguity, isSubroutine);
       }
       return std::nullopt;
     }

diff --git a/flang/test/Semantics/resolve63.f90 b/flang/test/Semantics/resolve63.f90
index a3154d8..5c4d9c6 100644 (file)
--- a/flang/test/Semantics/resolve63.f90
+++ b/flang/test/Semantics/resolve63.f90
@@ -340,11 +340,29 @@ module m8
     call generic(null(), ip) ! ok
     call generic(null(mold=ip), null()) ! ok
     call generic(null(), null(mold=ip)) ! ok
-    !ERROR: One or more NULL() actual arguments to the generic procedure 'generic' requires a MOLD= for disambiguation
+    !ERROR: One or more actual arguments to the generic procedure 'generic' matched multiple specific procedures, perhaps due to use of NULL() without MOLD= or an actual procedure with an implicit interface
     call generic(null(), null())
   end subroutine
 end
 
+module m9
+  interface generic
+    procedure s1, s2
+  end interface
+ contains
+  subroutine s1(jf)
+    procedure(integer) :: jf
+  end subroutine
+  subroutine s2(af)
+    procedure(real) :: af
+  end subroutine
+  subroutine test
+    external underspecified
+    !ERROR: One or more actual arguments to the generic procedure 'generic' matched multiple specific procedures, perhaps due to use of NULL() without MOLD= or an actual procedure with an implicit interface
+    call generic(underspecified)
+  end subroutine
+end module
+
 ! Ensure no bogus errors for assignments to CLASS(*) allocatable
 module m10
   type :: t1