[flang-commits] [flang] [flang] Add/fix some semantic checks for assumed-rank (PR #96194)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Thu Jun 20 07:21:34 PDT 2024
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/96194
Catch some cases where assumed rank dummy arguments are not allowed.
>From c791afef405cefde6819f283da6e9f164771eeae Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Thu, 20 Jun 2024 07:19:19 -0700
Subject: [PATCH] [flang] Add/fix some semantic checks for assumed-rank
Catch some cases where assumed rank dummy arguments are not
allowed.
---
flang/include/flang/Evaluate/tools.h | 3 +++
flang/lib/Semantics/check-allocate.cpp | 2 +-
flang/lib/Semantics/check-call.cpp | 8 +++-----
flang/lib/Semantics/expression.cpp | 22 +++++++++++++++++++++-
flang/lib/Semantics/pointer-assignment.cpp | 3 +++
flang/test/Semantics/select-rank03.f90 | 10 +++++++---
6 files changed, 38 insertions(+), 10 deletions(-)
diff --git a/flang/include/flang/Evaluate/tools.h b/flang/include/flang/Evaluate/tools.h
index 9c3dfb7a6f6ab..ff826d8adcf0b 100644
--- a/flang/include/flang/Evaluate/tools.h
+++ b/flang/include/flang/Evaluate/tools.h
@@ -98,6 +98,9 @@ template <typename T> bool IsAssumedRank(const Expr<T> &expr) {
template <typename A> bool IsAssumedRank(const std::optional<A> &x) {
return x && IsAssumedRank(*x);
}
+template <typename A> bool IsAssumedRank(const A *x) {
+ return x && IsAssumedRank(*x);
+}
// Predicate: true when an expression is a coarray (corank > 0)
bool IsCoarray(const ActualArgument &);
diff --git a/flang/lib/Semantics/check-allocate.cpp b/flang/lib/Semantics/check-allocate.cpp
index b4c5660670579..a4fa72b03ca18 100644
--- a/flang/lib/Semantics/check-allocate.cpp
+++ b/flang/lib/Semantics/check-allocate.cpp
@@ -539,7 +539,7 @@ bool AllocationCheckerHelper::RunChecks(SemanticsContext &context) {
// Shape related checks
if (ultimate_ && evaluate::IsAssumedRank(*ultimate_)) {
context.Say(name_.source,
- "An assumed-rank object may not appear in an ALLOCATE statement"_err_en_US);
+ "An assumed-rank dummy argument may not appear in an ALLOCATE statement"_err_en_US);
return false;
}
if (ultimate_ && IsAssumedSizeArray(*ultimate_) && context.AnyFatalError()) {
diff --git a/flang/lib/Semantics/check-call.cpp b/flang/lib/Semantics/check-call.cpp
index 72576942e62cb..bc6f8956773d3 100644
--- a/flang/lib/Semantics/check-call.cpp
+++ b/flang/lib/Semantics/check-call.cpp
@@ -67,11 +67,9 @@ static void CheckImplicitInterfaceArg(evaluate::ActualArgument &arg,
messages.Say(
"Coarray argument requires an explicit interface"_err_en_US);
}
- if (const auto *details{symbol.detailsIf<ObjectEntityDetails>()}) {
- if (details->IsAssumedRank()) {
- messages.Say(
- "Assumed rank argument requires an explicit interface"_err_en_US);
- }
+ if (evaluate::IsAssumedRank(symbol)) {
+ messages.Say(
+ "Assumed rank argument requires an explicit interface"_err_en_US);
}
if (symbol.attrs().test(Attr::ASYNCHRONOUS)) {
messages.Say(
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 803c655b3174f..d80b3b65f0a98 100644
--- a/flang/lib/Semantics/expression.cpp
+++ b/flang/lib/Semantics/expression.cpp
@@ -153,6 +153,7 @@ class ArgumentAnalyzer {
bool CheckConformance();
bool CheckAssignmentConformance();
bool CheckForNullPointer(const char *where = "as an operand here");
+ bool CheckForAssumedRank(const char *where = "as an operand here");
// Find and return a user-defined operator or report an error.
// The provided message is used if there is no such operator.
@@ -3200,6 +3201,7 @@ const Assignment *ExpressionAnalyzer::Analyze(const parser::AssignmentStmt &x) {
if (!procRef) {
analyzer.CheckForNullPointer(
"in a non-pointer intrinsic assignment statement");
+ analyzer.CheckForAssumedRank("in an assignment statement");
const Expr<SomeType> &lhs{analyzer.GetExpr(0)};
if (auto dyType{lhs.GetType()};
dyType && dyType->IsPolymorphic()) { // 10.2.1.2p1(1)
@@ -3394,6 +3396,7 @@ static MaybeExpr NumericUnaryHelper(ExpressionAnalyzer &context,
if (!analyzer.fatalErrors()) {
if (analyzer.IsIntrinsicNumeric(opr)) {
analyzer.CheckForNullPointer();
+ analyzer.CheckForAssumedRank();
if (opr == NumericOperator::Add) {
return analyzer.MoveExpr(0);
} else {
@@ -3428,6 +3431,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::NOT &x) {
if (!analyzer.fatalErrors()) {
if (analyzer.IsIntrinsicLogical()) {
analyzer.CheckForNullPointer();
+ analyzer.CheckForAssumedRank();
return AsGenericExpr(
LogicalNegation(std::get<Expr<SomeLogical>>(analyzer.MoveExpr(0).u)));
} else {
@@ -3476,6 +3480,7 @@ MaybeExpr NumericBinaryHelper(ExpressionAnalyzer &context, NumericOperator opr,
if (!analyzer.fatalErrors()) {
if (analyzer.IsIntrinsicNumeric(opr)) {
analyzer.CheckForNullPointer();
+ analyzer.CheckForAssumedRank();
analyzer.CheckConformance();
return NumericOperation<OPR>(context.GetContextualMessages(),
analyzer.MoveExpr(0), analyzer.MoveExpr(1),
@@ -3525,6 +3530,7 @@ MaybeExpr ExpressionAnalyzer::Analyze(const parser::Expr::Concat &x) {
if (!analyzer.fatalErrors()) {
if (analyzer.IsIntrinsicConcat()) {
analyzer.CheckForNullPointer();
+ analyzer.CheckForAssumedRank();
return common::visit(
[&](auto &&x, auto &&y) -> MaybeExpr {
using T = ResultType<decltype(x)>;
@@ -3572,6 +3578,7 @@ MaybeExpr RelationHelper(ExpressionAnalyzer &context, RelationalOperator opr,
if (leftType && rightType &&
analyzer.IsIntrinsicRelational(opr, *leftType, *rightType)) {
analyzer.CheckForNullPointer("as a relational operand");
+ analyzer.CheckForAssumedRank("as a relational operand");
return AsMaybeExpr(Relate(context.GetContextualMessages(), opr,
analyzer.MoveExpr(0), analyzer.MoveExpr(1)));
} else {
@@ -3617,6 +3624,7 @@ MaybeExpr LogicalBinaryHelper(ExpressionAnalyzer &context, LogicalOperator opr,
if (!analyzer.fatalErrors()) {
if (analyzer.IsIntrinsicLogical()) {
analyzer.CheckForNullPointer("as a logical operand");
+ analyzer.CheckForAssumedRank("as a logical operand");
return AsGenericExpr(BinaryLogicalOperation(opr,
std::get<Expr<SomeLogical>>(analyzer.MoveExpr(0).u),
std::get<Expr<SomeLogical>>(analyzer.MoveExpr(1).u)));
@@ -4330,6 +4338,18 @@ bool ArgumentAnalyzer::CheckForNullPointer(const char *where) {
return true;
}
+bool ArgumentAnalyzer::CheckForAssumedRank(const char *where) {
+ for (const std::optional<ActualArgument> &arg : actuals_) {
+ if (arg && IsAssumedRank(arg->UnwrapExpr())) {
+ context_.Say(source_,
+ "An assumed-rank dummy argument is not allowed %s"_err_en_US, where);
+ fatalErrors_ = true;
+ return false;
+ }
+ }
+ return true;
+}
+
MaybeExpr ArgumentAnalyzer::TryDefinedOp(
const char *opr, parser::MessageFixedText error, bool isUserOp) {
if (AnyUntypedOrMissingOperand()) {
@@ -4404,7 +4424,7 @@ MaybeExpr ArgumentAnalyzer::TryDefinedOp(
context_.Say(
"Operands of %s are not conformable; have rank %d and rank %d"_err_en_US,
ToUpperCase(opr), actuals_[0]->Rank(), actuals_[1]->Rank());
- } else if (CheckForNullPointer()) {
+ } else if (CheckForNullPointer() && CheckForAssumedRank()) {
context_.Say(error, ToUpperCase(opr), TypeAsFortran(0), TypeAsFortran(1));
}
return result;
diff --git a/flang/lib/Semantics/pointer-assignment.cpp b/flang/lib/Semantics/pointer-assignment.cpp
index 077072060e9b1..df26aa0476b9d 100644
--- a/flang/lib/Semantics/pointer-assignment.cpp
+++ b/flang/lib/Semantics/pointer-assignment.cpp
@@ -148,6 +148,9 @@ bool PointerAssignmentChecker::CheckLeftHandSide(const SomeExpr &lhs) {
msg->Attach(std::move(*whyNot));
}
return false;
+ } else if (evaluate::IsAssumedRank(lhs)) {
+ Say("The left-hand side of a pointer assignment must not be an assumed-rank dummy argument"_err_en_US);
+ return false;
} else {
return true;
}
diff --git a/flang/test/Semantics/select-rank03.f90 b/flang/test/Semantics/select-rank03.f90
index 8a965e950d385..77b76f5f584ca 100644
--- a/flang/test/Semantics/select-rank03.f90
+++ b/flang/test/Semantics/select-rank03.f90
@@ -52,10 +52,12 @@ subroutine allocatables(a)
!ERROR: Whole assumed-size array 'a' may not appear here without subscripts
a = 1.
rank default
- !ERROR: An assumed-rank object may not appear in an ALLOCATE statement
+ !ERROR: An assumed-rank dummy argument may not appear in an ALLOCATE statement
allocate(a)
deallocate(a)
- a = 1.
+ !ERROR: An assumed-rank dummy argument is not allowed in an assignment statement
+ !ERROR: An assumed-rank dummy argument is not allowed as an operand here
+ a = a + 1.
end select
! Test nested associations
select rank(a)
@@ -121,11 +123,13 @@ subroutine pointers(p)
!ERROR: Whole assumed-size array 'p' may not appear here without subscripts
deallocate(p)
rank default
- !ERROR: An assumed-rank object may not appear in an ALLOCATE statement
+ !ERROR: An assumed-rank dummy argument may not appear in an ALLOCATE statement
allocate(p)
deallocate(p)
+ !ERROR: The left-hand side of a pointer assignment must not be an assumed-rank dummy argument
!ERROR: pointer 'p' associated with object 't0' with incompatible type or shape
p => t0
+ !ERROR: The left-hand side of a pointer assignment must not be an assumed-rank dummy argument
!ERROR: pointer 'p' associated with object 't1' with incompatible type or shape
p => t1
end select
More information about the flang-commits
mailing list