diff --git a/flang/include/flang/Evaluate/call.h b/flang/include/flang/Evaluate/call.h index 2a5929b873d74..fea09d6440226 100644 --- a/flang/include/flang/Evaluate/call.h +++ b/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 keyword() const { return keyword_; } ActualArgument &set_keyword(parser::CharBlock x) { diff --git a/flang/include/flang/Semantics/expression.h b/flang/include/flang/Semantics/expression.h index 95c97f264a667..639ef99d2d936 100644 --- a/flang/include/flang/Semantics/expression.h +++ b/flang/include/flang/Semantics/expression.h @@ -367,11 +367,16 @@ class ExpressionAnalyzer { using AdjustActuals = std::optional>; const Symbol *ResolveForward(const Symbol &); - std::pair 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 GetCalleeAndArguments(const parser::Name &, diff --git a/flang/lib/Evaluate/formatting.cpp b/flang/lib/Evaluate/formatting.cpp index ec5dc0baaa5cb..5632015857ab3 100644 --- a/flang/lib/Evaluate/formatting.cpp +++ b/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; } diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp index e4d2a0d220c12..c51d40b9e5039 100644 --- a/flang/lib/Semantics/check-call.cpp +++ b/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()}; diff --git a/flang/lib/Semantics/check-call.h b/flang/lib/Semantics/check-call.h index 46bc61a601bd3..a69b792b646e6 100644 --- a/flang/lib/Semantics/check-call.h +++ b/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 &, diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index 4aeb9a44088e2..32aa6b1e0aa1d 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/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 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 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 ExpressionAnalyzer::ResolveGeneric( } crtMatchingDistance = ComputeCudaMatchingDistance( context_.languageFeatures(), *procedure, localActuals); + } else { + tried.push_back(*specific); } } } @@ -3038,11 +3041,12 @@ std::pair 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 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()}; 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 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()); // 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; diff --git a/flang/test/Semantics/generic-error.f90 b/flang/test/Semantics/generic-error.f90 new file mode 100644 index 0000000000000..25c0410a938c5 --- /dev/null +++ b/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