maxjhandsome
/
llvm-project
forked from OSchip/llvm-project
1
0
Fork 0
Code Issues Pull Requests Packages Releases Wiki Activity

[flang] Detect UBOUND() error on assumed-size array 

UBOUND() is not allowed on the last dimension of an
assumed-size array dummy argument.

Differential Revision: https://reviews.llvm.org/D95831
This commit is contained in:
peter klausler 2021-02-01 15:26:48 -08:00
parent 74c94b5d9c
commit dc6fadf708
3 changed files with 30 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

11
flang/lib/Evaluate/fold-integer.cpp
View File

@ -23,7 +23,7 @@ Expr<Type<TypeCategory::Integer, KIND>> LBOUND(FoldingContext &context,
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<T>(std::move(funcRef));
} else {
@ -78,7 +78,7 @@ Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,
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<T>(std::move(funcRef));
} else {
@ -95,8 +95,11 @@ Expr<Type<TypeCategory::Integer, KIND>> UBOUND(FoldingContext &context,
if (symbol.Rank() == rank) {
takeBoundsFromShape = false;
if (dim) {
if (semantics::IsAssumedSizeArray(symbol) && *dim == rank) {
return Expr<T>{-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<T>(std::move(funcRef));
} else if (auto ub{GetUpperBound(context, *named, *dim)}) {
return Fold(context, ConvertToType<T>(std::move(*ub)));
}

22
flang/test/Evaluate/folding19.f90 Normal file
View File

@ -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

2
flang/test/Semantics/spec-expr.f90
View File

@ -79,7 +79,7 @@ end subroutine s7a
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