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

[Pete Steinfeld via Phabricator via llvm-commits]

PeteSteinfeld updated this revision to Diff 365529.
PeteSteinfeld added a comment.

Responding to Peter's comment.


Repository:
  rG LLVM Github Monorepo

CHANGES SINCE LAST ACTION
  https://reviews.llvm.org/D107832/new/

https://reviews.llvm.org/D107832

Files:
  flang/lib/Evaluate/shape.cpp
  flang/test/Evaluate/folding21.f90


Index: flang/test/Evaluate/folding21.f90
===================================================================
--- /dev/null
+++ 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
Index: flang/lib/Evaluate/shape.cpp
===================================================================
--- flang/lib/Evaluate/shape.cpp
+++ flang/lib/Evaluate/shape.cpp
@@ -316,6 +316,26 @@
   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 @@
       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();
               }


-------------- next part --------------
A non-text attachment was scrubbed...
Name: D107832.365529.patch
Type: text/x-patch
Size: 3554 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/llvm-commits/attachments/20210810/fac10e6b/attachment.bin>