aboutsummaryrefslogtreecommitdiff
path: root/flang/lib/Semantics
diff options
context:
space:
mode:
Diffstat (limited to 'flang/lib/Semantics')
-rw-r--r--flang/lib/Semantics/check-call.cpp7
-rw-r--r--flang/lib/Semantics/check-call.h11
-rw-r--r--flang/lib/Semantics/check-declarations.cpp6
-rw-r--r--flang/lib/Semantics/expression.cpp114
-rw-r--r--flang/lib/Semantics/openmp-utils.cpp3
-rw-r--r--flang/lib/Semantics/resolve-names.cpp6
6 files changed, 94 insertions, 53 deletions
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index e4d2a0d..c51d40b 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 46bc61a..a69b792 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/check-declarations.cpp b/flang/lib/Semantics/check-declarations.cpp
index 31e246c..549ee83 100644
--- a/flang/lib/Semantics/check-declarations.cpp
+++ b/flang/lib/Semantics/check-declarations.cpp
@@ -472,6 +472,10 @@ void CheckHelper::Check(const Symbol &symbol) {
messages_.Say(
"A function result may not also be a named constant"_err_en_US);
}
+ if (!IsProcedurePointer(symbol) && IsProcedure(symbol)) {
+ messages_.Say(
+ "A function result may not be a procedure unless it is a procedure pointer"_err_en_US);
+ }
}
if (IsAutomatic(symbol)) {
if (const Symbol * common{FindCommonBlockContaining(symbol)}) {
@@ -1781,7 +1785,7 @@ void CheckHelper::CheckExternal(const Symbol &symbol) {
if (auto previousChars{Characterize(previous)}) {
std::string whyNot;
if (!chars->IsCompatibleWith(*previousChars,
- /*ignoreImplicitVsExplicit=*/false, &whyNot)) {
+ /*ignoreImplicitVsExplicit=*/true, &whyNot)) {
if (auto *msg{Warn(common::UsageWarning::ExternalInterfaceMismatch,
"The external interface '%s' is not compatible with an earlier definition (%s)"_warn_en_US,
symbol.name(), whyNot)}) {
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 4aeb9a4..32aa6b1 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<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;
diff --git a/flang/lib/Semantics/openmp-utils.cpp b/flang/lib/Semantics/openmp-utils.cpp
index cc55bb4..6b304b6 100644
--- a/flang/lib/Semantics/openmp-utils.cpp
+++ b/flang/lib/Semantics/openmp-utils.cpp
@@ -26,7 +26,9 @@
#include "flang/Parser/openmp-utils.h"
#include "flang/Parser/parse-tree.h"
#include "flang/Semantics/expression.h"
+#include "flang/Semantics/scope.h"
#include "flang/Semantics/semantics.h"
+#include "flang/Semantics/symbol.h"
#include "llvm/ADT/ArrayRef.h"
#include "llvm/ADT/STLExtras.h"
@@ -505,5 +507,4 @@ bool IsStrictlyStructuredBlock(const parser::Block &block) {
return false;
}
}
-
} // namespace Fortran::semantics::omp
diff --git a/flang/lib/Semantics/resolve-names.cpp b/flang/lib/Semantics/resolve-names.cpp
index db75437..4af6cf6 100644
--- a/flang/lib/Semantics/resolve-names.cpp
+++ b/flang/lib/Semantics/resolve-names.cpp
@@ -1772,11 +1772,11 @@ public:
messageHandler().set_currStmtSource(std::nullopt);
}
- bool Pre(const parser::OmpTypeSpecifier &x) {
+ bool Pre(const parser::OmpTypeName &x) {
BeginDeclTypeSpec();
return true;
}
- void Post(const parser::OmpTypeSpecifier &x) { //
+ void Post(const parser::OmpTypeName &x) { //
EndDeclTypeSpec();
}
@@ -2007,7 +2007,7 @@ void OmpVisitor::ProcessReductionSpecifier(
}
}
EndDeclTypeSpec();
- Walk(std::get<std::optional<parser::OmpReductionCombiner>>(spec.t));
+ Walk(std::get<std::optional<parser::OmpCombinerExpression>>(spec.t));
Walk(clauses);
PopScope();
}
generated by cgit v1.1 at 2025-10-25 08:17:30 +0000