[flang-commits] [flang] [flang] Relax overindexing error to warning for last dummy dimension (PR #71725)
Peter Klausler via flang-commits
flang-commits at lists.llvm.org
Wed Nov 8 11:07:47 PST 2023
https://github.com/klausler created https://github.com/llvm/llvm-project/pull/71725
Compilation-time subscript value range checking should emit a warning, not an error, when the indexed array is a dummy argument; there's old-school codes out there that should have used assumed-size dummy arguments but didn't.
>From e6dac11f3c91e934a28bb374e76e8e81d4386f22 Mon Sep 17 00:00:00 2001
From: Peter Klausler <pklausler at nvidia.com>
Date: Wed, 8 Nov 2023 10:54:56 -0800
Subject: [PATCH] [flang] Relax overindexing error to warning for last dummy
dimension
Compilation-time subscript value range checking should emit a warning,
not an error, when the indexed array is a dummy argument; there's
old-school codes out there that should have used assumed-size dummy
arguments but didn't.
---
flang/lib/Semantics/expression.cpp | 29 +++++++----
flang/test/Semantics/expr-errors06.f90 | 69 +++++++++++++++-----------
2 files changed, 58 insertions(+), 40 deletions(-)
diff --git a/flang/lib/Semantics/expression.cpp b/flang/lib/Semantics/expression.cpp
index 367414a2b4465ce..4d4e1e932f52b4c 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<parser::MessageFixedText> msg;
+ std::optional<ConstantSubscript> 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<std::intmax_t>(*val[j]),
- static_cast<std::intmax_t>(*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<std::intmax_t>(*val[j]),
- static_cast<std::intmax_t>(*dimUB), dim + 1),
- ref.base().GetLastSymbol());
+ Say(std::move(*msg), static_cast<std::intmax_t>(*val[j]),
+ static_cast<std::intmax_t>(bound.value()), dim + 1),
+ arraySymbol);
}
}
}
diff --git a/flang/test/Semantics/expr-errors06.f90 b/flang/test/Semantics/expr-errors06.f90
index 1168d410b9bd9c4..84872c7fcdbc584 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
More information about the flang-commits
mailing list