[flang] Add/fix some semantic checks for assumed-rank #96194
Merged
Conversation
This file contains hidden or bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
llvmbot
added
flang
|
@llvm/pr-subscribers-flang-semantics Author: Peter Klausler (klausler) ChangesCatch some cases where assumed rank dummy arguments are not allowed. Full diff: https://github.com/llvm/llvm-project/pull/96194.diff 6 Files Affected:
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
|
klausler
force-pushed
the
bug1667
branch
2 times, most recently
from
6bc8e08 to
88805cb
Compare
Catch some cases where assumed rank dummy arguments are not allowed.
AlexisPerry
pushed a commit
to llvm-project-tlp/llvm-project
that referenced
this pull request
Jul 9, 2024
Catch some cases where assumed rank dummy arguments are not allowed.
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
Add this suggestion to a batch that can be applied as a single commit.
This suggestion is invalid because no changes were made to the code.
Suggestions cannot be applied while the pull request is closed.
Suggestions cannot be applied while viewing a subset of changes.
Only one suggestion per line can be applied in a batch.
Add this suggestion to a batch that can be applied as a single commit.
Applying suggestions on deleted lines is not supported.
You must change the existing code in this line in order to create a valid suggestion.
Outdated suggestions cannot be applied.
This suggestion has been applied or marked resolved.
Suggestions cannot be applied from pending reviews.
Suggestions cannot be applied on multi-line comments.
Suggestions cannot be applied while the pull request is queued to merge.
Suggestion cannot be applied right now. Please check back later.
Catch some cases where assumed rank dummy arguments are not allowed.