[flang-commits] [flang] 3ad9826 - [flang] Fix the extent calculation when upper bounds are less than lower bounds

[Peter Steinfeld via flang-commits]

Author: Peter Steinfeld
Date: 2021-08-10T10:34:22-07:00
New Revision: 3ad9826dcd480d04480ebb98dae426f435a2c135

URL: https://github.com/llvm/llvm-project/commit/3ad9826dcd480d04480ebb98dae426f435a2c135
DIFF: https://github.com/llvm/llvm-project/commit/3ad9826dcd480d04480ebb98dae426f435a2c135.diff

LOG: [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

Added: 
    flang/test/Evaluate/folding21.f90

Modified: 
    flang/lib/Evaluate/shape.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index 7e8158da5ceeb..7c5f517b92dbc 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -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 (const auto &ubound{shapeSpec.ubound().GetExplicit()}) {
+            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();
               }

diff  --git a/flang/test/Evaluate/folding21.f90 b/flang/test/Evaluate/folding21.f90
new file mode 100644
index 0000000000000..2a7923debd7d2
--- /dev/null
+++ b/flang/test/Evaluate/folding21.f90
@@ -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