[flang] CheckConformance: tristate-ify result

[klausler]

Summary

To ensure that errors are emitted by CheckConformance and
its callers in all situations, it's necessary for the returned result
of that function to distinguish between three possible
outcomes: the arrays are known to conform at compilation time,
the arrays are known to not conform (and a message has been
produced), and an indeterminate result in which is not possible
to determine conformance. So convert CheckConformance's
result into an optional<bool>, and convert its confusing
Boolean flag arguments into a bit-set of named flags too.

[jeanPerier]

LGTM

flang/include/flang/Evaluate/characteristics.h

public:
   }
   const Shape &shape() const { return shape_; }
   const Attrs &attrs() const { return attrs_; }
   int corank() const { return corank_; }
 
   int Rank() const { return GetRank(shape_); }
   bool IsCompatibleWith(parser::ContextualMessages &, const TypeAndShape &that,
       const char *thisIs = "pointer", const char *thatIs = "target",
-      bool isElemental = false, bool thisIsDeferredShape = false,
-      bool thatIsDeferredShape = false) const;
+      bool isElemental = false,
+      enum CheckConformanceFlags::Flags = CheckConformanceFlags::None) const;
   std::optional<Expr<SubscriptInteger>> MeasureElementSizeInBytes(
       FoldingContext &, bool align) const;
   std::optional<Expr<SubscriptInteger>> MeasureSizeInBytes(
       FoldingContext &) const;
 
   // called by Fold() to rewrite in place
   TypeAndShape &Rewrite(FoldingContext &);
 

flang/include/flang/Evaluate/shape.h

std::optional<ConstantSubscripts> GetConstantExtents(
   if (auto shape{GetShape(context, x)}) {
     return AsConstantExtents(context, *shape);
   } else {
     return std::nullopt;
   }
 }
 
 // Compilation-time shape conformance checking, when corresponding extents
-// are known.
-bool CheckConformance(parser::ContextualMessages &, const Shape &left,
-    const Shape &right, const char *leftIs = "left operand",
-    const char *rightIs = "right operand", bool leftScalarExpandable = true,
-    bool rightScalarExpandable = true, bool leftIsDeferredShape = false,
-    bool rightIsDeferredShape = false);
+// are or should be known.  The result is an optional Boolean:
+//  - nullopt: no error found or reported, but conformance cannot
+//    be guaranteed during compilation; this result is possible only
+//    when one or both arrays are allowed to have deferred shape
+//  - true: no error found or reported, arrays conform
+//  - false: errors found and reported
+// Use "CheckConformance(...).value_or()" to specify a default result
+// when you don't care whether messages have been emitted.
+struct CheckConformanceFlags {
+  enum Flags {
+    None = 0,
+    LeftScalarExpandable = 1,
+    RightScalarExpandable = 2,
+    LeftIsDeferredShape = 4,
+    RightIsDeferredShape = 8,
+    EitherScalarExpandable = LeftScalarExpandable | RightScalarExpandable,
+    BothDeferredShape = LeftIsDeferredShape | RightIsDeferredShape,
+    RightIsExpandableDeferred = RightScalarExpandable | RightIsDeferredShape,
+  };
+};
+std::optional<bool> CheckConformance(parser::ContextualMessages &,
+    const Shape &left, const Shape &right,
+    CheckConformanceFlags::Flags flags = CheckConformanceFlags::None,
+    const char *leftIs = "left operand", const char *rightIs = "right operand");
 
 // Increments one-based subscripts in element order (first varies fastest)
 // and returns true when they remain in range; resets them all to one and
 // return false otherwise (including the case where one or more of the
 // extents are zero).
 bool IncrementSubscripts(
     ConstantSubscripts &, const ConstantSubscripts &extents);
 
 } // namespace Fortran::evaluate
 #endif // FORTRAN_EVALUATE_SHAPE_H_

flang/lib/Evaluate/characteristics.cpp

 
 std::optional<TypeAndShape> TypeAndShape::Characterize(
     const ActualArgument &arg, FoldingContext &context) {
   return Characterize(arg.UnwrapExpr(), context);
 }
 
 bool TypeAndShape::IsCompatibleWith(parser::ContextualMessages &messages,
     const TypeAndShape &that, const char *thisIs, const char *thatIs,
-    bool isElemental, bool thisIsDeferredShape,
-    bool thatIsDeferredShape) const {
+    bool isElemental, enum CheckConformanceFlags::Flags flags) const {
   if (!type_.IsTkCompatibleWith(that.type_)) {
     messages.Say(
         "%1$s type '%2$s' is not compatible with %3$s type '%4$s'"_err_en_US,
         thatIs, that.AsFortran(), thisIs, AsFortran());
     return false;
   }
   return isElemental ||
-      CheckConformance(messages, shape_, that.shape_, thisIs, thatIs, false,
-          false /* no scalar expansion */, thisIsDeferredShape,
-          thatIsDeferredShape);
+      CheckConformance(messages, shape_, that.shape_, flags, thisIs, thatIs)
+          .value_or(true /*fail only when nonconformance is known now*/);
 }
 
 std::optional<Expr<SubscriptInteger>> TypeAndShape::MeasureElementSizeInBytes(
     FoldingContext &foldingContext, bool align) const {
   if (LEN_) {
     CHECK(type_.category() == TypeCategory::Character);
     return Fold(foldingContext,
         Expr<SubscriptInteger>{type_.kind()} * Expr<SubscriptInteger>{*LEN_});

flang/lib/Evaluate/check-expression.cpp

if (auto converted{ConvertToType(symTS->type(), std::move(x))}) {
           } else if (folded.Rank() == 0 && symRank > 0) {
             // expand the scalar constant to an array
             return ScalarConstantExpander{std::move(*extents),
                 AsConstantExtents(
                     context, GetLowerBounds(context, NamedEntity{symbol}))}
                 .Expand(std::move(folded));
           } else if (auto resultShape{GetShape(context, folded)}) {
             if (CheckConformance(context.messages(), symTS->shape(),
-                    *resultShape, "initialized object",
-                    "initialization expression", false, false)) {
+                    *resultShape, CheckConformanceFlags::None,
+                    "initialized object", "initialization expression")
+                    .value_or(false /*fail if not known now to conform*/)) {
               // make a constant array with adjusted lower bounds
               return ArrayConstantBoundChanger{
                   std::move(*AsConstantExtents(
                       context, GetLowerBounds(context, NamedEntity{symbol})))}
                   .ChangeLbounds(std::move(folded));
             }
           }
         } else if (IsNamedConstant(symbol)) {

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)}) {
-              if (CheckConformance(
-                      context.messages(), *leftShape, *rightShape)) {
+              if (CheckConformance(context.messages(), *leftShape, *rightShape,
+                      CheckConformanceFlags::EitherScalarExpandable)
+                      .value_or(false /*fail if not known now to conform*/)) {
                 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));
             }

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,
-    bool leftScalarExpandable, bool rightScalarExpandable,
-    bool leftIsDeferredShape, bool rightIsDeferredShape) {
+// Check conformance of the passed shapes.
+std::optional<bool> CheckConformance(parser::ContextualMessages &messages,
+    const Shape &left, const Shape &right, CheckConformanceFlags::Flags flags,
+    const char *leftIs, const char *rightIs) {
   int n{GetRank(left)};
-  if (n == 0 && leftScalarExpandable) {
+  if (n == 0 && (flags & CheckConformanceFlags::LeftScalarExpandable)) {
     return true;
   }
   int rn{GetRank(right)};
-  if (rn == 0 && rightScalarExpandable) {
+  if (rn == 0 && (flags & CheckConformanceFlags::RightScalarExpandable)) {
     return true;
   }
   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;
   }
   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;
         }
-      } else if (!rightIsDeferredShape) {
-        return false;
+      } else if (!(flags & CheckConformanceFlags::RightIsDeferredShape)) {
+        return std::nullopt;
       }
-    } else if (!leftIsDeferredShape) {
-      return false;
+    } else if (!(flags & CheckConformanceFlags::LeftIsDeferredShape)) {
+      return std::nullopt;
     }
   }
   return true;
 }
 
 bool IncrementSubscripts(
     ConstantSubscripts &indices, const ConstantSubscripts &extents) {
   std::size_t rank(indices.size());

flang/lib/Semantics/check-call.cpp

if (isElemental) {
                    characteristics::TypeAndShape::Attr::AssumedShape) &&
         (actualType.Rank() > 0 || IsArrayElement(actual))) {
       // Sequence association (15.5.2.11) applies -- rank need not match
       // if the actual argument is an array or array element designator.
     } else {
       // Let CheckConformance accept scalars; storage association
       // cases are checked here below.
       CheckConformance(messages, dummy.type.shape(), actualType.shape(),
-          "dummy argument", "actual argument", true, true);
+          evaluate::CheckConformanceFlags::EitherScalarExpandable,
+          "dummy argument", "actual argument");
     }
   } else {
     const auto &len{actualType.LEN()};
     messages.Say(
         "Actual argument type '%s' is not compatible with dummy argument type '%s'"_err_en_US,
         actualType.type().AsFortran(len ? len->AsFortran() : ""),
         dummy.type.type().AsFortran());
   }

flang/lib/Semantics/expression.cpp

if (symbol) {
           if (auto componentShape{GetShape(GetFoldingContext(), *symbol)}) {
             if (auto valueShape{GetShape(GetFoldingContext(), *converted)}) {
               if (GetRank(*componentShape) == 0 && GetRank(*valueShape) > 0) {
                 AttachDeclaration(
                     Say(expr.source,
                         "Rank-%d array value is not compatible with scalar component '%s'"_err_en_US,
                         GetRank(*valueShape), symbol->name()),
                     *symbol);
-              } else if (CheckConformance(messages, *componentShape,
-                             *valueShape, "component", "value", false,
-                             true /* can expand scalar value */)) {
-                if (GetRank(*componentShape) > 0 && GetRank(*valueShape) == 0 &&
+              } else {
+                auto checked{
+                    CheckConformance(messages, *componentShape, *valueShape,
+                        CheckConformanceFlags::RightIsExpandableDeferred,
+                        "component", "value")};
+                if (checked && *checked && GetRank(*componentShape) > 0 &&
+                    GetRank(*valueShape) == 0 &&
                     !IsExpandableScalar(*converted)) {
                   AttachDeclaration(
                       Say(expr.source,
                           "Scalar value cannot be expanded to shape of array component '%s'"_err_en_US,
                           symbol->name()),
                       *symbol);
-                } else {
+                }
+                if (checked.value_or(true)) {
                   result.Add(*symbol, std::move(*converted));
                 }
               }
             } else {
               Say(expr.source, "Shape of value cannot be determined"_err_en_US);
             }
           } else {
             AttachDeclaration(
if (actuals_.size() == 2) {
     const auto *lhs{actuals_.at(0).value().UnwrapExpr()};
     const auto *rhs{actuals_.at(1).value().UnwrapExpr()};
     if (lhs && rhs) {
       auto &foldingContext{context_.GetFoldingContext()};
       auto lhShape{GetShape(foldingContext, *lhs)};
       auto rhShape{GetShape(foldingContext, *rhs)};
       if (lhShape && rhShape) {
         return evaluate::CheckConformance(foldingContext.messages(), *lhShape,
-            *rhShape, "left operand", "right operand", true,
-            true /* scalar expansion is allowed */);
+            *rhShape, CheckConformanceFlags::EitherScalarExpandable,
+            "left operand", "right operand")
+            .value_or(false /*fail when conformance is not known now*/);
       }
     }
   }
   return true; // no proven problem
 }
 
 MaybeExpr ArgumentAnalyzer::TryDefinedOp(
     const char *opr, parser::MessageFixedText &&error, bool isUserOp) {

flang/lib/Semantics/pointer-assignment.cpp

msg = "%s is associated with the result of a reference to function '%s'"
       !funcResult->attrs.test(FunctionResult::Attr::Contiguous)) {
     msg = "CONTIGUOUS %s is associated with the result of reference to"
           " function '%s' that is not contiguous"_err_en_US;
   } else if (lhsType_) {
     const auto *frTypeAndShape{funcResult->GetTypeAndShape()};
     CHECK(frTypeAndShape);
     if (!lhsType_->IsCompatibleWith(context_.messages(), *frTypeAndShape,
             "pointer", "function result", false /*elemental*/,
-            true /*left: deferred shape*/, true /*right: deferred shape*/)) {
+            evaluate::CheckConformanceFlags::BothDeferredShape)) {
       msg = "%s is associated with the result of a reference to function '%s'"
             " whose pointer result has an incompatible type or shape"_err_en_US;
     }
   }
   if (msg) {
     auto restorer{common::ScopedSet(lhs_, symbol)};
     Say(*msg, description_, funcName);
     return false;