[flang-commits] [flang] 5795a81 - [flang] Fix "EQ" comparison of arrays

[Peter Steinfeld via flang-commits]

Author: Peter Steinfeld
Date: 2020-11-13T15:18:13-08:00
New Revision: 5795a81cbab879e353299556157dd5fd42cc7857

URL: https://github.com/llvm/llvm-project/commit/5795a81cbab879e353299556157dd5fd42cc7857
DIFF: https://github.com/llvm/llvm-project/commit/5795a81cbab879e353299556157dd5fd42cc7857.diff

LOG: [flang] Fix "EQ" comparison of arrays

When comparing arrays whose shapes do not conform, the contant folding
code ran into problems trying to get the value of an extent that did not
exist.  There were actually two problems.  First, the routine
"CheckConformance()" was returning "true" when the compiler was unable
to get the extent of an array.  Second, the function
"ApplyElementwise()" was calling "CheckConformance()" prior to folding
the elements of two arrays, but it was ignoring the return value.

Differential Revision: https://reviews.llvm.org/D91440

Added: 
    flang/test/Semantics/shape.f90

Modified: 
    flang/lib/Evaluate/fold-implementation.h
    flang/lib/Evaluate/shape.cpp

Removed: 
    


################################################################################
diff  --git a/flang/lib/Evaluate/fold-implementation.h b/flang/lib/Evaluate/fold-implementation.h
index 78df7e7b9312..ee3aaa3f9124 100644
--- a/flang/lib/Evaluate/fold-implementation.h
+++ b/flang/lib/Evaluate/fold-implementation.h
@@ -1113,7 +1113,13 @@ auto ApplyElementwise(FoldingContext &context,
         if (rightExpr.Rank() > 0) {
           if (std::optional<Shape> rightShape{GetShape(context, rightExpr)}) {
             if (auto right{AsFlatArrayConstructor(rightExpr)}) {
-              CheckConformance(context.messages(), *leftShape, *rightShape);
+              if (CheckConformance(
+                      context.messages(), *leftShape, *rightShape)) {
+                return MapOperation(context, std::move(f), *leftShape,
+                    std::move(*left), std::move(*right));
+              } else {
+                return std::nullopt;
+              }
               return MapOperation(context, std::move(f), *leftShape,
                   std::move(*left), std::move(*right));
             }

diff  --git a/flang/lib/Evaluate/shape.cpp b/flang/lib/Evaluate/shape.cpp
index bfc2447bd300..c672cc1a0cd7 100644
--- a/flang/lib/Evaluate/shape.cpp
+++ b/flang/lib/Evaluate/shape.cpp
@@ -682,6 +682,8 @@ auto GetShapeHelper::operator()(const ProcedureRef &call) const -> Result {
   return std::nullopt;
 }
 
+// Check conformance of the passed shapes.  Only return true if we can verify
+// that they conform
 bool CheckConformance(parser::ContextualMessages &messages, const Shape &left,
     const Shape &right, const char *leftIs, const char *rightIs) {
   int n{GetRank(left)};
@@ -693,15 +695,16 @@ bool CheckConformance(parser::ContextualMessages &messages, const Shape &left,
       return false;
     } else {
       for (int j{0}; j < n; ++j) {
-        if (auto leftDim{ToInt64(left[j])}) {
-          if (auto rightDim{ToInt64(right[j])}) {
-            if (*leftDim != *rightDim) {
-              messages.Say("Dimension %1$d of %2$s has extent %3$jd, "
-                           "but %4$s has extent %5$jd"_err_en_US,
-                  j + 1, leftIs, *leftDim, rightIs, *rightDim);
-              return false;
-            }
-          }
+        auto leftDim{ToInt64(left[j])};
+        auto rightDim{ToInt64(right[j])};
+        if (!leftDim || !rightDim) {
+          return false;
+        }
+        if (*leftDim != *rightDim) {
+          messages.Say("Dimension %1$d of %2$s has extent %3$jd, "
+                       "but %4$s has extent %5$jd"_err_en_US,
+              j + 1, leftIs, *leftDim, rightIs, *rightDim);
+          return false;
         }
       }
     }

diff  --git a/flang/test/Semantics/shape.f90 b/flang/test/Semantics/shape.f90
new file mode 100644
index 000000000000..ef0771bee5d4
--- /dev/null
+++ b/flang/test/Semantics/shape.f90
@@ -0,0 +1,41 @@
+! RUN: %S/test_errors.sh %s %t %f18
+! Test comparisons that use the intrinsic SHAPE() as an operand
+program testShape
+contains
+  subroutine sub1(arrayDummy)
+    integer :: arrayDummy(:)
+    integer, allocatable :: arrayDeferred(:)
+    integer :: arrayLocal(2) = [88, 99]
+    if (all(shape(arrayDummy)==shape(8))) then
+      print *, "hello"
+    end if
+    if (all(shape(27)==shape(arrayDummy))) then
+      print *, "hello"
+    end if
+    if (all(64==shape(arrayDummy))) then
+      print *, "hello"
+    end if
+    if (all(shape(arrayDeferred)==shape(8))) then
+      print *, "hello"
+    end if
+    if (all(shape(27)==shape(arrayDeferred))) then
+      print *, "hello"
+    end if
+    if (all(64==shape(arrayDeferred))) then
+      print *, "hello"
+    end if
+    !ERROR: Dimension 1 of left operand has extent 1, but right operand has extent 0
+    !ERROR: Dimension 1 of left operand has extent 1, but right operand has extent 0
+    if (all(shape(arrayLocal)==shape(8))) then
+      print *, "hello"
+    end if
+    !ERROR: Dimension 1 of left operand has extent 0, but right operand has extent 1
+    !ERROR: Dimension 1 of left operand has extent 0, but right operand has extent 1
+    if (all(shape(27)==shape(arrayLocal))) then
+      print *, "hello"
+    end if
+    if (all(64==shape(arrayLocal))) then
+      print *, "hello"
+    end if
+  end subroutine sub1
+end program testShape