[flang] Fix the extent calculation when upper bounds are less than lower bounds

When the upper bound is less than the lower bound, the extent is zero.  This is
specified in section 8.5.8.2, paragraph 3.

Note that similar problems exist in the lowering code.  This change only fixes
the problem for the front end.

I also added a test.

Differential Revision: https://reviews.llvm.org/D107832
This commit is contained in:
Peter Steinfeld 2021-08-10 08:20:30 -07:00
parent d719f1c3cc
commit 3ad9826dcd
2 changed files with 61 additions and 5 deletions

View File

@ -316,6 +316,26 @@ Shape GetLowerBounds(FoldingContext &context, const NamedEntity &base) {
return result;
}
// If the upper and lower bounds are constant, return a constant expression for
// the extent. In particular, if the upper bound is less than the lower bound,
// return zero.
static MaybeExtentExpr GetNonNegativeExtent(
const semantics::ShapeSpec &shapeSpec) {
const auto &ubound{shapeSpec.ubound().GetExplicit()};
const auto &lbound{shapeSpec.lbound().GetExplicit()};
std::optional<ConstantSubscript> uval{ToInt64(ubound)};
std::optional<ConstantSubscript> lval{ToInt64(lbound)};
if (uval && lval) {
if (*uval < *lval) {
return ExtentExpr{0};
} else {
return ExtentExpr{*uval - *lval + 1};
}
}
return common::Clone(ubound.value()) - common::Clone(lbound.value()) +
ExtentExpr{1};
}
MaybeExtentExpr GetExtent(const NamedEntity &base, int dimension) {
CHECK(dimension >= 0);
const Symbol &symbol{ResolveAssociations(base.GetLastSymbol())};
@ -330,11 +350,12 @@ MaybeExtentExpr GetExtent(const NamedEntity &base, int dimension) {
int j{0};
for (const auto &shapeSpec : details->shape()) {
if (j++ == dimension) {
if (shapeSpec.ubound().isExplicit()) {
if (const auto &ubound{shapeSpec.ubound().GetExplicit()}) {
if (const auto &lbound{shapeSpec.lbound().GetExplicit()}) {
return common::Clone(ubound.value()) -
common::Clone(lbound.value()) + ExtentExpr{1};
if (shapeSpec.ubound().GetExplicit()) {
// 8.5.8.2, paragraph 3. If the upper bound is less than the
// lower bound, the extent is zero.
if (shapeSpec.lbound().GetExplicit()) {
return GetNonNegativeExtent(shapeSpec);
} else {
return ubound.value();
}

View File

@ -0,0 +1,35 @@
! RUN: %S/test_folding.sh %s %t %flang_fc1
! REQUIRES: shell
! Check array sizes with varying extents, including extents where the upper
! bound is less than the lower bound
module m
contains
subroutine s1(a,b)
real nada1(-2:-1) ! size = 2
real nada2(-1:-1) ! size = 1
real nada3( 0:-1) ! size = 0
real nada4( 1:-1) ! size = 0
real nada5( 2:-1) ! size = 0
real nada6( 3:-1) ! size = 0
real nada7( 5, 3:-1) ! size = 0
real nada8( -1) ! size = 0
integer, parameter :: size1 = size(nada1)
integer, parameter :: size2 = size(nada2)
integer, parameter :: size3 = size(nada3)
integer, parameter :: size4 = size(nada4)
integer, parameter :: size5 = size(nada5)
integer, parameter :: size6 = size(nada6)
integer, parameter :: size7 = size(nada7)
integer, parameter :: size8 = size(nada8)
logical, parameter :: test_size_1 = size1 == 2
logical, parameter :: test_size_2 = size2 == 1
logical, parameter :: test_size_3 = size3 == 0
logical, parameter :: test_size_4 = size4 == 0
logical, parameter :: test_size_5 = size5 == 0
logical, parameter :: test_size_6 = size6 == 0
logical, parameter :: test_size_7 = size7 == 0
logical, parameter :: test_size_8 = size8 == 0
end subroutine
end module