[flang-commits] [PATCH] D155494: [flang] Avoid bogus errors with LBOUND/UBOUND(assumed rank array, DIM=)
Peter Klausler via Phabricator via flang-commits
flang-commits at lists.llvm.org
Mon Jul 17 10:21:29 PDT 2023
klausler created this revision.
klausler added a reviewer: PeteSteinfeld.
klausler added a project: Flang.
Herald added subscribers: sunshaoce, jdoerfert.
Herald added a project: All.
klausler requested review of this revision.
Don't emit bogus compile-time error messages about out-of-range values
for the DIM= argument to LBOUND/BOUND when the array in question is an
assumed-rank dummy array argument.
https://reviews.llvm.org/D155494
Files:
flang/lib/Evaluate/fold-integer.cpp
flang/test/Semantics/misc-intrinsics.f90
Index: flang/test/Semantics/misc-intrinsics.f90
===================================================================
--- flang/test/Semantics/misc-intrinsics.f90
+++ flang/test/Semantics/misc-intrinsics.f90
@@ -3,10 +3,11 @@
program test_size
real :: scalar
real, dimension(5, 5) :: array
- call test(array)
+ call test(array, array)
contains
- subroutine test(arg)
+ subroutine test(arg, assumedRank)
real, dimension(5, *) :: arg
+ real, dimension(..) :: assumedRank
!ERROR: A dim= argument is required for 'size' when the array is assumed-size
print *, size(arg)
!ERROR: missing mandatory 'dim=' argument
@@ -21,6 +22,13 @@
print *, size(scalar)
!ERROR: missing mandatory 'dim=' argument
print *, ubound(scalar)
+ select rank(assumedRank)
+ rank(1)
+ !ERROR: DIM=2 dimension is out of range for rank-1 array
+ print *, lbound(assumedRank, dim=2)
+ !ERROR: DIM=2 dimension is out of range for rank-1 array
+ print *, ubound(assumedRank, dim=2)
+ end select
! But these cases are fine:
print *, size(arg, dim=1)
print *, ubound(arg, dim=1)
@@ -32,5 +40,15 @@
print *, ubound(arg(:,1))
print *, shape(scalar)
print *, shape(arg(:,1))
+ print *, lbound(assumedRank, dim=2) ! can't check until run time
+ print *, ubound(assumedRank, dim=2)
+ select rank(assumedRank)
+ rank(3)
+ print *, lbound(assumedRank, dim=2)
+ print *, ubound(assumedRank, dim=2)
+ rank default
+ print *, lbound(assumedRank, dim=2)
+ print *, ubound(assumedRank, dim=2)
+ end select
end subroutine
end
Index: flang/lib/Evaluate/fold-integer.cpp
===================================================================
--- flang/lib/Evaluate/fold-integer.cpp
+++ flang/lib/Evaluate/fold-integer.cpp
@@ -115,14 +115,14 @@
using T = Type<TypeCategory::Integer, KIND>;
ActualArguments &args{funcRef.arguments()};
if (const auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
- if (int rank{array->Rank()}; rank > 0) {
+ if (int rank{array->Rank()}; rank > 0 && !IsAssumedRank(*array)) {
std::optional<int> dim;
if (funcRef.Rank() == 0) {
// Optional DIM= argument is present: result is scalar.
if (auto dim64{ToInt64(args[1])}) {
if (*dim64 < 1 || *dim64 > rank) {
- context.messages().Say("DIM=%jd dimension is out of range for "
- "rank-%d array"_err_en_US,
+ context.messages().Say(
+ "DIM=%jd dimension is out of range for rank-%d array"_err_en_US,
*dim64, rank);
return MakeInvalidIntrinsic<T>(std::move(funcRef));
} else {
@@ -169,14 +169,14 @@
using T = Type<TypeCategory::Integer, KIND>;
ActualArguments &args{funcRef.arguments()};
if (auto *array{UnwrapExpr<Expr<SomeType>>(args[0])}) {
- if (int rank{array->Rank()}; rank > 0) {
+ if (int rank{array->Rank()}; rank > 0 && !IsAssumedRank(*array)) {
std::optional<int> dim;
if (funcRef.Rank() == 0) {
// Optional DIM= argument is present: result is scalar.
if (auto dim64{ToInt64(args[1])}) {
if (*dim64 < 1 || *dim64 > rank) {
- context.messages().Say("DIM=%jd dimension is out of range for "
- "rank-%d array"_err_en_US,
+ context.messages().Say(
+ "DIM=%jd dimension is out of range for rank-%d array"_err_en_US,
*dim64, rank);
return MakeInvalidIntrinsic<T>(std::move(funcRef));
} else {
@@ -194,8 +194,8 @@
takeBoundsFromShape = false;
if (dim) {
if (semantics::IsAssumedSizeArray(symbol) && *dim == rank - 1) {
- context.messages().Say("DIM=%jd dimension is out of range for "
- "rank-%d assumed-size array"_err_en_US,
+ context.messages().Say(
+ "DIM=%jd dimension is out of range for rank-%d assumed-size array"_err_en_US,
rank, rank);
return MakeInvalidIntrinsic<T>(std::move(funcRef));
} else if (auto ub{GetUBOUND(context, *named, *dim)}) {
-------------- next part --------------
A non-text attachment was scrubbed...
Name: D155494.541122.patch
Type: text/x-patch
Size: 4225 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/flang-commits/attachments/20230717/05e4c1e8/attachment.bin>
More information about the flang-commits
mailing list