[flang] Check for another case of ambiguous generic resolution

[klausler]

Summary

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.

[PeteSteinfeld]

All builds and tests correctly and looks good.

flang/include/flang/Semantics/expression.h

private:
 
   std::optional<CalleeAndArguments> AnalyzeProcedureComponentRef(
       const parser::ProcComponentRef &, ActualArguments &&, bool isSubroutine);
   std::optional<characteristics::Procedure> CheckCall(
       parser::CharBlock, const ProcedureDesignator &, ActualArguments &);
   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);
   const Symbol &AccessSpecific(
       const Symbol &originalGeneric, const Symbol &specific);
   std::optional<CalleeAndArguments> GetCalleeAndArguments(const parser::Name &,
       ActualArguments &&, bool isSubroutine = false,
       bool mightBeStructureConstructor = false);

flang/lib/Semantics/expression.cpp

if (ultimate.attrs().test(semantics::Attr::INTRINSIC)) {
     if (context_.intrinsics().Probe(
             CallCharacteristics{ultimate.name().ToString(), isSubroutine},
             localActuals, foldingContext_) &&
         !buffer.AnyFatalError()) {
       return {&ultimate, false};
     }
   }
   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;
       }
       if (!ResolveForward(specific)) {
         continue;
       }
       if (std::optional<characteristics::Procedure> procedure{
               characteristics::Procedure::Characterize(
                   ProcedureDesignator{specific}, context_.foldingContext())}) {
         ActualArguments localActuals{actuals};
         if (specific.has<semantics::ProcBindingDetails>()) {
           if (!adjustActuals.value()(specific, localActuals)) {
             continue;
           }
         }
         if (semantics::CheckInterfaceForGeneric(*procedure, localActuals,
                 GetFoldingContext(), false /* no integer conversions */) &&
             CheckCompatibleArguments(*procedure, localActuals)) {
           if ((procedure->IsElemental() && elemental) ||
               (!procedure->IsElemental() && nonElemental)) {
             // 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;
           }
         }
       }
     }
     if (nonElemental) {
       return {&AccessSpecific(symbol, *nonElemental), false};
return *const_cast<semantics::Scope &>(scope)
                     semantics::UseDetails{rename, specific})
                 .first->second;
   } else {
     return specific;
   }
 }
 
 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
           ? "No specific subroutine of generic '%s' matches the actual arguments"_err_en_US
           : "No specific function of generic '%s' matches the actual arguments"_err_en_US,
       symbol.name());
 }
 
auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
     ActualArguments &&arguments, bool isSubroutine,
     bool mightBeStructureConstructor) -> std::optional<CalleeAndArguments> {
   const Symbol *symbol{name.symbol};
   if (context_.HasError(symbol)) {
     return std::nullopt; // also handles null symbol
   }
   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};
   if (isGenericInterface || isExplicitIntrinsic) {
     ExpressionAnalyzer::AdjustActuals noAdjustment;
     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);
     }
   } else if (IsProcedure(ultimate) &&
       ultimate.attrs().test(semantics::Attr::ABSTRACT)) {
     Say("Abstract procedure interface '%s' may not be referenced"_err_en_US,
         name.source);
   } else {
     resolution = symbol;
   }
   if (!resolution || resolution->attrs().test(semantics::Attr::INTRINSIC)) {
     // Not generic, or no resolution; may be intrinsic
     if (std::optional<SpecificCall> specificCall{context_.intrinsics().Probe(
             CallCharacteristics{ultimate.name().ToString(), isSubroutine},
             arguments, GetFoldingContext())}) {
       CheckBadExplicitType(*specificCall, *symbol);
       return CalleeAndArguments{
           ProcedureDesignator{std::move(specificCall->specificIntrinsic)},
           std::move(specificCall->arguments)};
     } else {
       if (isGenericInterface) {
-        EmitGenericResolutionError(*symbol, dueToNullActual, isSubroutine);
+        EmitGenericResolutionError(*symbol, dueToAmbiguity, isSubroutine);
       }
       return std::nullopt;
     }
   }
   if (resolution->GetUltimate().has<semantics::DerivedTypeDetails>()) {
     if (mightBeStructureConstructor) {
       return CalleeAndArguments{
           semantics::SymbolRef{*resolution}, std::move(arguments)};

flang/test/Semantics/resolve63.f90

subroutine test
     real, pointer :: rp
     call generic(ip, rp) ! ok
     call generic(ip, null()) ! ok
     call generic(rp, null()) ! ok
     call generic(null(), rp) ! ok
     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
     integer :: n
   end type
  contains
   subroutine test
     class(*), allocatable :: poly
     poly = 1
     poly = 3.14159
     poly = 'Il faut imaginer Sisyphe heureux'
     poly = t1(1)
   end subroutine
 end module