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

[Pete Steinfeld via Phabricator via llvm-commits]

PeteSteinfeld created this revision.
Herald added a reviewer: sscalpone.
PeteSteinfeld requested review of this revision.
Herald added a project: LLVM.
Herald added a subscriber: llvm-commits.

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.


Repository:
  rG LLVM Github Monorepo

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
@@ -21,6 +21,7 @@
 using namespace std::placeholders; // _1, _2, &c. for std::bind()
 
 namespace Fortran::evaluate {
+class ShapeSpec;
 
 bool IsImpliedShape(const Symbol &original) {
   const Symbol &symbol{ResolveAssociations(original)};
@@ -316,6 +317,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 +351,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.365484.patch
Type: text/x-patch
Size: 3795 bytes
Desc: not available
URL: <http://lists.llvm.org/pipermail/llvm-commits/attachments/20210810/9584cb81/attachment.bin>