[flang] Fix "EQ" comparison of arrays

[PeteSteinfeld]

Summary

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.

[klausler]

flang/lib/Evaluate/shape.cpp

698

Might be more readable if restructured. Two possible ways:

for (int j{0}; j < n; ++j) {

auto leftDim{...}, rightDim{...};
if (!leftDim || !rightDim) { return false; }
if (*leftDim != *rightDim) { Say(...); return false; }

}

or

for (int j{0}; j < n; ++j) {

if (auto leftDim{...}) {
  if (auto rightDim{...}) {
    if (*leftDim == *rightDim) {
      continue;
    }
    Say(...);
  }
}
return false;

}

[PeteSteinfeld]

flang/lib/Evaluate/shape.cpp

698

Thanks for the suggestions. I like the first one. I'll rework the code.

[PeteSteinfeld]

Reworked the code to check array shape conformance as suggested by Peter.

flang/lib/Evaluate/fold-implementation.h

auto ApplyElementwise(FoldingContext &context,
   auto &rightExpr{operation.right()};
   rightExpr = Fold(context, std::move(rightExpr));
   if (leftExpr.Rank() > 0) {
     if (std::optional<Shape> leftShape{GetShape(context, leftExpr)}) {
       if (auto left{AsFlatArrayConstructor(leftExpr)}) {
         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));
             }
           }
         } else if (IsExpandableScalar(rightExpr)) {
           return MapOperation(
               context, std::move(f), *leftShape, std::move(*left), rightExpr);
         }

flang/lib/Evaluate/shape.cpp

if (intrinsic->name == "shape" || intrinsic->name == "lbound" ||
       return (*this)(call.arguments());
     } else {
       // TODO: shapes of other non-elemental intrinsic results
     }
   }
   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)};
   int rn{GetRank(right)};
   if (n != 0 && rn != 0) {
     if (n != rn) {
       messages.Say("Rank of %1$s is %2$d, but %3$s has rank %4$d"_err_en_US,
           leftIs, n, rightIs, rn);
       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;
+        }
   return true;
 }
 
 bool IncrementSubscripts(
     ConstantSubscripts &indices, const ConstantSubscripts &extents) {
   std::size_t rank(indices.size());
   CHECK(rank <= extents.size());
   for (std::size_t j{0}; j < rank; ++j) {

flang/test/Semantics/shape.f90

+! 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