[flang] Fold OUT_OF_RANGE()

Fold the F'2018 intrinsic function OUT_OF_RANGE(), which returns .TRUE.
when a conversion of an integer or real value to an integer or real type
would yield an overflow or (for real->integer only) invalid operand
exception.  Test all type combinations, with both rounding possibilities
for the real->integer cases.

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

Author: klausler

flang/lib/Evaluate/fold-logical.cpp

@@ -215,6 +215,115 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
     if (auto *expr{UnwrapExpr<Expr<SomeLogical>>(args[0])}) {
       return Fold(context, ConvertToType<T>(std::move(*expr)));
     }
+  } else if (name == "out_of_range") {
+    if (Expr<SomeType> * cx{UnwrapExpr<Expr<SomeType>>(args[0])}) {
+      auto restorer{context.messages().DiscardMessages()};
+      *args[0] = Fold(context, std::move(*cx));
+      if (Expr<SomeType> & folded{DEREF(args[0].value().UnwrapExpr())};
+          IsActuallyConstant(folded)) {
+        std::optional<std::vector<typename T::Scalar>> result;
+        if (Expr<SomeReal> * realMold{UnwrapExpr<Expr<SomeReal>>(args[1])}) {
+          if (const auto *xInt{UnwrapExpr<Expr<SomeInteger>>(folded)}) {
+            result.emplace();
+            std::visit(
+                [&](const auto &mold, const auto &x) {
+                  using RealType =
+                      typename std::decay_t<decltype(mold)>::Result;
+                  static_assert(RealType::category == TypeCategory::Real);
+                  using Scalar = typename RealType::Scalar;
+                  using xType = typename std::decay_t<decltype(x)>::Result;
+                  const auto &xConst{DEREF(UnwrapExpr<Constant<xType>>(x))};
+                  for (const auto &elt : xConst.values()) {
+                    result->emplace_back(
+                        Scalar::template FromInteger(elt).flags.test(
+                            RealFlag::Overflow));
+                  }
+                },
+                realMold->u, xInt->u);
+          } else if (const auto *xReal{UnwrapExpr<Expr<SomeReal>>(folded)}) {
+            result.emplace();
+            std::visit(
+                [&](const auto &mold, const auto &x) {
+                  using RealType =
+                      typename std::decay_t<decltype(mold)>::Result;
+                  static_assert(RealType::category == TypeCategory::Real);
+                  using Scalar = typename RealType::Scalar;
+                  using xType = typename std::decay_t<decltype(x)>::Result;
+                  const auto &xConst{DEREF(UnwrapExpr<Constant<xType>>(x))};
+                  for (const auto &elt : xConst.values()) {
+                    result->emplace_back(elt.IsFinite() &&
+                        Scalar::template Convert(elt).flags.test(
+                            RealFlag::Overflow));
+                  }
+                },
+                realMold->u, xReal->u);
+          }
+        } else if (Expr<SomeInteger> *
+            intMold{UnwrapExpr<Expr<SomeInteger>>(args[1])}) {
+          if (const auto *xInt{UnwrapExpr<Expr<SomeInteger>>(folded)}) {
+            result.emplace();
+            std::visit(
+                [&](const auto &mold, const auto &x) {
+                  using IntType = typename std::decay_t<decltype(mold)>::Result;
+                  static_assert(IntType::category == TypeCategory::Integer);
+                  using Scalar = typename IntType::Scalar;
+                  using xType = typename std::decay_t<decltype(x)>::Result;
+                  const auto &xConst{DEREF(UnwrapExpr<Constant<xType>>(x))};
+                  for (const auto &elt : xConst.values()) {
+                    result->emplace_back(
+                        Scalar::template ConvertSigned(elt).overflow);
+                  }
+                },
+                intMold->u, xInt->u);
+          } else if (Expr<SomeLogical> *
+                         cRound{args.size() >= 3
+                                 ? UnwrapExpr<Expr<SomeLogical>>(args[2])
+                                 : nullptr};
+                     !cRound || IsActuallyConstant(*args[2]->UnwrapExpr())) {
+            if (const auto *xReal{UnwrapExpr<Expr<SomeReal>>(folded)}) {
+              common::RoundingMode roundingMode{common::RoundingMode::ToZero};
+              if (cRound &&
+                  common::visit(
+                      [](const auto &x) {
+                        using xType =
+                            typename std::decay_t<decltype(x)>::Result;
+                        return GetScalarConstantValue<xType>(x)
+                            .value()
+                            .IsTrue();
+                      },
+                      cRound->u)) {
+                // ROUND=.TRUE. - convert with NINT()
+                roundingMode = common::RoundingMode::TiesAwayFromZero;
+              }
+              result.emplace();
+              std::visit(
+                  [&](const auto &mold, const auto &x) {
+                    using IntType =
+                        typename std::decay_t<decltype(mold)>::Result;
+                    static_assert(IntType::category == TypeCategory::Integer);
+                    using Scalar = typename IntType::Scalar;
+                    using xType = typename std::decay_t<decltype(x)>::Result;
+                    const auto &xConst{DEREF(UnwrapExpr<Constant<xType>>(x))};
+                    for (const auto &elt : xConst.values()) {
+                      // Note that OUT_OF_RANGE(Inf/NaN) is .TRUE. for the
+                      // real->integer case, but not for  real->real.
+                      result->emplace_back(!elt.IsFinite() ||
+                          elt.template ToInteger<Scalar>(roundingMode)
+                              .flags.test(RealFlag::Overflow));
+                    }
+                  },
+                  intMold->u, xReal->u);
+            }
+          }
+        }
+        if (result) {
+          if (auto extents{GetConstantExtents(context, folded)}) {
+            return Expr<T>{
+                Constant<T>{std::move(*result), std::move(*extents)}};
+          }
+        }
+      }
+    }
   } else if (name == "parity") {
     return FoldAllAnyParity(
         context, std::move(funcRef), &Scalar<T>::NEQV, Scalar<T>{false});
@@ -242,9 +351,7 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
       name == "__builtin_ieee_support_underflow_control") {
     return Expr<T>{true};
   }
-  // TODO: is_iostat_end,
-  // is_iostat_eor, logical, matmul, out_of_range,
-  // parity
+  // TODO: is_iostat_end, is_iostat_eor, logical, matmul, parity
   return Expr<T>{std::move(funcRef)};
 }