[flang] More information on generic resolution failures

When a generic procedure reference does not match any of its
specific procedures, run through them and emit the errors for each
attempted match, so that the user has more information to
resolve the problem by adjusting the actual arguments.

Author: klausler

flang/include/flang/Evaluate/call.h

@@ -112,6 +112,7 @@ class ActualArgument {
   int Rank() const;
   bool operator==(const ActualArgument &) const;
   llvm::raw_ostream &AsFortran(llvm::raw_ostream &) const;
+  std::string AsFortran() const;
 
   std::optional<parser::CharBlock> keyword() const { return keyword_; }
   ActualArgument &set_keyword(parser::CharBlock x) {

flang/include/flang/Semantics/expression.h

@@ -370,8 +370,8 @@ class ExpressionAnalyzer {
   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);
+  void EmitGenericResolutionError(const Symbol &, bool dueToNullActuals,
+      bool isSubroutine, ActualArguments &);
   const Symbol &AccessSpecific(
       const Symbol &originalGeneric, const Symbol &specific);
   std::optional<CalleeAndArguments> GetCalleeAndArguments(const parser::Name &,

flang/lib/Evaluate/formatting.cpp

@@ -252,6 +252,13 @@ llvm::raw_ostream &ActualArgument::AsFortran(llvm::raw_ostream &o) const {
   return o;
 }
 
+std::string ActualArgument::AsFortran() const {
+  std::string result;
+  llvm::raw_string_ostream sstream(result);
+  AsFortran(sstream);
+  return result;
+}
+
 llvm::raw_ostream &SpecificIntrinsic::AsFortran(llvm::raw_ostream &o) const {
   return o << name;
 }

flang/lib/Semantics/check-call.cpp

@@ -2241,10 +2241,9 @@ static void CheckSpecificIntrinsic(const characteristics::Procedure &proc,
   }
 }
 
-static parser::Messages CheckExplicitInterface(
-    const characteristics::Procedure &proc, evaluate::ActualArguments &actuals,
-    SemanticsContext &context, const Scope *scope,
-    const evaluate::SpecificIntrinsic *intrinsic,
+parser::Messages CheckExplicitInterface(const characteristics::Procedure &proc,
+    evaluate::ActualArguments &actuals, SemanticsContext &context,
+    const Scope *scope, const evaluate::SpecificIntrinsic *intrinsic,
     bool allowActualArgumentConversions, bool extentErrors,
     bool ignoreImplicitVsExplicit) {
   evaluate::FoldingContext &foldingContext{context.foldingContext()};

flang/lib/Semantics/check-call.h

@@ -12,11 +12,8 @@
 #define FORTRAN_SEMANTICS_CHECK_CALL_H_
 
 #include "flang/Evaluate/call.h"
+#include "flang/Parser/message.h"
 
-namespace Fortran::parser {
-class Messages;
-class ContextualMessages;
-} // namespace Fortran::parser
 namespace Fortran::evaluate::characteristics {
 struct Procedure;
 }
@@ -47,6 +44,12 @@ bool CheckArgumentIsConstantExprInRange(
     const evaluate::ActualArguments &actuals, int index, int lowerBound,
     int upperBound, parser::ContextualMessages &messages);
 
+parser::Messages CheckExplicitInterface(
+    const evaluate::characteristics::Procedure &, evaluate::ActualArguments &,
+    SemanticsContext &, const Scope *, const evaluate::SpecificIntrinsic *,
+    bool allowActualArgumentConversions, bool extentErrors,
+    bool ignoreImplicitVsExplicit);
+
 // Checks actual arguments for the purpose of resolving a generic interface.
 bool CheckInterfaceForGeneric(const evaluate::characteristics::Procedure &,
     evaluate::ActualArguments &, SemanticsContext &,

flang/lib/Semantics/expression.cpp

@@ -2556,7 +2556,8 @@ auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
               ResolveGeneric(generic, arguments, adjustment, isSubroutine)};
           sym = pair.first;
           if (!sym) {
-            EmitGenericResolutionError(generic, pair.second, isSubroutine);
+            EmitGenericResolutionError(
+                generic, pair.second, isSubroutine, arguments);
             return std::nullopt;
           }
           // re-resolve the name to the specific binding
@@ -3098,16 +3099,39 @@ const Symbol &ExpressionAnalyzer::AccessSpecific(
   }
 }
 
-void ExpressionAnalyzer::EmitGenericResolutionError(
-    const Symbol &symbol, bool dueToAmbiguity, bool isSubroutine) {
-  Say(dueToAmbiguity
-          ? "The 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());
+void ExpressionAnalyzer::EmitGenericResolutionError(const Symbol &symbol,
+    bool dueToAmbiguity, bool isSubroutine, ActualArguments &arguments) {
+  if (auto *msg{Say(dueToAmbiguity
+              ? "The 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())}) {
+    if (const auto *generic{
+            symbol.GetUltimate().detailsIf<semantics::GenericDetails>()}) {
+      parser::ContextualMessages &messages{GetContextualMessages()};
+      semantics::Scope &scope{context_.FindScope(messages.at())};
+      for (const Symbol &specific : generic->specificProcs()) {
+        if (auto procChars{characteristics::Procedure::Characterize(
+                specific, GetFoldingContext())}) {
+          if (auto reasons{semantics::CheckExplicitInterface(*procChars,
+                  arguments, context_, &scope, /*intrinsic=*/nullptr,
+                  /*allocActualARgumentConversions=*/false,
+                  /*extentErrors=*/false,
+                  /*ignoreImplicitVsExplicit=*/false)};
+              !reasons.empty()) {
+            reasons.AttachTo(
+                msg->Attach(specific.name(),
+                    "Specific procedure '%s' does not match the actual arguments"_en_US,
+                    specific.name()),
+                parser::Severity::None);
+          }
+        }
+      }
+    }
+  }
 }
 
 auto ExpressionAnalyzer::GetCalleeAndArguments(
@@ -3182,7 +3206,8 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
           std::move(specificCall->arguments)};
     } else {
       if (isGenericInterface) {
-        EmitGenericResolutionError(*symbol, dueToAmbiguity, isSubroutine);
+        EmitGenericResolutionError(
+            *symbol, dueToAmbiguity, isSubroutine, arguments);
       }
       return std::nullopt;
     }
@@ -5115,7 +5140,8 @@ const Symbol *ArgumentAnalyzer::FindBoundOp(parser::CharBlock oprName,
       if (isAmbiguous) {
         *isAmbiguous = pair.second;
       }
-      context_.EmitGenericResolutionError(*generic, pair.second, isSubroutine);
+      context_.EmitGenericResolutionError(
+          *generic, pair.second, isSubroutine, actuals_);
     }
   }
   return nullptr;

flang/test/Semantics/generic-error.f90

@@ -0,0 +1,21 @@
+! RUN: not %flang_fc1 -fsyntax-only %s 2>&1 | FileCheck %s
+module m
+  interface generic
+    procedure :: sub1, sub2
+  end interface
+ contains
+  subroutine sub1(x)
+  end
+  subroutine sub2(j)
+  end
+end
+
+program test
+  use m
+!CHECK: error: No specific subroutine of generic 'generic' matches the actual arguments
+!CHECK: Specific procedure 'sub1' does not match the actual arguments
+!CHECK: Actual argument type 'REAL(8)' is not compatible with dummy argument type 'REAL(4)'
+!CHECK: Specific procedure 'sub2' does not match the actual arguments
+!CHECK: Actual argument type 'REAL(8)' is not compatible with dummy argument type 'INTEGER(4)'
+  call generic(1.d0)
+end