diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp index 367414a2b4465..4d4e1e932f52b 100644 --- a/flang/lib/Semantics/expression.cpp +++ b/flang/lib/Semantics/expression.cpp @@ -403,19 +403,28 @@ void ExpressionAnalyzer::CheckConstantSubscripts(ArrayRef &ref) { } for (int j{0}; j < vals; ++j) { if (val[j]) { + std::optional msg; + std::optional bound; if (dimLB && *val[j] < *dimLB) { - AttachDeclaration( - Say("Subscript %jd is less than lower bound %jd for dimension %d of array"_err_en_US, - static_cast(*val[j]), - static_cast(*dimLB), dim + 1), - ref.base().GetLastSymbol()); + msg = + "Subscript %jd is less than lower bound %jd for dimension %d of array"_err_en_US; + bound = *dimLB; + } else if (dimUB && *val[j] > *dimUB) { + msg = + "Subscript %jd is greater than upper bound %jd for dimension %d of array"_err_en_US; + bound = *dimUB; + if (dim + 1 == arraySymbol.Rank() && IsDummy(arraySymbol) && + *bound == 1) { + // Old-school overindexing of a dummy array isn't fatal when + // it's on the last dimension and the extent is 1. + msg->set_severity(parser::Severity::Warning); + } } - if (dimUB && *val[j] > *dimUB) { + if (msg) { AttachDeclaration( - Say("Subscript %jd is greater than upper bound %jd for dimension %d of array"_err_en_US, - static_cast(*val[j]), - static_cast(*dimUB), dim + 1), - ref.base().GetLastSymbol()); + Say(std::move(*msg), static_cast(*val[j]), + static_cast(bound.value()), dim + 1), + arraySymbol); } } } diff --git a/flang/test/Semantics/expr-errors06.f90 b/flang/test/Semantics/expr-errors06.f90 index 1168d410b9bd9..84872c7fcdbc5 100644 --- a/flang/test/Semantics/expr-errors06.f90 +++ b/flang/test/Semantics/expr-errors06.f90 @@ -1,33 +1,42 @@ ! RUN: %python %S/test_errors.py %s %flang_fc1 -Werror ! Check out-of-range subscripts -real a(10) -integer, parameter :: n(2) = [1, 2] -integer unknown -!ERROR: DATA statement designator 'a(0_8)' is out of range -!ERROR: DATA statement designator 'a(11_8)' is out of range -data a(0)/0./, a(10+1)/0./ -!ERROR: Subscript 0 is less than lower bound 1 for dimension 1 of array -print *, a(0) -!ERROR: Subscript 0 is less than lower bound 1 for dimension 1 of array -print *, a(1-1) -!ERROR: Subscript 11 is greater than upper bound 10 for dimension 1 of array -print *, a(11) -!ERROR: Subscript 11 is greater than upper bound 10 for dimension 1 of array -print *, a(10+1) -!ERROR: Subscript value (0) is out of range on dimension 1 in reference to a constant array value -print *, n(0) -!ERROR: Subscript value (3) is out of range on dimension 1 in reference to a constant array value -print *, n(4-1) -print *, a(1:12:3) ! ok -!ERROR: Subscript 13 is greater than upper bound 10 for dimension 1 of array -print *, a(1:13:3) -print *, a(10:-1:-3) ! ok -!ERROR: Subscript -2 is less than lower bound 1 for dimension 1 of array -print *, a(10:-2:-3) -print *, a(-1:-2) ! empty section is ok -print *, a(0:11:-1) ! empty section is ok -!ERROR: Subscript 0 is less than lower bound 1 for dimension 1 of array -print *, a(0:0:unknown) ! lower==upper, can ignore stride -!ERROR: Subscript 11 is greater than upper bound 10 for dimension 1 of array -print *, a(11:11:unknown) ! lower==upper, can ignore stride +subroutine subr(da) + real a(10), da(2,1) + integer, parameter :: n(2) = [1, 2] + integer unknown + !ERROR: DATA statement designator 'a(0_8)' is out of range + !ERROR: DATA statement designator 'a(11_8)' is out of range + data a(0)/0./, a(10+1)/0./ + !ERROR: Subscript 0 is less than lower bound 1 for dimension 1 of array + print *, a(0) + !ERROR: Subscript 0 is less than lower bound 1 for dimension 1 of array + print *, a(1-1) + !ERROR: Subscript 11 is greater than upper bound 10 for dimension 1 of array + print *, a(11) + !ERROR: Subscript 11 is greater than upper bound 10 for dimension 1 of array + print *, a(10+1) + !ERROR: Subscript value (0) is out of range on dimension 1 in reference to a constant array value + print *, n(0) + !ERROR: Subscript value (3) is out of range on dimension 1 in reference to a constant array value + print *, n(4-1) + print *, a(1:12:3) ! ok + !ERROR: Subscript 13 is greater than upper bound 10 for dimension 1 of array + print *, a(1:13:3) + print *, a(10:-1:-3) ! ok + !ERROR: Subscript -2 is less than lower bound 1 for dimension 1 of array + print *, a(10:-2:-3) + print *, a(-1:-2) ! empty section is ok + print *, a(0:11:-1) ! empty section is ok + !ERROR: Subscript 0 is less than lower bound 1 for dimension 1 of array + print *, a(0:0:unknown) ! lower==upper, can ignore stride + !ERROR: Subscript 11 is greater than upper bound 10 for dimension 1 of array + print *, a(11:11:unknown) ! lower==upper, can ignore stride + !ERROR: Subscript 0 is less than lower bound 1 for dimension 1 of array + print *, da(0,1) + !ERROR: Subscript 3 is greater than upper bound 2 for dimension 1 of array + print *, da(3,1) + !ERROR: Subscript 0 is less than lower bound 1 for dimension 2 of array + print *, da(1,0) + !WARNING: Subscript 2 is greater than upper bound 1 for dimension 2 of array + print *, da(1,2) end