Merge commit 'e34d603f185b' from llvm.org/main into next

Author: git apple-llvm automerger

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

@@ -367,11 +367,16 @@ class ExpressionAnalyzer {
   using AdjustActuals =
       std::optional<std::function<bool(const Symbol &, ActualArguments &)>>;
   const Symbol *ResolveForward(const Symbol &);
-  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);
+  struct GenericResolution {
+    const Symbol *specific{nullptr};
+    bool failedDueToAmbiguity{false};
+    SymbolVector tried{};
+  };
+  GenericResolution ResolveGeneric(const Symbol &, const ActualArguments &,
+      const AdjustActuals &, bool isSubroutine, SymbolVector &&tried,
+      bool mightBeStructureConstructor = false);
+  void EmitGenericResolutionError(const Symbol &, bool dueToNullActuals,
+      bool isSubroutine, ActualArguments &, const SymbolVector &);
   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

@@ -2552,11 +2552,12 @@ auto ExpressionAnalyzer::AnalyzeProcedureComponentRef(
                 }
                 return true;
               }};
-          auto pair{
-              ResolveGeneric(generic, arguments, adjustment, isSubroutine)};
-          sym = pair.first;
+          auto result{ResolveGeneric(
+              generic, arguments, adjustment, isSubroutine, SymbolVector{})};
+          sym = result.specific;
           if (!sym) {
-            EmitGenericResolutionError(generic, pair.second, isSubroutine);
+            EmitGenericResolutionError(generic, result.failedDueToAmbiguity,
+                isSubroutine, arguments, result.tried);
             return std::nullopt;
           }
           // re-resolve the name to the specific binding
@@ -2886,10 +2887,10 @@ const Symbol *ExpressionAnalyzer::ResolveForward(const Symbol &symbol) {
 
 // Resolve a call to a generic procedure with given actual arguments.
 // adjustActuals is called on procedure bindings to handle pass arg.
-std::pair<const Symbol *, bool> ExpressionAnalyzer::ResolveGeneric(
-    const Symbol &symbol, const ActualArguments &actuals,
-    const AdjustActuals &adjustActuals, bool isSubroutine,
-    bool mightBeStructureConstructor) {
+auto ExpressionAnalyzer::ResolveGeneric(const Symbol &symbol,
+    const ActualArguments &actuals, const AdjustActuals &adjustActuals,
+    bool isSubroutine, SymbolVector &&tried, bool mightBeStructureConstructor)
+    -> GenericResolution {
   const Symbol &ultimate{symbol.GetUltimate()};
   // Check for a match with an explicit INTRINSIC
   const Symbol *explicitIntrinsic{nullptr};
@@ -2948,7 +2949,7 @@ std::pair<const Symbol *, bool> ExpressionAnalyzer::ResolveGeneric(
               // cannot be unambiguously distinguished
               // Underspecified external procedure actual arguments can
               // also lead to ambiguity.
-              return {nullptr, true /* due to ambiguity */};
+              return {nullptr, true /* due to ambiguity */, std::move(tried)};
             }
           }
           if (!procedure->IsElemental()) {
@@ -2959,6 +2960,8 @@ std::pair<const Symbol *, bool> ExpressionAnalyzer::ResolveGeneric(
           }
           crtMatchingDistance = ComputeCudaMatchingDistance(
               context_.languageFeatures(), *procedure, localActuals);
+        } else {
+          tried.push_back(*specific);
         }
       }
     }
@@ -3038,11 +3041,12 @@ std::pair<const Symbol *, bool> ExpressionAnalyzer::ResolveGeneric(
   // Check parent derived type
   if (const auto *parentScope{symbol.owner().GetDerivedTypeParent()}) {
     if (const Symbol * extended{parentScope->FindComponent(symbol.name())}) {
-      auto pair{ResolveGeneric(
-          *extended, actuals, adjustActuals, isSubroutine, false)};
-      if (pair.first) {
-        return pair;
+      auto result{ResolveGeneric(*extended, actuals, adjustActuals,
+          isSubroutine, std::move(tried), false)};
+      if (result.specific != nullptr) {
+        return result;
       }
+      tried = std::move(result.tried);
     }
   }
   // Structure constructor?
@@ -3054,14 +3058,15 @@ std::pair<const Symbol *, bool> ExpressionAnalyzer::ResolveGeneric(
   if (!symbol.owner().IsGlobal() && !symbol.owner().IsDerivedType()) {
     if (const Symbol *
         outer{symbol.owner().parent().FindSymbol(symbol.name())}) {
-      auto pair{ResolveGeneric(*outer, actuals, adjustActuals, isSubroutine,
-          mightBeStructureConstructor)};
-      if (pair.first) {
-        return pair;
+      auto result{ResolveGeneric(*outer, actuals, adjustActuals, isSubroutine,
+          std::move(tried), mightBeStructureConstructor)};
+      if (result.specific) {
+        return result;
       }
+      tried = std::move(result.tried);
     }
   }
-  return {nullptr, false};
+  return {nullptr, false, std::move(tried)};
 }
 
 const Symbol &ExpressionAnalyzer::AccessSpecific(
@@ -3098,16 +3103,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,
+    const SymbolVector &tried) {
+  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())}) {
+    parser::ContextualMessages &messages{GetContextualMessages()};
+    semantics::Scope &scope{context_.FindScope(messages.at())};
+    for (const Symbol &specific : tried) {
+      if (auto procChars{characteristics::Procedure::Characterize(
+              specific, GetFoldingContext())}) {
+        if (procChars->HasExplicitInterface()) {
+          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 because"_en_US,
+                    specific.name()),
+                parser::Severity::None);
+          }
+        }
+      }
+    }
+  }
 }
 
 auto ExpressionAnalyzer::GetCalleeAndArguments(
@@ -3146,12 +3174,14 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
   bool isGenericInterface{ultimate.has<semantics::GenericDetails>()};
   bool isExplicitIntrinsic{ultimate.attrs().test(semantics::Attr::INTRINSIC)};
   const Symbol *resolution{nullptr};
+  SymbolVector tried;
   if (isGenericInterface || isExplicitIntrinsic) {
     ExpressionAnalyzer::AdjustActuals noAdjustment;
-    auto pair{ResolveGeneric(*symbol, arguments, noAdjustment, isSubroutine,
-        mightBeStructureConstructor)};
-    resolution = pair.first;
-    dueToAmbiguity = pair.second;
+    auto result{ResolveGeneric(*symbol, arguments, noAdjustment, isSubroutine,
+        SymbolVector{}, mightBeStructureConstructor)};
+    resolution = result.specific;
+    dueToAmbiguity = result.failedDueToAmbiguity;
+    tried = std::move(result.tried);
     if (resolution) {
       if (context_.GetPPCBuiltinsScope() &&
           resolution->name().ToString().rfind("__ppc_", 0) == 0) {
@@ -3182,7 +3212,8 @@ auto ExpressionAnalyzer::GetCalleeAndArguments(const parser::Name &name,
           std::move(specificCall->arguments)};
     } else {
       if (isGenericInterface) {
-        EmitGenericResolutionError(*symbol, dueToAmbiguity, isSubroutine);
+        EmitGenericResolutionError(
+            *symbol, dueToAmbiguity, isSubroutine, arguments, tried);
       }
       return std::nullopt;
     }
@@ -4955,8 +4986,10 @@ std::optional<ProcedureRef> ArgumentAnalyzer::GetDefinedAssignmentProc(
     auto restorer{context_.GetContextualMessages().DiscardMessages()};
     if (const Symbol *symbol{scope.FindSymbol(oprName)}) {
       ExpressionAnalyzer::AdjustActuals noAdjustment;
-      proc =
-          context_.ResolveGeneric(*symbol, actuals_, noAdjustment, true).first;
+      proc = context_
+                 .ResolveGeneric(
+                     *symbol, actuals_, noAdjustment, true, SymbolVector{})
+                 .specific;
       if (proc) {
         isProcElemental = IsElementalProcedure(*proc);
       }
@@ -5105,17 +5138,18 @@ const Symbol *ArgumentAnalyzer::FindBoundOp(parser::CharBlock oprName,
         [&](const Symbol &proc, ActualArguments &) {
           return passIndex == GetPassIndex(proc).value_or(-1);
         }};
-    auto pair{
-        context_.ResolveGeneric(*generic, actuals_, adjustment, isSubroutine)};
-    if (const Symbol *binding{pair.first}) {
+    auto result{context_.ResolveGeneric(
+        *generic, actuals_, adjustment, isSubroutine, SymbolVector{})};
+    if (const Symbol *binding{result.specific}) {
       CHECK(binding->has<semantics::ProcBindingDetails>());
       // Use the most recent override of the binding, if any
       return scope->FindComponent(binding->name());
     } else {
       if (isAmbiguous) {
-        *isAmbiguous = pair.second;
+        *isAmbiguous = result.failedDueToAmbiguity;
       }
-      context_.EmitGenericResolutionError(*generic, pair.second, isSubroutine);
+      context_.EmitGenericResolutionError(*generic, result.failedDueToAmbiguity,
+          isSubroutine, actuals_, result.tried);
     }
   }
   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