diff --git a/flang/lib/Evaluate/fold-integer.cpp b/flang/lib/Evaluate/fold-integer.cpp --- a/flang/lib/Evaluate/fold-integer.cpp +++ b/flang/lib/Evaluate/fold-integer.cpp @@ -23,7 +23,7 @@ if (auto dim64{GetInt64Arg(args[1])}) { if (*dim64 < 1 || *dim64 > rank) { context.messages().Say("DIM=%jd dimension is out of range for " - "rank-%d array"_en_US, + "rank-%d array"_err_en_US, *dim64, rank); return MakeInvalidIntrinsic(std::move(funcRef)); } else { @@ -78,7 +78,7 @@ if (auto dim64{GetInt64Arg(args[1])}) { if (*dim64 < 1 || *dim64 > rank) { context.messages().Say("DIM=%jd dimension is out of range for " - "rank-%d array"_en_US, + "rank-%d array"_err_en_US, *dim64, rank); return MakeInvalidIntrinsic(std::move(funcRef)); } else { @@ -95,8 +95,11 @@ if (symbol.Rank() == rank) { takeBoundsFromShape = false; if (dim) { - if (semantics::IsAssumedSizeArray(symbol) && *dim == rank) { - return Expr{-1}; + 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, + rank, rank); + return MakeInvalidIntrinsic(std::move(funcRef)); } else if (auto ub{GetUpperBound(context, *named, *dim)}) { return Fold(context, ConvertToType(std::move(*ub))); } diff --git a/flang/test/Evaluate/folding19.f90 b/flang/test/Evaluate/folding19.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Evaluate/folding19.f90 @@ -0,0 +1,22 @@ +! RUN: not %f18 %s 2>&1 | FileCheck %s +! Check errors found in folding +! TODO: test others emitted from flang/lib/Evaluate +module m + contains + subroutine s1(a,b) + real :: a(*), b(:) + !CHECK: error: DIM=1 dimension is out of range for rank-1 assumed-size array + integer :: ub1(ubound(a,1)) + !CHECK-NOT: error: DIM=1 dimension is out of range for rank-1 assumed-size array + integer :: lb1(lbound(a,1)) + !CHECK: error: DIM=0 dimension is out of range for rank-1 array + integer :: ub2(ubound(a,0)) + !CHECK: error: DIM=2 dimension is out of range for rank-1 array + integer :: ub3(ubound(a,2)) + !CHECK: error: DIM=0 dimension is out of range for rank-1 array + integer :: lb2(lbound(b,0)) + !CHECK: error: DIM=2 dimension is out of range for rank-1 array + integer :: lb3(lbound(b,2)) + end subroutine +end module + diff --git a/flang/test/Semantics/spec-expr.f90 b/flang/test/Semantics/spec-expr.f90 --- a/flang/test/Semantics/spec-expr.f90 +++ b/flang/test/Semantics/spec-expr.f90 @@ -79,7 +79,7 @@ subroutine s7bi(assumedArg) integer, dimension(2, *) :: assumedArg real, dimension(ubound(assumedArg, 1)) :: realArray1 - ! Should be an error since 2 is the last dimension of an assumed-size array + !ERROR: DIM=2 dimension is out of range for rank-2 assumed-size array real, dimension(ubound(assumedArg, 2)) :: realArray2 end subroutine s7bi