[flang-commits] [flang] [flang] Adjust %REF/%VAL semantic checking (PR #93718)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Wed May 29 11:50:49 PDT 2024
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/93718
In accordance with other compilers, don't require that a %REF() actual argument be a modifiable variable. And move the %REF/%VAL semantic checks to Semantics/check-call.cpp, where one would expect to find them.
Fixes https://github.com/llvm/llvm-project/issues/93489.
>From b3ebee6fe0d4dbcbbe8752e6b860059965fc764f Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Wed, 29 May 2024 11:48:26 -0700
Subject: [PATCH] [flang] Adjust %REF/%VAL semantic checking
In accordance with other compilers, don't require that a %REF()
actual argument be a modifiable variable. And move the %REF/%VAL
semantic checks to Semantics/check-call.cpp, where one would expect
to find them.
Fixes https://github.com/llvm/llvm-project/issues/93489.
---
flang/include/flang/Parser/parse-tree.h | 2 +-
flang/lib/Parser/program-parsers.cpp | 4 ++--
flang/lib/Semantics/check-call.cpp | 29 +++++++++++++++++++++----
flang/lib/Semantics/expression.cpp | 12 +++-------
flang/test/Semantics/call40.f90 | 15 +++++++++----
5 files changed, 42 insertions(+), 20 deletions(-)
diff --git a/flang/include/flang/Parser/parse-tree.h b/flang/include/flang/Parser/parse-tree.h
index 0a40aa8b8f616..6749e2093719d 100644
--- a/flang/include/flang/Parser/parse-tree.h
+++ b/flang/include/flang/Parser/parse-tree.h
@@ -3194,7 +3194,7 @@ WRAPPER_CLASS(AltReturnSpec, Label);
// expr | variable | procedure-name | proc-component-ref |
// alt-return-spec
struct ActualArg {
- WRAPPER_CLASS(PercentRef, Variable); // %REF(v) extension
+ WRAPPER_CLASS(PercentRef, Expr); // %REF(x) extension
WRAPPER_CLASS(PercentVal, Expr); // %VAL(x) extension
UNION_CLASS_BOILERPLATE(ActualArg);
ActualArg(Expr &&x) : u{common::Indirection<Expr>(std::move(x))} {}
diff --git a/flang/lib/Parser/program-parsers.cpp b/flang/lib/Parser/program-parsers.cpp
index ff5e58ebc721c..6f25ba4827220 100644
--- a/flang/lib/Parser/program-parsers.cpp
+++ b/flang/lib/Parser/program-parsers.cpp
@@ -472,8 +472,8 @@ TYPE_PARSER(construct<ActualArg>(expr) ||
construct<ActualArg>(Parser<AltReturnSpec>{}) ||
extension<LanguageFeature::PercentRefAndVal>(
"nonstandard usage: %REF"_port_en_US,
- construct<ActualArg>(construct<ActualArg::PercentRef>(
- "%REF" >> parenthesized(variable)))) ||
+ construct<ActualArg>(
+ construct<ActualArg::PercentRef>("%REF" >> parenthesized(expr)))) ||
extension<LanguageFeature::PercentRefAndVal>(
"nonstandard usage: %VAL"_port_en_US,
construct<ActualArg>(
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 48c888c0dfb26..9af2e37bb256d 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -35,7 +35,8 @@ static void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg,
"Keyword '%s=' may not appear in a reference to a procedure with an implicit interface"_err_en_US,
*kw);
}
- if (auto type{arg.GetType()}) {
+ auto type{arg.GetType()};
+ if (type) {
if (type->IsAssumedType()) {
messages.Say(
"Assumed type actual argument requires an explicit interface"_err_en_US);
@@ -49,6 +50,11 @@ static void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg,
}
}
}
+ if (arg.isPercentVal() &&
+ (!type || !type->IsLengthlessIntrinsicType() || arg.Rank() != 0)) {
+ messages.Say(
+ "%VAL argument must be a scalar numeric or logical expression"_err_en_US);
+ }
if (const auto *expr{arg.UnwrapExpr()}) {
if (IsBOZLiteral(*expr)) {
messages.Say("BOZ argument requires an explicit interface"_err_en_US);
@@ -314,7 +320,8 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
SemanticsContext &context, evaluate::FoldingContext &foldingContext,
const Scope *scope, const evaluate::SpecificIntrinsic *intrinsic,
bool allowActualArgumentConversions, bool extentErrors,
- const characteristics::Procedure &procedure) {
+ const characteristics::Procedure &procedure,
+ const evaluate::ActualArgument &arg) {
// Basic type & rank checking
parser::ContextualMessages &messages{foldingContext.messages()};
@@ -939,11 +946,25 @@ static void CheckExplicitDataArg(const characteristics::DummyDataObject &dummy,
}
}
- // Breaking change warnings
+ // Warning for breaking F'2023 change with character allocatables
if (intrinsic && dummy.intent != common::Intent::In) {
WarnOnDeferredLengthCharacterScalar(
context, &actual, messages.at(), dummyName.c_str());
}
+
+ // %VAL() and %REF() checking for explicit interface
+ if ((arg.isPercentRef() || arg.isPercentVal()) &&
+ dummy.IsPassedByDescriptor(procedure.IsBindC())) {
+ messages.Say(
+ "%VAL or %REF are not allowed for %s that must be passed by means of a descriptor"_err_en_US,
+ dummyName);
+ }
+ if (arg.isPercentVal() &&
+ (!actualType.type().IsLengthlessIntrinsicType() ||
+ actualType.Rank() != 0)) {
+ messages.Say(
+ "%VAL argument must be a scalar numeric or logical expression"_err_en_US);
+ }
}
static void CheckProcedureArg(evaluate::ActualArgument &arg,
@@ -1152,7 +1173,7 @@ static void CheckExplicitInterfaceArg(evaluate::ActualArgument &arg,
object.type.Rank() == 0 && proc.IsElemental()};
CheckExplicitDataArg(object, dummyName, *expr, *type,
isElemental, context, foldingContext, scope, intrinsic,
- allowActualArgumentConversions, extentErrors, proc);
+ allowActualArgumentConversions, extentErrors, proc, arg);
} else if (object.type.type().IsTypelessIntrinsicArgument() &&
IsBOZLiteral(*expr)) {
// ok
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 50e2b41212d7d..e42a8df1c3dc5 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -4187,13 +4187,13 @@ void ArgumentAnalyzer::Analyze(
},
[&](const parser::AltReturnSpec &label) {
if (!isSubroutine) {
- context_.Say("alternate return specification may not appear on"
- " function reference"_err_en_US);
+ context_.Say(
+ "alternate return specification may not appear on function reference"_err_en_US);
}
actual = ActualArgument(label.v);
},
[&](const parser::ActualArg::PercentRef &percentRef) {
- actual = AnalyzeVariable(percentRef.v);
+ actual = AnalyzeExpr(percentRef.v);
if (actual.has_value()) {
actual->set_isPercentRef();
}
@@ -4202,12 +4202,6 @@ void ArgumentAnalyzer::Analyze(
actual = AnalyzeExpr(percentVal.v);
if (actual.has_value()) {
actual->set_isPercentVal();
- std::optional<DynamicType> type{actual->GetType()};
- if (!type || !type->IsLengthlessIntrinsicType() ||
- actual->Rank() != 0) {
- context_.SayAt(percentVal.v,
- "%VAL argument must be a scalar numerical or logical expression"_err_en_US);
- }
}
},
},
diff --git a/flang/test/Semantics/call40.f90 b/flang/test/Semantics/call40.f90
index c248be6937e21..e240b5a432184 100644
--- a/flang/test/Semantics/call40.f90
+++ b/flang/test/Semantics/call40.f90
@@ -9,15 +9,22 @@ subroutine val_errors(array, string, polymorphic, derived)
character(*) :: string
type(t) :: derived
type(*) :: polymorphic
- !ERROR: %VAL argument must be a scalar numerical or logical expression
+ interface
+ subroutine foo5(a)
+ integer a(:)
+ end
+ end interface
+ !ERROR: %VAL argument must be a scalar numeric or logical expression
call foo1(%val(array))
- !ERROR: %VAL argument must be a scalar numerical or logical expression
+ !ERROR: %VAL argument must be a scalar numeric or logical expression
call foo2(%val(string))
- !ERROR: %VAL argument must be a scalar numerical or logical expression
+ !ERROR: %VAL argument must be a scalar numeric or logical expression
call foo3(%val(derived))
- !ERROR: %VAL argument must be a scalar numerical or logical expression
!ERROR: Assumed type actual argument requires an explicit interface
+ !ERROR: %VAL argument must be a scalar numeric or logical expression
call foo4(%val(polymorphic))
+ !ERROR: %VAL or %REF are not allowed for dummy argument 'a=' that must be passed by means of a descriptor
+ call foo5(%ref(array))
end subroutine
subroutine val_ok()
More information about the flang-commits
mailing list