[flang-commits] [flang] 1444e5a - [flang] Complete implementation of OUT_OF_RANGE() (#89334)

via flang-commits flang-commits at lists.llvm.org
Mon Apr 22 15:46:04 PDT 2024


Author: Peter Klausler
Date: 2024-04-22T15:46:00-07:00
New Revision: 1444e5acfb75630c23b118c39454a05cf3792d35

URL: https://github.com/llvm/llvm-project/commit/1444e5acfb75630c23b118c39454a05cf3792d35
DIFF: https://github.com/llvm/llvm-project/commit/1444e5acfb75630c23b118c39454a05cf3792d35.diff

LOG: [flang] Complete implementation of OUT_OF_RANGE() (#89334)

The intrinsic function OUT_OF_RANGE() lacks support in lowering and the
runtime. This patch obviates a need for any such support by implementing
OUT_OF_RANGE() via rewriting in semantics. This rewriting of
OUT_OF_RANGE() calls replaces the existing code that folds
OUT_OF_RANGE() calls with constant arguments.

Some changes and fixes were necessary outside of OUT_OF_RANGE()'s
folding code (now rewriting code), whose testing exposed some other
issues worth fixing.

- The common::RealDetails<> template class was recoded in terms of a new
base class with a constexpr constructor, so that the the characteristics
of the various REAL kinds could be queried dynamically as well. This
affected some client usage.
- There were bugs in the code that folds TRANSFER() when the type of X
or MOLD was REAL(10) -- this is a type that occupies 16 bytes per
element in execution memory but only 10 bytes (was 12) in the data of
std::vector<Scalar<>> in a Constant<>.
- Folds of REAL->REAL conversions weren't preserving infinities.

Added: 
    flang/test/Evaluate/rewrite-out_of_range.F90

Modified: 
    flang/include/flang/Common/real.h
    flang/include/flang/Decimal/binary-floating-point.h
    flang/include/flang/Evaluate/complex.h
    flang/include/flang/Evaluate/integer.h
    flang/include/flang/Evaluate/real.h
    flang/include/flang/Evaluate/type.h
    flang/lib/Decimal/big-radix-floating-point.h
    flang/lib/Evaluate/complex.cpp
    flang/lib/Evaluate/fold-logical.cpp
    flang/lib/Evaluate/integer.cpp
    flang/lib/Evaluate/real.cpp
    flang/test/Evaluate/fold-out_of_range.f90

Removed: 
    


################################################################################
diff  --git a/flang/include/flang/Common/real.h b/flang/include/flang/Common/real.h
index 49c400b368a2c1..b527deda0e3b4f 100644
--- a/flang/include/flang/Common/real.h
+++ b/flang/include/flang/Common/real.h
@@ -108,7 +108,27 @@ static constexpr int PrecisionOfRealKind(int kind) {
   }
 }
 
-template <int BINARY_PRECISION> class RealDetails {
+// RealCharacteristics is constexpr, but also useful when constructed
+// with a non-constant precision argument.
+class RealCharacteristics {
+public:
+  explicit constexpr RealCharacteristics(int p) : binaryPrecision{p} {}
+
+  int binaryPrecision;
+  int bits{BitsForBinaryPrecision(binaryPrecision)};
+  bool isImplicitMSB{binaryPrecision != 64 /*x87*/};
+  int significandBits{binaryPrecision - isImplicitMSB};
+  int exponentBits{bits - significandBits - 1 /*sign*/};
+  int maxExponent{(1 << exponentBits) - 1};
+  int exponentBias{maxExponent / 2};
+  int decimalPrecision{LogBaseTwoToLogBaseTen(binaryPrecision - 1)};
+  int decimalRange{LogBaseTwoToLogBaseTen(exponentBias - 1)};
+  // Number of significant decimal digits in the fraction of the
+  // exact conversion of the least nonzero subnormal.
+  int maxDecimalConversionDigits{MaxDecimalConversionDigits(binaryPrecision)};
+  int maxHexadecimalConversionDigits{
+      MaxHexadecimalConversionDigits(binaryPrecision)};
+
 private:
   // Converts bit widths to whole decimal digits
   static constexpr int LogBaseTwoToLogBaseTen(int logb2) {
@@ -118,33 +138,6 @@ template <int BINARY_PRECISION> class RealDetails {
         (logb2 * LogBaseTenOfTwoTimesTenToThe12th) / TenToThe12th};
     return static_cast<int>(logb10);
   }
-
-public:
-  RT_OFFLOAD_VAR_GROUP_BEGIN
-  static constexpr int binaryPrecision{BINARY_PRECISION};
-  static constexpr int bits{BitsForBinaryPrecision(binaryPrecision)};
-  static constexpr bool isImplicitMSB{binaryPrecision != 64 /*x87*/};
-  static constexpr int significandBits{binaryPrecision - isImplicitMSB};
-  static constexpr int exponentBits{bits - significandBits - 1 /*sign*/};
-  static constexpr int maxExponent{(1 << exponentBits) - 1};
-  static constexpr int exponentBias{maxExponent / 2};
-
-  static constexpr int decimalPrecision{
-      LogBaseTwoToLogBaseTen(binaryPrecision - 1)};
-  static constexpr int decimalRange{LogBaseTwoToLogBaseTen(exponentBias - 1)};
-
-  // Number of significant decimal digits in the fraction of the
-  // exact conversion of the least nonzero subnormal.
-  static constexpr int maxDecimalConversionDigits{
-      MaxDecimalConversionDigits(binaryPrecision)};
-
-  static constexpr int maxHexadecimalConversionDigits{
-      MaxHexadecimalConversionDigits(binaryPrecision)};
-  RT_OFFLOAD_VAR_GROUP_END
-
-  static_assert(binaryPrecision > 0);
-  static_assert(exponentBits > 1);
-  static_assert(exponentBits <= 15);
 };
 
 } // namespace Fortran::common

diff  --git a/flang/include/flang/Decimal/binary-floating-point.h b/flang/include/flang/Decimal/binary-floating-point.h
index 4919c1f9d240f4..1e0cde97d98e61 100644
--- a/flang/include/flang/Decimal/binary-floating-point.h
+++ b/flang/include/flang/Decimal/binary-floating-point.h
@@ -30,21 +30,20 @@ enum FortranRounding {
   RoundCompatible, /* RC: like RN, but ties go away from 0 */
 };
 
-template <int BINARY_PRECISION>
-class BinaryFloatingPointNumber : public common::RealDetails<BINARY_PRECISION> {
+template <int BINARY_PRECISION> class BinaryFloatingPointNumber {
 public:
-  using Details = common::RealDetails<BINARY_PRECISION>;
-  using Details::binaryPrecision;
-  using Details::bits;
-  using Details::decimalPrecision;
-  using Details::decimalRange;
-  using Details::exponentBias;
-  using Details::exponentBits;
-  using Details::isImplicitMSB;
-  using Details::maxDecimalConversionDigits;
-  using Details::maxExponent;
-  using Details::maxHexadecimalConversionDigits;
-  using Details::significandBits;
+  static constexpr common::RealCharacteristics realChars{BINARY_PRECISION};
+  static constexpr int binaryPrecision{BINARY_PRECISION};
+  static constexpr int bits{realChars.bits};
+  static constexpr int isImplicitMSB{realChars.isImplicitMSB};
+  static constexpr int significandBits{realChars.significandBits};
+  static constexpr int exponentBits{realChars.exponentBits};
+  static constexpr int exponentBias{realChars.exponentBias};
+  static constexpr int maxExponent{realChars.maxExponent};
+  static constexpr int decimalPrecision{realChars.decimalPrecision};
+  static constexpr int decimalRange{realChars.decimalRange};
+  static constexpr int maxDecimalConversionDigits{
+      realChars.maxDecimalConversionDigits};
 
   using RawType = common::HostUnsignedIntType<bits>;
   static_assert(CHAR_BIT * sizeof(RawType) >= bits);

diff  --git a/flang/include/flang/Evaluate/complex.h b/flang/include/flang/Evaluate/complex.h
index 200965ed92121f..06eef842410944 100644
--- a/flang/include/flang/Evaluate/complex.h
+++ b/flang/include/flang/Evaluate/complex.h
@@ -104,7 +104,7 @@ extern template class Complex<Real<Integer<16>, 11>>;
 extern template class Complex<Real<Integer<16>, 8>>;
 extern template class Complex<Real<Integer<32>, 24>>;
 extern template class Complex<Real<Integer<64>, 53>>;
-extern template class Complex<Real<Integer<80>, 64>>;
+extern template class Complex<Real<X87IntegerContainer, 64>>;
 extern template class Complex<Real<Integer<128>, 113>>;
 } // namespace Fortran::evaluate::value
 #endif // FORTRAN_EVALUATE_COMPLEX_H_

diff  --git a/flang/include/flang/Evaluate/integer.h b/flang/include/flang/Evaluate/integer.h
index b62e2bcb90f2f3..10a13115a39e00 100644
--- a/flang/include/flang/Evaluate/integer.h
+++ b/flang/include/flang/Evaluate/integer.h
@@ -50,9 +50,12 @@ namespace Fortran::evaluate::value {
 // named accordingly in ALL CAPS so that they can be referenced easily in
 // the language standard.
 template <int BITS, bool IS_LITTLE_ENDIAN = isHostLittleEndian,
-    int PARTBITS = BITS <= 32 ? BITS : 32,
+    int PARTBITS = BITS <= 32 ? BITS
+        : BITS % 32 == 0      ? 32
+        : BITS % 16 == 0      ? 16
+                              : 8,
     typename PART = HostUnsignedInt<PARTBITS>,
-    typename BIGPART = HostUnsignedInt<PARTBITS * 2>>
+    typename BIGPART = HostUnsignedInt<PARTBITS * 2>, int ALIGNMENT = BITS>
 class Integer {
 public:
   static constexpr int bits{BITS};
@@ -79,6 +82,8 @@ class Integer {
   static_assert((parts - 1) * partBits + topPartBits == bits);
   static constexpr Part partMask{static_cast<Part>(~0) >> extraPartBits};
   static constexpr Part topPartMask{static_cast<Part>(~0) >> extraTopPartBits};
+  static constexpr int partsWithAlignment{
+      (ALIGNMENT + partBits - 1) / partBits};
 
 public:
   // Some types used for member function results
@@ -1043,14 +1048,16 @@ class Integer {
     }
   }
 
-  Part part_[parts]{};
+  Part part_[partsWithAlignment]{};
 };
 
 extern template class Integer<8>;
 extern template class Integer<16>;
 extern template class Integer<32>;
 extern template class Integer<64>;
-extern template class Integer<80>;
+using X87IntegerContainer =
+    Integer<80, true, 16, std::uint16_t, std::uint32_t, 128>;
+extern template class Integer<80, true, 16, std::uint16_t, std::uint32_t, 128>;
 extern template class Integer<128>;
 } // namespace Fortran::evaluate::value
 #endif // FORTRAN_EVALUATE_INTEGER_H_

diff  --git a/flang/include/flang/Evaluate/real.h b/flang/include/flang/Evaluate/real.h
index 6f2466c9da6773..cb3c0036e0cfae 100644
--- a/flang/include/flang/Evaluate/real.h
+++ b/flang/include/flang/Evaluate/real.h
@@ -35,20 +35,19 @@ static constexpr std::int64_t ScaledLogBaseTenOfTwo{301029995664};
 // class template must be (or look like) an instance of Integer<>;
 // the second specifies the number of effective bits (binary precision)
 // in the fraction.
-template <typename WORD, int PREC>
-class Real : public common::RealDetails<PREC> {
+template <typename WORD, int PREC> class Real {
 public:
   using Word = WORD;
   static constexpr int binaryPrecision{PREC};
-  using Details = common::RealDetails<PREC>;
-  using Details::exponentBias;
-  using Details::exponentBits;
-  using Details::isImplicitMSB;
-  using Details::maxExponent;
-  using Details::significandBits;
+  static constexpr common::RealCharacteristics realChars{PREC};
+  static constexpr int exponentBias{realChars.exponentBias};
+  static constexpr int exponentBits{realChars.exponentBits};
+  static constexpr int isImplicitMSB{realChars.isImplicitMSB};
+  static constexpr int maxExponent{realChars.maxExponent};
+  static constexpr int significandBits{realChars.significandBits};
 
   static constexpr int bits{Word::bits};
-  static_assert(bits >= Details::bits);
+  static_assert(bits >= realChars.bits);
   using Fraction = Integer<binaryPrecision>; // all bits made explicit
 
   template <typename W, int P> friend class Real;
@@ -205,8 +204,8 @@ class Real : public common::RealDetails<PREC> {
   }
 
   static constexpr int DIGITS{binaryPrecision};
-  static constexpr int PRECISION{Details::decimalPrecision};
-  static constexpr int RANGE{Details::decimalRange};
+  static constexpr int PRECISION{realChars.decimalPrecision};
+  static constexpr int RANGE{realChars.decimalRange};
   static constexpr int MAXEXPONENT{maxExponent - exponentBias};
   static constexpr int MINEXPONENT{2 - exponentBias};
   Real RRSPACING() const;
@@ -371,6 +370,10 @@ class Real : public common::RealDetails<PREC> {
       return result;
     }
     bool isNegative{x.IsNegative()};
+    if (x.IsInfinite()) {
+      result.value = Infinity(isNegative);
+      return result;
+    }
     A absX{x};
     if (isNegative) {
       absX = x.Negate();
@@ -493,7 +496,7 @@ extern template class Real<Integer<16>, 11>; // IEEE half format
 extern template class Real<Integer<16>, 8>; // the "other" half format
 extern template class Real<Integer<32>, 24>; // IEEE single
 extern template class Real<Integer<64>, 53>; // IEEE double
-extern template class Real<Integer<80>, 64>; // 80387 extended precision
+extern template class Real<X87IntegerContainer, 64>; // 80387 extended precision
 extern template class Real<Integer<128>, 113>; // IEEE quad
 // N.B. No "double-double" support.
 } // namespace Fortran::evaluate::value

diff  --git a/flang/include/flang/Evaluate/type.h b/flang/include/flang/Evaluate/type.h
index da6efea6f8a742..93a0f21fa91455 100644
--- a/flang/include/flang/Evaluate/type.h
+++ b/flang/include/flang/Evaluate/type.h
@@ -296,7 +296,10 @@ class Type<TypeCategory::Real, KIND>
 public:
   static constexpr int precision{common::PrecisionOfRealKind(KIND)};
   static constexpr int bits{common::BitsForBinaryPrecision(precision)};
-  using Scalar = value::Real<value::Integer<bits>, precision>;
+  using Scalar =
+      value::Real<std::conditional_t<precision == 64,
+                      value::X87IntegerContainer, value::Integer<bits>>,
+          precision>;
 };
 
 // The KIND type parameter on COMPLEX is the kind of each of its components.

diff  --git a/flang/lib/Decimal/big-radix-floating-point.h b/flang/lib/Decimal/big-radix-floating-point.h
index 6ce8ae7925c150..f9afebf5b3d703 100644
--- a/flang/lib/Decimal/big-radix-floating-point.h
+++ b/flang/lib/Decimal/big-radix-floating-point.h
@@ -83,6 +83,8 @@ template <int PREC, int LOG10RADIX = 16> class BigRadixFloatingPointNumber {
     return *this;
   }
 
+  RT_API_ATTRS bool IsInteger() const { return exponent_ >= 0; }
+
   // Converts decimal floating-point to binary.
   RT_API_ATTRS ConversionToBinaryResult<PREC> ConvertToBinary();
 

diff  --git a/flang/lib/Evaluate/complex.cpp b/flang/lib/Evaluate/complex.cpp
index e683d7e0229ca5..ab83f193e3f3e1 100644
--- a/flang/lib/Evaluate/complex.cpp
+++ b/flang/lib/Evaluate/complex.cpp
@@ -120,6 +120,6 @@ template class Complex<Real<Integer<16>, 11>>;
 template class Complex<Real<Integer<16>, 8>>;
 template class Complex<Real<Integer<32>, 24>>;
 template class Complex<Real<Integer<64>, 53>>;
-template class Complex<Real<Integer<80>, 64>>;
+template class Complex<Real<X87IntegerContainer, 64>>;
 template class Complex<Real<Integer<128>, 113>>;
 } // namespace Fortran::evaluate::value

diff  --git a/flang/lib/Evaluate/fold-logical.cpp b/flang/lib/Evaluate/fold-logical.cpp
index 5a9596f3c274b5..4c1afe9a0f2952 100644
--- a/flang/lib/Evaluate/fold-logical.cpp
+++ b/flang/lib/Evaluate/fold-logical.cpp
@@ -41,6 +41,586 @@ static Expr<T> FoldAllAnyParity(FoldingContext &context, FunctionRef<T> &&ref,
   return Expr<T>{std::move(ref)};
 }
 
+// OUT_OF_RANGE(x,mold[,round]) references are entirely rewritten here into
+// expressions, which are then folded into constants when 'x' and 'round'
+// are constant.  It is guaranteed that 'x' is evaluated at most once.
+
+template <int X_RKIND, int MOLD_IKIND>
+Expr<SomeReal> RealToIntBoundHelper(bool round, bool negate) {
+  using RType = Type<TypeCategory::Real, X_RKIND>;
+  using RealType = Scalar<RType>;
+  using IntType = Scalar<Type<TypeCategory::Integer, MOLD_IKIND>>;
+  RealType result{}; // 0.
+  common::RoundingMode roundingMode{round
+          ? common::RoundingMode::TiesAwayFromZero
+          : common::RoundingMode::ToZero};
+  // Add decreasing powers of two to the result to find the largest magnitude
+  // value that can be converted to the integer type without overflow.
+  RealType at{RealType::FromInteger(IntType{negate ? -1 : 1}).value};
+  bool decrement{true};
+  while (!at.template ToInteger<IntType>(roundingMode)
+              .flags.test(RealFlag::Overflow)) {
+    auto tmp{at.SCALE(IntType{1})};
+    if (tmp.flags.test(RealFlag::Overflow)) {
+      decrement = false;
+      break;
+    }
+    at = tmp.value;
+  }
+  while (true) {
+    if (decrement) {
+      at = at.SCALE(IntType{-1}).value;
+    } else {
+      decrement = true;
+    }
+    auto tmp{at.Add(result)};
+    if (tmp.flags.test(RealFlag::Inexact)) {
+      break;
+    } else if (!tmp.value.template ToInteger<IntType>(roundingMode)
+                    .flags.test(RealFlag::Overflow)) {
+      result = tmp.value;
+    }
+  }
+  return AsCategoryExpr(Constant<RType>{std::move(result)});
+}
+
+static Expr<SomeReal> RealToIntBound(
+    int xRKind, int moldIKind, bool round, bool negate) {
+  switch (xRKind) {
+#define ICASES(RK) \
+  switch (moldIKind) { \
+  case 1: \
+    return RealToIntBoundHelper<RK, 1>(round, negate); \
+    break; \
+  case 2: \
+    return RealToIntBoundHelper<RK, 2>(round, negate); \
+    break; \
+  case 4: \
+    return RealToIntBoundHelper<RK, 4>(round, negate); \
+    break; \
+  case 8: \
+    return RealToIntBoundHelper<RK, 8>(round, negate); \
+    break; \
+  case 16: \
+    return RealToIntBoundHelper<RK, 16>(round, negate); \
+    break; \
+  } \
+  break
+  case 2:
+    ICASES(2);
+    break;
+  case 3:
+    ICASES(3);
+    break;
+  case 4:
+    ICASES(4);
+    break;
+  case 8:
+    ICASES(8);
+    break;
+  case 10:
+    ICASES(10);
+    break;
+  case 16:
+    ICASES(16);
+    break;
+  }
+  DIE("RealToIntBound: no case");
+#undef ICASES
+}
+
+class RealToIntLimitHelper {
+public:
+  using Result = std::optional<Expr<SomeReal>>;
+  using Types = RealTypes;
+  RealToIntLimitHelper(
+      FoldingContext &context, Expr<SomeReal> &&hi, Expr<SomeReal> &lo)
+      : context_{context}, hi_{std::move(hi)}, lo_{lo} {}
+  template <typename T> Result Test() {
+    if (UnwrapExpr<Expr<T>>(hi_)) {
+      bool promote{T::kind < 16};
+      Result constResult;
+      if (auto hiV{GetScalarConstantValue<T>(hi_)}) {
+        auto loV{GetScalarConstantValue<T>(lo_)};
+        CHECK(loV.has_value());
+        auto 
diff {hiV->Subtract(*loV, Rounding{common::RoundingMode::ToZero})};
+        promote = promote &&
+            (
diff .flags.test(RealFlag::Overflow) ||
+                
diff .flags.test(RealFlag::Inexact));
+        constResult = AsCategoryExpr(Constant<T>{std::move(
diff .value)});
+      }
+      if (promote) {
+        constexpr int nextKind{T::kind < 4 ? 4 : T::kind == 4 ? 8 : 16};
+        using T2 = Type<TypeCategory::Real, nextKind>;
+        hi_ = Expr<SomeReal>{Fold(context_, ConvertToType<T2>(std::move(hi_)))};
+        lo_ = Expr<SomeReal>{Fold(context_, ConvertToType<T2>(std::move(lo_)))};
+        if (constResult) {
+          // Use promoted constants on next iteration of SearchTypes
+          return std::nullopt;
+        }
+      }
+      if (constResult) {
+        return constResult;
+      } else {
+        return AsCategoryExpr(std::move(hi_) - Expr<SomeReal>{lo_});
+      }
+    } else {
+      return std::nullopt;
+    }
+  }
+
+private:
+  FoldingContext &context_;
+  Expr<SomeReal> hi_;
+  Expr<SomeReal> &lo_;
+};
+
+static std::optional<Expr<SomeReal>> RealToIntLimit(
+    FoldingContext &context, Expr<SomeReal> &&hi, Expr<SomeReal> &lo) {
+  return common::SearchTypes(RealToIntLimitHelper{context, std::move(hi), lo});
+}
+
+// RealToRealBounds() returns a pair (HUGE(x),REAL(HUGE(mold),KIND(x)))
+// when REAL(HUGE(x),KIND(mold)) overflows, and std::nullopt otherwise.
+template <int X_RKIND, int MOLD_RKIND>
+std::optional<std::pair<Expr<SomeReal>, Expr<SomeReal>>>
+RealToRealBoundsHelper() {
+  using RType = Type<TypeCategory::Real, X_RKIND>;
+  using RealType = Scalar<RType>;
+  using MoldRealType = Scalar<Type<TypeCategory::Real, MOLD_RKIND>>;
+  if (!MoldRealType::Convert(RealType::HUGE()).flags.test(RealFlag::Overflow)) {
+    return std::nullopt;
+  } else {
+    return std::make_pair(AsCategoryExpr(Constant<RType>{
+                              RealType::Convert(MoldRealType::HUGE()).value}),
+        AsCategoryExpr(Constant<RType>{RealType::HUGE()}));
+  }
+}
+
+static std::optional<std::pair<Expr<SomeReal>, Expr<SomeReal>>>
+RealToRealBounds(int xRKind, int moldRKind) {
+  switch (xRKind) {
+#define RCASES(RK) \
+  switch (moldRKind) { \
+  case 2: \
+    return RealToRealBoundsHelper<RK, 2>(); \
+    break; \
+  case 3: \
+    return RealToRealBoundsHelper<RK, 3>(); \
+    break; \
+  case 4: \
+    return RealToRealBoundsHelper<RK, 4>(); \
+    break; \
+  case 8: \
+    return RealToRealBoundsHelper<RK, 8>(); \
+    break; \
+  case 10: \
+    return RealToRealBoundsHelper<RK, 10>(); \
+    break; \
+  case 16: \
+    return RealToRealBoundsHelper<RK, 16>(); \
+    break; \
+  } \
+  break
+  case 2:
+    RCASES(2);
+    break;
+  case 3:
+    RCASES(3);
+    break;
+  case 4:
+    RCASES(4);
+    break;
+  case 8:
+    RCASES(8);
+    break;
+  case 10:
+    RCASES(10);
+    break;
+  case 16:
+    RCASES(16);
+    break;
+  }
+  DIE("RealToRealBounds: no case");
+#undef RCASES
+}
+
+template <int X_IKIND, int MOLD_RKIND>
+std::optional<Expr<SomeInteger>> IntToRealBoundHelper(bool negate) {
+  using IType = Type<TypeCategory::Integer, X_IKIND>;
+  using IntType = Scalar<IType>;
+  using RealType = Scalar<Type<TypeCategory::Real, MOLD_RKIND>>;
+  IntType result{}; // 0
+  while (true) {
+    std::optional<IntType> next;
+    for (int bit{0}; bit < IntType::bits; ++bit) {
+      IntType power{IntType{}.IBSET(bit)};
+      if (power.IsNegative()) {
+        if (!negate) {
+          break;
+        }
+      } else if (negate) {
+        power = power.Negate().value;
+      }
+      auto tmp{power.AddSigned(result)};
+      if (tmp.overflow ||
+          RealType::FromInteger(tmp.value).flags.test(RealFlag::Overflow)) {
+        break;
+      }
+      next = tmp.value;
+    }
+    if (next) {
+      CHECK(result.CompareSigned(*next) != Ordering::Equal);
+      result = *next;
+    } else {
+      break;
+    }
+  }
+  if (result.CompareSigned(IntType::HUGE()) == Ordering::Equal) {
+    return std::nullopt;
+  } else {
+    return AsCategoryExpr(Constant<IType>{std::move(result)});
+  }
+}
+
+static std::optional<Expr<SomeInteger>> IntToRealBound(
+    int xIKind, int moldRKind, bool negate) {
+  switch (xIKind) {
+#define RCASES(IK) \
+  switch (moldRKind) { \
+  case 2: \
+    return IntToRealBoundHelper<IK, 2>(negate); \
+    break; \
+  case 3: \
+    return IntToRealBoundHelper<IK, 3>(negate); \
+    break; \
+  case 4: \
+    return IntToRealBoundHelper<IK, 4>(negate); \
+    break; \
+  case 8: \
+    return IntToRealBoundHelper<IK, 8>(negate); \
+    break; \
+  case 10: \
+    return IntToRealBoundHelper<IK, 10>(negate); \
+    break; \
+  case 16: \
+    return IntToRealBoundHelper<IK, 16>(negate); \
+    break; \
+  } \
+  break
+  case 1:
+    RCASES(1);
+    break;
+  case 2:
+    RCASES(2);
+    break;
+  case 4:
+    RCASES(4);
+    break;
+  case 8:
+    RCASES(8);
+    break;
+  case 16:
+    RCASES(16);
+    break;
+  }
+  DIE("IntToRealBound: no case");
+#undef RCASES
+}
+
+template <int X_IKIND, int MOLD_IKIND>
+std::optional<Expr<SomeInteger>> IntToIntBoundHelper() {
+  if constexpr (X_IKIND <= MOLD_IKIND) {
+    return std::nullopt;
+  } else {
+    using XIType = Type<TypeCategory::Integer, X_IKIND>;
+    using IntegerType = Scalar<XIType>;
+    using MoldIType = Type<TypeCategory::Integer, MOLD_IKIND>;
+    using MoldIntegerType = Scalar<MoldIType>;
+    return AsCategoryExpr(Constant<XIType>{
+        IntegerType::ConvertSigned(MoldIntegerType::HUGE()).value});
+  }
+}
+
+static std::optional<Expr<SomeInteger>> IntToIntBound(
+    int xIKind, int moldIKind) {
+  switch (xIKind) {
+#define ICASES(IK) \
+  switch (moldIKind) { \
+  case 1: \
+    return IntToIntBoundHelper<IK, 1>(); \
+    break; \
+  case 2: \
+    return IntToIntBoundHelper<IK, 2>(); \
+    break; \
+  case 4: \
+    return IntToIntBoundHelper<IK, 4>(); \
+    break; \
+  case 8: \
+    return IntToIntBoundHelper<IK, 8>(); \
+    break; \
+  case 16: \
+    return IntToIntBoundHelper<IK, 16>(); \
+    break; \
+  } \
+  break
+  case 1:
+    ICASES(1);
+    break;
+  case 2:
+    ICASES(2);
+    break;
+  case 4:
+    ICASES(4);
+    break;
+  case 8:
+    ICASES(8);
+    break;
+  case 16:
+    ICASES(16);
+    break;
+  }
+  DIE("IntToIntBound: no case");
+#undef ICASES
+}
+
+// ApplyIntrinsic() constructs the typed expression representation
+// for a specific intrinsic function reference.
+// TODO: maybe move into tools.h?
+class IntrinsicCallHelper {
+public:
+  explicit IntrinsicCallHelper(SpecificCall &&call) : call_{call} {
+    CHECK(proc_.IsFunction());
+    typeAndShape_ = proc_.functionResult->GetTypeAndShape();
+    CHECK(typeAndShape_ != nullptr);
+  }
+  using Result = std::optional<Expr<SomeType>>;
+  using Types = LengthlessIntrinsicTypes;
+  template <typename T> Result Test() {
+    if (T::category == typeAndShape_->type().category() &&
+        T::kind == typeAndShape_->type().kind()) {
+      return AsGenericExpr(FunctionRef<T>{
+          ProcedureDesignator{std::move(call_.specificIntrinsic)},
+          std::move(call_.arguments)});
+    } else {
+      return std::nullopt;
+    }
+  }
+
+private:
+  SpecificCall call_;
+  const characteristics::Procedure &proc_{
+      call_.specificIntrinsic.characteristics.value()};
+  const characteristics::TypeAndShape *typeAndShape_{nullptr};
+};
+
+static Expr<SomeType> ApplyIntrinsic(
+    FoldingContext &context, const std::string &func, ActualArguments &&args) {
+  auto found{
+      context.intrinsics().Probe(CallCharacteristics{func}, args, context)};
+  CHECK(found.has_value());
+  auto result{common::SearchTypes(IntrinsicCallHelper{std::move(*found)})};
+  CHECK(result.has_value());
+  return *result;
+}
+
+static Expr<LogicalResult> CompareUnsigned(FoldingContext &context,
+    const char *intrin, Expr<SomeType> &&x, Expr<SomeType> &&y) {
+  Expr<SomeType> result{ApplyIntrinsic(context, intrin,
+      ActualArguments{
+          ActualArgument{std::move(x)}, ActualArgument{std::move(y)}})};
+  return DEREF(UnwrapExpr<Expr<LogicalResult>>(result));
+}
+
+// Determines the right kind of INTEGER to hold the bits of a REAL type.
+static Expr<SomeType> IntTransferMold(
+    const TargetCharacteristics &target, DynamicType realType, bool asVector) {
+  CHECK(realType.category() == TypeCategory::Real);
+  int rKind{realType.kind()};
+  int iKind{std::max<int>(target.GetAlignment(TypeCategory::Real, rKind),
+      target.GetByteSize(TypeCategory::Real, rKind))};
+  CHECK(target.CanSupportType(TypeCategory::Integer, iKind));
+  DynamicType iType{TypeCategory::Integer, iKind};
+  ConstantSubscripts shape;
+  if (asVector) {
+    shape = ConstantSubscripts{1};
+  }
+  Constant<SubscriptInteger> value{
+      std::vector<Scalar<SubscriptInteger>>{0}, std::move(shape)};
+  auto expr{ConvertToType(iType, AsGenericExpr(std::move(value)))};
+  CHECK(expr.has_value());
+  return std::move(*expr);
+}
+
+static Expr<SomeType> GetRealBits(FoldingContext &context, Expr<SomeReal> &&x) {
+  auto xType{x.GetType()};
+  CHECK(xType.has_value());
+  bool asVector{x.Rank() > 0};
+  return ApplyIntrinsic(context, "transfer",
+      ActualArguments{ActualArgument{AsGenericExpr(std::move(x))},
+          ActualArgument{IntTransferMold(
+              context.targetCharacteristics(), *xType, asVector)}});
+}
+
+template <int KIND>
+static Expr<Type<TypeCategory::Logical, KIND>> RewriteOutOfRange(
+    FoldingContext &context,
+    FunctionRef<Type<TypeCategory::Logical, KIND>> &&funcRef) {
+  using ResultType = Type<TypeCategory::Logical, KIND>;
+  ActualArguments &args{funcRef.arguments()};
+  // Fold x= and round= unconditionally
+  if (auto *x{UnwrapExpr<Expr<SomeType>>(args[0])}) {
+    *args[0] = Fold(context, std::move(*x));
+  }
+  if (args.size() >= 3) {
+    if (auto *round{UnwrapExpr<Expr<SomeType>>(args[2])}) {
+      *args[2] = Fold(context, std::move(*round));
+    }
+  }
+  if (auto *x{UnwrapExpr<Expr<SomeType>>(args[0])}) {
+    x = UnwrapExpr<Expr<SomeType>>(args[0]);
+    CHECK(x != nullptr);
+    if (const auto *mold{UnwrapExpr<Expr<SomeType>>(args[1])}) {
+      DynamicType xType{x->GetType().value()};
+      DynamicType moldType{mold->GetType().value()};
+      std::optional<Expr<LogicalResult>> result;
+      bool alwaysFalse{false};
+      if (auto *iXExpr{UnwrapExpr<Expr<SomeInteger>>(*x)}) {
+        DynamicType iXType{iXExpr->GetType().value()};
+        int iXKind{iXExpr->GetType().value().kind()};
+        if (auto *iMoldExpr{UnwrapExpr<Expr<SomeInteger>>(*mold)}) {
+          // INTEGER -> INTEGER
+          int iMoldKind{iMoldExpr->GetType().value().kind()};
+          if (auto hi{IntToIntBound(iXKind, iMoldKind)}) {
+            // 'hi' is INT(HUGE(mold), KIND(x))
+            // OUT_OF_RANGE(x,mold) = (x + (hi + 1)) .UGT. (2*hi + 1)
+            auto one{DEREF(UnwrapExpr<Expr<SomeInteger>>(ConvertToType(
+                xType, AsGenericExpr(Constant<SubscriptInteger>{1}))))};
+            auto lhs{std::move(*iXExpr) +
+                (Expr<SomeInteger>{*hi} + Expr<SomeInteger>{one})};
+            auto two{DEREF(UnwrapExpr<Expr<SomeInteger>>(ConvertToType(
+                xType, AsGenericExpr(Constant<SubscriptInteger>{2}))))};
+            auto rhs{std::move(two) * std::move(*hi) + std::move(one)};
+            result = CompareUnsigned(context, "bgt",
+                Expr<SomeType>{std::move(lhs)}, Expr<SomeType>{std::move(rhs)});
+          } else {
+            alwaysFalse = true;
+          }
+        } else if (auto *rMoldExpr{UnwrapExpr<Expr<SomeReal>>(*mold)}) {
+          // INTEGER -> REAL
+          int rMoldKind{rMoldExpr->GetType().value().kind()};
+          if (auto hi{IntToRealBound(iXKind, rMoldKind, /*negate=*/false)}) {
+            // OUT_OF_RANGE(x,mold) = (x - lo) .UGT. (hi - lo)
+            auto lo{IntToRealBound(iXKind, rMoldKind, /*negate=*/true)};
+            CHECK(lo.has_value());
+            auto lhs{std::move(*iXExpr) - Expr<SomeInteger>{*lo}};
+            auto rhs{std::move(*hi) - std::move(*lo)};
+            result = CompareUnsigned(context, "bgt",
+                Expr<SomeType>{std::move(lhs)}, Expr<SomeType>{std::move(rhs)});
+          } else {
+            alwaysFalse = true;
+          }
+        }
+      } else if (auto *rXExpr{UnwrapExpr<Expr<SomeReal>>(*x)}) {
+        DynamicType rXType{rXExpr->GetType().value()};
+        int rXKind{rXExpr->GetType().value().kind()};
+        if (auto *iMoldExpr{UnwrapExpr<Expr<SomeInteger>>(*mold)}) {
+          // REAL -> INTEGER
+          int iMoldKind{iMoldExpr->GetType().value().kind()};
+          auto hi{RealToIntBound(rXKind, iMoldKind, false, false)};
+          auto lo{RealToIntBound(rXKind, iMoldKind, false, true)};
+          if (args.size() >= 3) {
+            // Bounds depend on round= value
+            if (auto *round{UnwrapExpr<Expr<SomeType>>(args[2])}) {
+              if (const Symbol * whole{UnwrapWholeSymbolDataRef(*round)};
+                  whole && semantics::IsOptional(whole->GetUltimate())) {
+                if (auto source{args[2]->sourceLocation()}) {
+                  context.messages().Say(*source,
+                      "ROUND= argument to OUT_OF_RANGE() is an optional dummy argument that must be present at execution"_warn_en_US);
+                }
+              }
+              auto rlo{RealToIntBound(rXKind, iMoldKind, true, true)};
+              auto rhi{RealToIntBound(rXKind, iMoldKind, true, false)};
+              auto mlo{Fold(context,
+                  ApplyIntrinsic(context, "merge",
+                      ActualArguments{
+                          ActualArgument{Expr<SomeType>{std::move(rlo)}},
+                          ActualArgument{Expr<SomeType>{std::move(lo)}},
+                          ActualArgument{Expr<SomeType>{*round}}}))};
+              auto mhi{Fold(context,
+                  ApplyIntrinsic(context, "merge",
+                      ActualArguments{
+                          ActualArgument{Expr<SomeType>{std::move(rhi)}},
+                          ActualArgument{Expr<SomeType>{std::move(hi)}},
+                          ActualArgument{std::move(*round)}}))};
+              lo = std::move(DEREF(UnwrapExpr<Expr<SomeReal>>(mlo)));
+              hi = std::move(DEREF(UnwrapExpr<Expr<SomeReal>>(mhi)));
+            }
+          }
+          // OUT_OF_RANGE(x,mold[,round]) =
+          //   TRANSFER(x - lo, int) .UGT. TRANSFER(hi - lo, int)
+          hi = Fold(context, std::move(hi));
+          lo = Fold(context, std::move(lo));
+          if (auto rhs{RealToIntLimit(context, std::move(hi), lo)}) {
+            Expr<SomeReal> lhs{std::move(*rXExpr) - std::move(lo)};
+            result = CompareUnsigned(context, "bgt",
+                GetRealBits(context, std::move(lhs)),
+                GetRealBits(context, std::move(*rhs)));
+          }
+        } else if (auto *rMoldExpr{UnwrapExpr<Expr<SomeReal>>(*mold)}) {
+          // REAL -> REAL
+          // Only finite arguments with ABS(x) > HUGE(mold) are .TRUE.
+          // OUT_OF_RANGE(x,mold) =
+          //   TRANSFER(ABS(x) - HUGE(mold), int) - 1 .ULT.
+          //   TRANSFER(HUGE(mold), int)
+          // Note that OUT_OF_RANGE(+/-Inf or NaN,mold) =
+          //   TRANSFER(+Inf or Nan, int) - 1 .ULT. TRANSFER(HUGE(mold), int)
+          int rMoldKind{rMoldExpr->GetType().value().kind()};
+          if (auto bounds{RealToRealBounds(rXKind, rMoldKind)}) {
+            auto &[moldHuge, xHuge]{*bounds};
+            Expr<SomeType> abs{ApplyIntrinsic(context, "abs",
+                ActualArguments{
+                    ActualArgument{Expr<SomeType>{std::move(*rXExpr)}}})};
+            auto &absR{DEREF(UnwrapExpr<Expr<SomeReal>>(abs))};
+            Expr<SomeType> 
diff Bits{
+                GetRealBits(context, std::move(absR) - std::move(moldHuge))};
+            auto &
diff BitsI{DEREF(UnwrapExpr<Expr<SomeInteger>>(
diff Bits))};
+            Expr<SomeType> decr{std::move(
diff BitsI) -
+                Expr<SomeInteger>{Expr<SubscriptInteger>{1}}};
+            result = CompareUnsigned(context, "blt", std::move(decr),
+                GetRealBits(context, std::move(xHuge)));
+          } else {
+            alwaysFalse = true;
+          }
+        }
+      }
+      if (alwaysFalse) {
+        // xType can never overflow moldType, so
+        //   OUT_OF_RANGE(x) = (x /= 0) .AND. .FALSE.
+        // which has the same shape as x.
+        Expr<LogicalResult> scalarFalse{
+            Constant<LogicalResult>{Scalar<LogicalResult>{false}}};
+        if (x->Rank() > 0) {
+          if (auto nez{Relate(context.messages(), RelationalOperator::NE,
+                  std::move(*x),
+                  AsGenericExpr(Constant<SubscriptInteger>{0}))}) {
+            result = Expr<LogicalResult>{LogicalOperation<LogicalResult::kind>{
+                LogicalOperator::And, std::move(*nez), std::move(scalarFalse)}};
+          }
+        } else {
+          result = std::move(scalarFalse);
+        }
+      }
+      if (result) {
+        auto restorer{context.messages().DiscardMessages()};
+        return Fold(
+            context, AsExpr(ConvertToType<ResultType>(std::move(*result))));
+      }
+    }
+  }
+  return AsExpr(std::move(funcRef));
+}
+
 template <int KIND>
 Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
     FoldingContext &context,
@@ -236,114 +816,7 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
   } else if (name == "matmul") {
     return FoldMatmul(context, std::move(funcRef));
   } 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)}};
-          }
-        }
-      }
-    }
+    return RewriteOutOfRange<KIND>(context, std::move(funcRef));
   } else if (name == "parity") {
     return FoldAllAnyParity(
         context, std::move(funcRef), &Scalar<T>::NEQV, Scalar<T>{false});

diff  --git a/flang/lib/Evaluate/integer.cpp b/flang/lib/Evaluate/integer.cpp
index e8173b44e873f1..b982a3a0796cc5 100644
--- a/flang/lib/Evaluate/integer.cpp
+++ b/flang/lib/Evaluate/integer.cpp
@@ -14,7 +14,7 @@ template class Integer<8>;
 template class Integer<16>;
 template class Integer<32>;
 template class Integer<64>;
-template class Integer<80>;
+template class Integer<80, true, 16, std::uint16_t, std::uint32_t, 128>;
 template class Integer<128>;
 
 // Sanity checks against misconfiguration bugs

diff  --git a/flang/lib/Evaluate/real.cpp b/flang/lib/Evaluate/real.cpp
index de4b21b7ca5f25..223f67fee41dfc 100644
--- a/flang/lib/Evaluate/real.cpp
+++ b/flang/lib/Evaluate/real.cpp
@@ -788,6 +788,6 @@ template class Real<Integer<16>, 11>;
 template class Real<Integer<16>, 8>;
 template class Real<Integer<32>, 24>;
 template class Real<Integer<64>, 53>;
-template class Real<Integer<80>, 64>;
+template class Real<X87IntegerContainer, 64>;
 template class Real<Integer<128>, 113>;
 } // namespace Fortran::evaluate::value

diff  --git a/flang/test/Evaluate/fold-out_of_range.f90 b/flang/test/Evaluate/fold-out_of_range.f90
index de66c803b103e1..30665b9021a9bb 100644
--- a/flang/test/Evaluate/fold-out_of_range.f90
+++ b/flang/test/Evaluate/fold-out_of_range.f90
@@ -90,35 +90,65 @@ module m
   logical, parameter :: test_r2r8   = .not. any(out_of_range(r2v,  1._8))
   logical, parameter :: test_r2r10  = .not. any(out_of_range(r2v,  1._10))
   logical, parameter :: test_r2r16  = .not. any(out_of_range(r2v,  1._16))
-  logical, parameter :: test_r3r2   =       all(out_of_range(r3v,  1._2)  .eqv. finites)
+  logical, parameter :: test_r3r2   =       all(out_of_range(r3v,  1._2) .eqv. finites)
+  !WARN: warning: invalid argument on REAL(2) to REAL(3) conversion
+  logical, parameter :: test_r3r2b  = .not. any(out_of_range(real(r2v, 3),  1._2))
   logical, parameter :: test_r3r3   = .not. any(out_of_range(r3v,  1._3))
   logical, parameter :: test_r3r4   = .not. any(out_of_range(r3v,  1._4))
   logical, parameter :: test_r3r8   = .not. any(out_of_range(r3v,  1._8))
   logical, parameter :: test_r3r10  = .not. any(out_of_range(r3v,  1._10))
   logical, parameter :: test_r3r16  = .not. any(out_of_range(r3v,  1._16))
-  logical, parameter :: test_r4r2   =       all(out_of_range(r4v,  1._2)  .eqv. finites)
-  logical, parameter :: test_r4r3   =       all(out_of_range(r4v,  1._3)  .eqv. finites)
+  logical, parameter :: test_r4r2   =       all(out_of_range(r4v,  1._2) .eqv. finites)
+  !WARN: warning: invalid argument on REAL(2) to REAL(4) conversion
+  logical, parameter :: test_r4r2b  = .not. any(out_of_range(real(r2v, 4),  1._2))
+  logical, parameter :: test_r4r3   =       all(out_of_range(r4v,  1._3) .eqv. finites)
+  !WARN: warning: invalid argument on REAL(3) to REAL(4) conversion
+  logical, parameter :: test_r4r3b  = .not. any(out_of_range(real(r3v, 4),  1._3))
   logical, parameter :: test_r4r4   = .not. any(out_of_range(r4v,  1._4))
   logical, parameter :: test_r4r8   = .not. any(out_of_range(r4v,  1._8))
   logical, parameter :: test_r4r10  = .not. any(out_of_range(r4v,  1._10))
   logical, parameter :: test_r4r16  = .not. any(out_of_range(r4v,  1._16))
-  logical, parameter :: test_r8r2   =       all(out_of_range(r8v,  1._2)  .eqv. finites)
-  logical, parameter :: test_r8r3   =       all(out_of_range(r8v,  1._3)  .eqv. finites)
-  logical, parameter :: test_r8r4   =       all(out_of_range(r8v,  1._4)  .eqv. finites)
+  logical, parameter :: test_r8r2   =       all(out_of_range(r8v,  1._2) .eqv. finites)
+  !WARN: warning: invalid argument on REAL(2) to REAL(8) conversion
+  logical, parameter :: test_r8r2b  = .not. any(out_of_range(real(r2v, 8),  1._2))
+  logical, parameter :: test_r8r3   =       all(out_of_range(r8v,  1._3) .eqv. finites)
+  !WARN: warning: invalid argument on REAL(3) to REAL(8) conversion
+  logical, parameter :: test_r8r3b  = .not. any(out_of_range(real(r3v, 8),  1._3))
+  logical, parameter :: test_r8r4   =       all(out_of_range(r8v,  1._4) .eqv. finites)
+  !WARN: warning: invalid argument on REAL(4) to REAL(8) conversion
+  logical, parameter :: test_r8r4b  = .not. any(out_of_range(real(r4v, 8),  1._4))
   logical, parameter :: test_r8r8   = .not. any(out_of_range(r8v,  1._8))
   logical, parameter :: test_r8r10  = .not. any(out_of_range(r8v,  1._10))
   logical, parameter :: test_r8r16  = .not. any(out_of_range(r8v,  1._16))
-  logical, parameter :: test_r10r2  =       all(out_of_range(r10v, 1._2)  .eqv. finites)
-  logical, parameter :: test_r10r3  =       all(out_of_range(r10v, 1._3)  .eqv. finites)
-  logical, parameter :: test_r10r4  =       all(out_of_range(r10v, 1._4)  .eqv. finites)
-  logical, parameter :: test_r10r8  =       all(out_of_range(r10v, 1._8)  .eqv. finites)
+  logical, parameter :: test_r10r2  =       all(out_of_range(r10v, 1._2) .eqv. finites)
+  !WARN: warning: invalid argument on REAL(2) to REAL(10) conversion
+  logical, parameter :: test_r10r2b = .not. any(out_of_range(real(r2v, 10),  1._2))
+  logical, parameter :: test_r10r3  =       all(out_of_range(r10v, 1._3) .eqv. finites)
+  !WARN: warning: invalid argument on REAL(3) to REAL(10) conversion
+  logical, parameter :: test_r10r3b = .not. any(out_of_range(real(r3v, 10),  1._3))
+  logical, parameter :: test_r10r4  =       all(out_of_range(r10v, 1._4) .eqv. finites)
+  !WARN: warning: invalid argument on REAL(4) to REAL(10) conversion
+  logical, parameter :: test_r10r4b = .not. any(out_of_range(real(r4v, 10),  1._4))
+  logical, parameter :: test_r10r8  =       all(out_of_range(r10v, 1._8) .eqv. finites)
+  !WARN: warning: invalid argument on REAL(8) to REAL(10) conversion
+  logical, parameter :: test_r10r8b = .not. any(out_of_range(real(r8v, 10),  1._8))
   logical, parameter :: test_r10r10 = .not. any(out_of_range(r10v, 1._10))
   logical, parameter :: test_r10r16 = .not. any(out_of_range(r10v, 1._16))
-  logical, parameter :: test_r16r2  =       all(out_of_range(r16v, 1._2)  .eqv. finites)
-  logical, parameter :: test_r16r3  =       all(out_of_range(r16v, 1._3)  .eqv. finites)
-  logical, parameter :: test_r16r4  =       all(out_of_range(r16v, 1._4)  .eqv. finites)
-  logical, parameter :: test_r16r8  =       all(out_of_range(r16v, 1._8)  .eqv. finites)
+  logical, parameter :: test_r16r2  =       all(out_of_range(r16v, 1._2) .eqv. finites)
+  !WARN: warning: invalid argument on REAL(2) to REAL(16) conversion
+  logical, parameter :: test_r16r2b = .not. any(out_of_range(real(r2v, 16), 1._2))
+  logical, parameter :: test_r16r3  =       all(out_of_range(r16v, 1._3) .eqv. finites)
+  !WARN: warning: invalid argument on REAL(3) to REAL(16) conversion
+  logical, parameter :: test_r16r3b = .not. any(out_of_range(real(r3v, 16), 1._3))
+  logical, parameter :: test_r16r4  =       all(out_of_range(r16v, 1._4) .eqv. finites)
+  !WARN: warning: invalid argument on REAL(4) to REAL(16) conversion
+  logical, parameter :: test_r16r4b = .not. any(out_of_range(real(r4v, 16), 1._4))
+  logical, parameter :: test_r16r8  =       all(out_of_range(r16v, 1._8) .eqv. finites)
+  !WARN: warning: invalid argument on REAL(8) to REAL(16) conversion
+  logical, parameter :: test_r16r8b = .not. any(out_of_range(real(r8v, 16), 1._8))
   logical, parameter :: test_r16r10 =       all(out_of_range(r16v, 1._10) .eqv. finites)
+  !WARN: warning: invalid argument on REAL(10) to REAL(16) conversion
+  logical, parameter :: test_r16r10b= .not. any(out_of_range(real(r10v, 16), 1._10))
   logical, parameter :: test_r16r16 = .not. any(out_of_range(r16v, 1._16))
 
   logical, parameter :: test_r2i1   =       all(out_of_range(r2v,  1_1))
@@ -320,4 +350,12 @@ module m
   logical, parameter :: test_r16i16ur = all(out_of_range(real(i16v, kind=16)+.5_16, 1_16, .true.)  .eqv. [.false., .true.])
   logical, parameter :: test_r16i16d  = all(out_of_range(real(i16v, kind=16)-.5_16, 1_16, .false.) .eqv. [.false., .true.])
   logical, parameter :: test_r16i16dr = all(out_of_range(real(i16v, kind=16)-.5_16, 1_16, .true.)  .eqv. [.false., .true.])
+
+ contains
+  subroutine s(x, r)
+    real(8), intent(in) :: x
+    logical, intent(in), optional :: r
+    !WARN: warning: ROUND= argument to OUT_OF_RANGE() is an optional dummy argument that must be present at execution
+    print *, out_of_range(x, 1, round=r)
+  end
 end

diff  --git a/flang/test/Evaluate/rewrite-out_of_range.F90 b/flang/test/Evaluate/rewrite-out_of_range.F90
new file mode 100644
index 00000000000000..a5cd09cb285359
--- /dev/null
+++ b/flang/test/Evaluate/rewrite-out_of_range.F90
@@ -0,0 +1,208 @@
+! Tests rewriting of OUT_OF_RANGE()
+! RUN: %flang_fc1 -fdebug-unparse %s 2>&1 | FileCheck %s
+
+logical round
+
+#define T1(XT,XK,MT,MK) \
+block; \
+  XT(XK) x; \
+  MT(MK) mold; \
+  print *, #XT, XK, #MT, MK, out_of_range(x,mold); \
+end block
+
+#define T2(XT,XK,MT,MK) \
+block; \
+  XT(XK) x; \
+  MT(MK) mold; \
+  print *, #XT, XK, #MT, MK, 'round', out_of_range(x,mold,round); \
+end block
+
+#define INTMOLDS(M,XT,XK) \
+  M(XT,XK,integer,1); \
+  M(XT,XK,integer,2); \
+  M(XT,XK,integer,4); \
+  M(XT,XK,integer,8); \
+  M(XT,XK,integer,16)
+
+#define REALMOLDS(M,XT,XK) \
+  M(XT,XK,real,2); \
+  M(XT,XK,real,3); \
+  M(XT,XK,real,4); \
+  M(XT,XK,real,8); \
+  M(XT,XK,real,10); \
+  M(XT,XK,real,16)
+
+#define INTXS(M1,M2) \
+  M1(M2, integer, 1); \
+  M1(M2, integer, 2); \
+  M1(M2, integer, 4); \
+  M1(M2, integer, 8); \
+  M1(M2, integer, 16)
+
+#define REALXS(M1,M2) \
+  M1(M2, real, 2); \
+  M1(M2, real, 3); \
+  M1(M2, real, 4); \
+  M1(M2, real, 8); \
+  M1(M2, real, 10); \
+  M1(M2, real, 16)
+
+INTXS(INTMOLDS, T1)
+INTXS(REALMOLDS, T1)
+REALXS(INTMOLDS, T1)
+REALXS(INTMOLDS, T2)
+REALXS(REALMOLDS, T1)
+
+end
+
+!CHECK:   PRINT *, " integer", 1_4, "integer", 1_4, .false._4
+!CHECK:   PRINT *, " integer", 1_4, "integer", 2_4, .false._4
+!CHECK:   PRINT *, " integer", 1_4, "integer", 4_4, .false._4
+!CHECK:   PRINT *, " integer", 1_4, "integer", 8_4, .false._4
+!CHECK:   PRINT *, " integer", 1_4, "integer", 16_4, .false._4
+!CHECK:   PRINT *, " integer", 2_4, "integer", 1_4, bgt(x+128_2,255_2)
+!CHECK:   PRINT *, " integer", 2_4, "integer", 2_4, .false._4
+!CHECK:   PRINT *, " integer", 2_4, "integer", 4_4, .false._4
+!CHECK:   PRINT *, " integer", 2_4, "integer", 8_4, .false._4
+!CHECK:   PRINT *, " integer", 2_4, "integer", 16_4, .false._4
+!CHECK:   PRINT *, " integer", 4_4, "integer", 1_4, bgt(x+128_4,255_4)
+!CHECK:   PRINT *, " integer", 4_4, "integer", 2_4, bgt(x+32768_4,65535_4)
+!CHECK:   PRINT *, " integer", 4_4, "integer", 4_4, .false._4
+!CHECK:   PRINT *, " integer", 4_4, "integer", 8_4, .false._4
+!CHECK:   PRINT *, " integer", 4_4, "integer", 16_4, .false._4
+!CHECK:   PRINT *, " integer", 8_4, "integer", 1_4, bgt(x+128_8,255_8)
+!CHECK:   PRINT *, " integer", 8_4, "integer", 2_4, bgt(x+32768_8,65535_8)
+!CHECK:   PRINT *, " integer", 8_4, "integer", 4_4, bgt(x+2147483648_8,4294967295_8)
+!CHECK:   PRINT *, " integer", 8_4, "integer", 8_4, .false._4
+!CHECK:   PRINT *, " integer", 8_4, "integer", 16_4, .false._4
+!CHECK:   PRINT *, " integer", 16_4, "integer", 1_4, bgt(x+128_16,255_16)
+!CHECK:   PRINT *, " integer", 16_4, "integer", 2_4, bgt(x+32768_16,65535_16)
+!CHECK:   PRINT *, " integer", 16_4, "integer", 4_4, bgt(x+2147483648_16,4294967295_16)
+!CHECK:   PRINT *, " integer", 16_4, "integer", 8_4, bgt(x+9223372036854775808_16,18446744073709551615_16)
+!CHECK:   PRINT *, " integer", 16_4, "integer", 16_4, .false._4
+!CHECK:   PRINT *, " integer", 1_4, "real", 2_4, .false._4
+!CHECK:   PRINT *, " integer", 1_4, "real", 3_4, .false._4
+!CHECK:   PRINT *, " integer", 1_4, "real", 4_4, .false._4
+!CHECK:   PRINT *, " integer", 1_4, "real", 8_4, .false._4
+!CHECK:   PRINT *, " integer", 1_4, "real", 10_4, .false._4
+!CHECK:   PRINT *, " integer", 1_4, "real", 16_4, .false._4
+!CHECK:   PRINT *, " integer", 2_4, "real", 2_4, .false._4
+!CHECK:   PRINT *, " integer", 2_4, "real", 3_4, .false._4
+!CHECK:   PRINT *, " integer", 2_4, "real", 4_4, .false._4
+!CHECK:   PRINT *, " integer", 2_4, "real", 8_4, .false._4
+!CHECK:   PRINT *, " integer", 2_4, "real", 10_4, .false._4
+!CHECK:   PRINT *, " integer", 2_4, "real", 16_4, .false._4
+!CHECK:   PRINT *, " integer", 4_4, "real", 2_4, bgt(x--65519_4,131038_4)
+!CHECK:   PRINT *, " integer", 4_4, "real", 3_4, .false._4
+!CHECK:   PRINT *, " integer", 4_4, "real", 4_4, .false._4
+!CHECK:   PRINT *, " integer", 4_4, "real", 8_4, .false._4
+!CHECK:   PRINT *, " integer", 4_4, "real", 10_4, .false._4
+!CHECK:   PRINT *, " integer", 4_4, "real", 16_4, .false._4
+!CHECK:   PRINT *, " integer", 8_4, "real", 2_4, bgt(x--65519_8,131038_8)
+!CHECK:   PRINT *, " integer", 8_4, "real", 3_4, .false._4
+!CHECK:   PRINT *, " integer", 8_4, "real", 4_4, .false._4
+!CHECK:   PRINT *, " integer", 8_4, "real", 8_4, .false._4
+!CHECK:   PRINT *, " integer", 8_4, "real", 10_4, .false._4
+!CHECK:   PRINT *, " integer", 8_4, "real", 16_4, .false._4
+!CHECK:   PRINT *, " integer", 16_4, "real", 2_4, bgt(x--65519_16,131038_16)
+!CHECK:   PRINT *, " integer", 16_4, "real", 3_4, .false._4
+!CHECK:   PRINT *, " integer", 16_4, "real", 4_4, .false._4
+!CHECK:   PRINT *, " integer", 16_4, "real", 8_4, .false._4
+!CHECK:   PRINT *, " integer", 16_4, "real", 10_4, .false._4
+!CHECK:   PRINT *, " integer", 16_4, "real", 16_4, .false._4
+!CHECK:   PRINT *, " real", 2_4, "integer", 1_4, bgt(transfer(real(x,kind=4)--1.28875e2_4,0_4),1132488704_4)
+!CHECK:   PRINT *, " real", 2_4, "integer", 2_4, bgt(transfer(real(x,kind=4)--3.2768e4_4,0_4),1199566848_4)
+!CHECK:   PRINT *, " real", 2_4, "integer", 4_4, bgt(transfer(real(x,kind=4)--6.5504e4_4,0_4),1207951360_4)
+!CHECK:   PRINT *, " real", 2_4, "integer", 8_4, bgt(transfer(real(x,kind=4)--6.5504e4_4,0_4),1207951360_4)
+!CHECK:   PRINT *, " real", 2_4, "integer", 16_4, bgt(transfer(real(x,kind=4)--6.5504e4_4,0_4),1207951360_4)
+!CHECK:   PRINT *, " real", 3_4, "integer", 1_4, bgt(transfer(real(x,kind=4)--1.28e2_4,0_4),1132429312_4)
+!CHECK:   PRINT *, " real", 3_4, "integer", 2_4, bgt(transfer(real(x,kind=4)--3.2768e4_4,0_4),1199538176_4)
+!CHECK:   PRINT *, " real", 3_4, "integer", 4_4, bgt(transfer(real(x,kind=4)--2.147483648e9_4,0_4),1333755904_4)
+!CHECK:   PRINT *, " real", 3_4, "integer", 8_4, bgt(transfer(real(x,kind=4)--9.223372036854775808e18_4,0_4),1602191360_4)
+!CHECK:   PRINT *, " real", 3_4, "integer", 16_4, bgt(transfer(real(x,kind=4)--1.70141183460469231731687303715884105728e38_4,0_4),2139062272_4)
+!CHECK:   PRINT *, " real", 4_4, "integer", 1_4, bgt(transfer(real(x,kind=8)--1.289999847412109375e2_8,0_8),4643228807602372608_8)
+!CHECK:   PRINT *, " real", 4_4, "integer", 2_4, bgt(transfer(real(x,kind=8)--3.276899609375e4_8,0_8),4679240081154768896_8)
+!CHECK:   PRINT *, " real", 4_4, "integer", 4_4, bgt(transfer(real(x,kind=8)--2.147483648e9_8,0_8),4751297606607437824_8)
+!CHECK:   PRINT *, " real", 4_4, "integer", 8_4, bgt(transfer(real(x,kind=8)--9.223372036854775808e18_8,0_8),4895412794683293696_8)
+!CHECK:   PRINT *, " real", 4_4, "integer", 16_4, bgt(transfer(real(x,kind=8)--1.70141183460469231731687303715884105728e38_8,0_8),5183643170835005440_8)
+!CHECK:   PRINT *, " real", 8_4, "integer", 1_4, bgt(transfer(real(x,kind=16)--1.28999999999999971578290569595992565155029296875e2_16,0_16),85106958090653963310049098151042744320_16)
+!CHECK:   PRINT *, " real", 8_4, "integer", 2_4, bgt(transfer(real(x,kind=16)--3.27689999999999927240423858165740966796875e4_16,0_16),85148476262340800793671255767969169408_16)
+!CHECK:   PRINT *, " real", 8_4, "integer", 4_4, bgt(transfer(real(x,kind=16)--2.147483648999999523162841796875e9_16,0_16),85231552932850404447283020744867446784_16)
+!CHECK:   PRINT *, " real", 8_4, "integer", 8_4, bgt(transfer(real(x,kind=16)--9.223372036854775808e18_16,0_16),85397706432322310005864612374379495424_16)
+!CHECK:   PRINT *, " real", 8_4, "integer", 16_4, bgt(transfer(real(x,kind=16)--1.70141183460469231731687303715884105728e38_16,0_16),85730013431268538974090564139449581568_16)
+!CHECK:   PRINT *, " real", 10_4, "integer", 1_4, bgt(transfer(real(x,kind=16)--1.2899999999999999998612221219218554324470460414886474609375e2_16,0_16),85106958090653963310913367067032813568_16)
+!CHECK:   PRINT *, " real", 10_4, "integer", 2_4, bgt(transfer(real(x,kind=16)--3.2768999999999999996447286321199499070644378662109375e4_16,0_16),85148476262340800794535524683959238656_16)
+!CHECK:   PRINT *, " real", 10_4, "integer", 4_4, bgt(transfer(real(x,kind=16)--2.14748364899999999976716935634613037109375e9_16,0_16),85231552932850404448147289660857516032_16)
+!CHECK:   PRINT *, " real", 10_4, "integer", 8_4, bgt(transfer(real(x,kind=16)--9.223372036854775808e18_16,0_16),85397706432322310006440791651706208256_16)
+!CHECK:   PRINT *, " real", 10_4, "integer", 16_4, bgt(transfer(real(x,kind=16)--1.70141183460469231731687303715884105728e38_16,0_16),85730013431268538974666743416776294400_16)
+!CHECK:   PRINT *, " real", 16_4, "integer", 1_4, bgt(transfer(x--1.28999999999999999999999999999999975348096711843381080883482334912930322712298902843031100928783416748046875e2_16,0_16),85106958090653963310913789279497879551_16)
+!CHECK:   PRINT *, " real", 16_4, "integer", 2_4, bgt(transfer(x--3.27689999999999999999999999999999936891127582319055567061714777377101626143485191278159618377685546875e4_16,0_16),85148476262340800794535946896424304639_16)
+!CHECK:   PRINT *, " real", 16_4, "integer", 4_4, bgt(transfer(x--2.147483648999999999999999999999999586409693723486162564295653965018573217093944549560546875e9_16,0_16),85231552932850404448147711873322582015_16)
+!CHECK:   PRINT *, " real", 16_4, "integer", 8_4, bgt(transfer(x--9.2233720368547758089999999999999982236431605997495353221893310546875e18_16,0_16),85397706432322310006441354601659629567_16)
+!CHECK:   PRINT *, " real", 16_4, "integer", 16_4, bgt(transfer(x--1.70141183460469231731687303715884105728e38_16,0_16),85730013431268538974667024891753005055_16)
+!CHECK:   PRINT *, " real", 2_4, "integer", 1_4, "round", bgt(transfer(real(x,kind=4)-real(merge(-1.28375e2_2,-1.28875e2_2,round),kind=4),0_4),transfer(real(merge(1.274375e2_2,1.279375e2_2,round),kind=4)-real(merge(-1.28375e2_2,-1.28875e2_2,round),kind=4),0_4))
+!CHECK:   PRINT *, " real", 2_4, "integer", 2_4, "round", bgt(transfer(real(x,kind=4)-real(merge(-3.2768e4_2,-3.2768e4_2,round),kind=4),0_4),transfer(real(merge(3.2752e4_2,3.2752e4_2,round),kind=4)-real(merge(-3.2768e4_2,-3.2768e4_2,round),kind=4),0_4))
+!CHECK:   PRINT *, " real", 2_4, "integer", 4_4, "round", bgt(transfer(real(x,kind=4)-real(merge(-6.5504e4_2,-6.5504e4_2,round),kind=4),0_4),transfer(real(merge(6.5504e4_2,6.5504e4_2,round),kind=4)-real(merge(-6.5504e4_2,-6.5504e4_2,round),kind=4),0_4))
+!CHECK:   PRINT *, " real", 2_4, "integer", 8_4, "round", bgt(transfer(real(x,kind=4)-real(merge(-6.5504e4_2,-6.5504e4_2,round),kind=4),0_4),transfer(real(merge(6.5504e4_2,6.5504e4_2,round),kind=4)-real(merge(-6.5504e4_2,-6.5504e4_2,round),kind=4),0_4))
+!CHECK:   PRINT *, " real", 2_4, "integer", 16_4, "round", bgt(transfer(real(x,kind=4)-real(merge(-6.5504e4_2,-6.5504e4_2,round),kind=4),0_4),transfer(real(merge(6.5504e4_2,6.5504e4_2,round),kind=4)-real(merge(-6.5504e4_2,-6.5504e4_2,round),kind=4),0_4))
+!CHECK:   PRINT *, " real", 3_4, "integer", 1_4, "round", bgt(transfer(real(x,kind=4)-real(merge(-1.28e2_3,-1.28e2_3,round),kind=4),0_4),transfer(real(merge(1.27e2_3,1.275e2_3,round),kind=4)-real(merge(-1.28e2_3,-1.28e2_3,round),kind=4),0_4))
+!CHECK:   PRINT *, " real", 3_4, "integer", 2_4, "round", bgt(transfer(real(x,kind=4)-real(merge(-3.2768e4_3,-3.2768e4_3,round),kind=4),0_4),transfer(real(merge(3.264e4_3,3.264e4_3,round),kind=4)-real(merge(-3.2768e4_3,-3.2768e4_3,round),kind=4),0_4))
+!CHECK:   PRINT *, " real", 3_4, "integer", 4_4, "round", bgt(transfer(real(x,kind=4)-real(merge(-2.147483648e9_3,-2.147483648e9_3,round),kind=4),0_4),transfer(real(merge(2.13909504e9_3,2.13909504e9_3,round),kind=4)-real(merge(-2.147483648e9_3,-2.147483648e9_3,round),kind=4),0_4))
+!CHECK:   PRINT *, " real", 3_4, "integer", 8_4, "round", bgt(transfer(real(x,kind=4)-real(merge(-9.223372036854775808e18_3,-9.223372036854775808e18_3,round),kind=4),0_4),transfer(real(merge(9.18734323983581184e18_3,9.18734323983581184e18_3,round),kind=4)-real(merge(-9.223372036854775808e18_3,-9.223372036854775808e18_3,round),kind=4),0_4))
+!CHECK:   PRINT *, " real", 3_4, "integer", 16_4, "round", bgt(transfer(real(x,kind=4)-real(merge(-1.70141183460469231731687303715884105728e38_3,-1.70141183460469231731687303715884105728e38_3,round),kind=4),0_4),transfer(real(merge(1.6947656946257677379523540018574393344e38_3,1.6947656946257677379523540018574393344e38_3,round),kind=4)-real(merge(-1.70141183460469231731687303715884105728e38_3,-1.70141183460469231731687303715884105728e38_3,round),kind=4),0_4))
+!CHECK:   PRINT *, " real", 4_4, "integer", 1_4, "round", bgt(transfer(real(x,kind=8)-real(merge(-1.284999847412109375e2_4,-1.289999847412109375e2_4,round),kind=8),0_8),transfer(real(merge(1.2749999237060546875e2_4,1.2799999237060546875e2_4,round),kind=8)-real(merge(-1.284999847412109375e2_4,-1.289999847412109375e2_4,round),kind=8),0_8))
+!CHECK:   PRINT *, " real", 4_4, "integer", 2_4, "round", bgt(transfer(real(x,kind=8)-real(merge(-3.276849609375e4_4,-3.276899609375e4_4,round),kind=8),0_8),transfer(real(merge(3.2767498046875e4_4,3.2767998046875e4_4,round),kind=8)-real(merge(-3.276849609375e4_4,-3.276899609375e4_4,round),kind=8),0_8))
+!CHECK:   PRINT *, " real", 4_4, "integer", 4_4, "round", bgt(transfer(real(x,kind=8)-real(merge(-2.147483648e9_4,-2.147483648e9_4,round),kind=8),0_8),transfer(real(merge(2.14748352e9_4,2.14748352e9_4,round),kind=8)-real(merge(-2.147483648e9_4,-2.147483648e9_4,round),kind=8),0_8))
+!CHECK:   PRINT *, " real", 4_4, "integer", 8_4, "round", bgt(transfer(real(x,kind=8)-real(merge(-9.223372036854775808e18_4,-9.223372036854775808e18_4,round),kind=8),0_8),transfer(real(merge(9.22337148709896192e18_4,9.22337148709896192e18_4,round),kind=8)-real(merge(-9.223372036854775808e18_4,-9.223372036854775808e18_4,round),kind=8),0_8))
+!CHECK:   PRINT *, " real", 4_4, "integer", 16_4, "round", bgt(transfer(real(x,kind=8)-real(merge(-1.70141183460469231731687303715884105728e38_4,-1.70141183460469231731687303715884105728e38_4,round),kind=8),0_8),transfer(real(merge(1.7014117331926442990585209174225846272e38_4,1.7014117331926442990585209174225846272e38_4,round),kind=8)-real(merge(-1.70141183460469231731687303715884105728e38_4,-1.70141183460469231731687303715884105728e38_4,round),kind=8),0_8))
+!CHECK:   PRINT *, " real", 8_4, "integer", 1_4, "round", bgt(transfer(real(x,kind=16)-real(merge(-1.28499999999999971578290569595992565155029296875e2_8,-1.28999999999999971578290569595992565155029296875e2_8,round),kind=16),0_16),transfer(real(merge(1.274999999999999857891452847979962825775146484375e2_8,1.279999999999999857891452847979962825775146484375e2_8,round),kind=16)-real(merge(-1.28499999999999971578290569595992565155029296875e2_8,-1.28999999999999971578290569595992565155029296875e2_8,round),kind=16),0_16))
+!CHECK:   PRINT *, " real", 8_4, "integer", 2_4, "round", bgt(transfer(real(x,kind=16)-real(merge(-3.27684999999999927240423858165740966796875e4_8,-3.27689999999999927240423858165740966796875e4_8,round),kind=16),0_16),transfer(real(merge(3.276749999999999636202119290828704833984375e4_8,3.276799999999999636202119290828704833984375e4_8,round),kind=16)-real(merge(-3.27684999999999927240423858165740966796875e4_8,-3.27689999999999927240423858165740966796875e4_8,round),kind=16),0_16))
+!CHECK:   PRINT *, " real", 8_4, "integer", 4_4, "round", bgt(transfer(real(x,kind=16)-real(merge(-2.147483648499999523162841796875e9_8,-2.147483648999999523162841796875e9_8,round),kind=16),0_16),transfer(real(merge(2.1474836474999997615814208984375e9_8,2.1474836479999997615814208984375e9_8,round),kind=16)-real(merge(-2.147483648499999523162841796875e9_8,-2.147483648999999523162841796875e9_8,round),kind=16),0_16))
+!CHECK:   PRINT *, " real", 8_4, "integer", 8_4, "round", bgt(transfer(real(x,kind=16)-real(merge(-9.223372036854775808e18_8,-9.223372036854775808e18_8,round),kind=16),0_16),transfer(real(merge(9.223372036854774784e18_8,9.223372036854774784e18_8,round),kind=16)-real(merge(-9.223372036854775808e18_8,-9.223372036854775808e18_8,round),kind=16),0_16))
+!CHECK:   PRINT *, " real", 8_4, "integer", 16_4, "round", bgt(transfer(real(x,kind=16)-real(merge(-1.70141183460469231731687303715884105728e38_8,-1.70141183460469231731687303715884105728e38_8,round),kind=16),0_16),transfer(real(merge(1.70141183460469212842221372237303250944e38_8,1.70141183460469212842221372237303250944e38_8,round),kind=16)-real(merge(-1.70141183460469231731687303715884105728e38_8,-1.70141183460469231731687303715884105728e38_8,round),kind=16),0_16))
+!CHECK:   PRINT *, " real", 10_4, "integer", 1_4, "round", bgt(transfer(real(x,kind=16)-real(merge(-1.2849999999999999998612221219218554324470460414886474609375e2_10,-1.2899999999999999998612221219218554324470460414886474609375e2_10,round),kind=16),0_16),transfer(real(merge(1.27499999999999999993061106096092771622352302074432373046875e2_10,1.27999999999999999993061106096092771622352302074432373046875e2_10,round),kind=16)-real(merge(-1.2849999999999999998612221219218554324470460414886474609375e2_10,-1.2899999999999999998612221219218554324470460414886474609375e2_10,round),kind=16),0_16))
+!CHECK:   PRINT *, " real", 10_4, "integer", 2_4, "round", bgt(transfer(real(x,kind=16)-real(merge(-3.2768499999999999996447286321199499070644378662109375e4_10,-3.2768999999999999996447286321199499070644378662109375e4_10,round),kind=16),0_16),transfer(real(merge(3.27674999999999999982236431605997495353221893310546875e4_10,3.27679999999999999982236431605997495353221893310546875e4_10,round),kind=16)-real(merge(-3.2768499999999999996447286321199499070644378662109375e4_10,-3.2768999999999999996447286321199499070644378662109375e4_10,round),kind=16),0_16))
+!CHECK:   PRINT *, " real", 10_4, "integer", 4_4, "round", bgt(transfer(real(x,kind=16)-real(merge(-2.14748364849999999976716935634613037109375e9_10,-2.14748364899999999976716935634613037109375e9_10,round),kind=16),0_16),transfer(real(merge(2.147483647499999999883584678173065185546875e9_10,2.147483647999999999883584678173065185546875e9_10,round),kind=16)-real(merge(-2.14748364849999999976716935634613037109375e9_10,-2.14748364899999999976716935634613037109375e9_10,round),kind=16),0_16))
+!CHECK:   PRINT *, " real", 10_4, "integer", 8_4, "round", bgt(transfer(real(x,kind=16)-real(merge(-9.223372036854775808e18_10,-9.223372036854775808e18_10,round),kind=16),0_16),transfer(real(merge(9.223372036854775807e18_10,9.2233720368547758075e18_10,round),kind=16)-real(merge(-9.223372036854775808e18_10,-9.223372036854775808e18_10,round),kind=16),0_16))
+!CHECK:   PRINT *, " real", 10_4, "integer", 16_4, "round", bgt(transfer(real(x,kind=16)-real(merge(-1.70141183460469231731687303715884105728e38_10,-1.70141183460469231731687303715884105728e38_10,round),kind=16),0_16),transfer(real(merge(1.7014118346046923172246393167902932992e38_10,1.7014118346046923172246393167902932992e38_10,round),kind=16)-real(merge(-1.70141183460469231731687303715884105728e38_10,-1.70141183460469231731687303715884105728e38_10,round),kind=16),0_16))
+!CHECK:   PRINT *, " real", 16_4, "integer", 1_4, "round", bgt(transfer(x-merge(-1.28499999999999999999999999999999975348096711843381080883482334912930322712298902843031100928783416748046875e2_16,-1.28999999999999999999999999999999975348096711843381080883482334912930322712298902843031100928783416748046875e2_16,round),0_16),transfer(merge(1.274999999999999999999999999999999876740483559216905404417411674564651613561494514215155504643917083740234375e2_16,1.279999999999999999999999999999999876740483559216905404417411674564651613561494514215155504643917083740234375e2_16,round)-merge(-1.28499999999999999999999999999999975348096711843381080883482334912930322712298902843031100928783416748046875e2_16,-1.28999999999999999999999999999999975348096711843381080883482334912930322712298902843031100928783416748046875e2_16,round),0_16))
+!CHECK:   PRINT *, " real", 16_4, "integer", 2_4, "round", bgt(transfer(x-merge(-3.27684999999999999999999999999999936891127582319055567061714777377101626143485191278159618377685546875e4_16,-3.27689999999999999999999999999999936891127582319055567061714777377101626143485191278159618377685546875e4_16,round),0_16),transfer(merge(3.276749999999999999999999999999999684455637911595277835308573886885508130717425956390798091888427734375e4_16,3.276799999999999999999999999999999684455637911595277835308573886885508130717425956390798091888427734375e4_16,round)-merge(-3.27684999999999999999999999999999936891127582319055567061714777377101626143485191278159618377685546875e4_16,-3.27689999999999999999999999999999936891127582319055567061714777377101626143485191278159618377685546875e4_16,round),0_16))
+!CHECK:   PRINT *, " real", 16_4, "integer", 4_4, "round", bgt(transfer(x-merge(-2.147483648499999999999999999999999586409693723486162564295653965018573217093944549560546875e9_16,-2.147483648999999999999999999999999586409693723486162564295653965018573217093944549560546875e9_16,round),0_16),transfer(merge(2.1474836474999999999999999999999997932048468617430812821478269825092866085469722747802734375e9_16,2.1474836479999999999999999999999997932048468617430812821478269825092866085469722747802734375e9_16,round)-merge(-2.147483648499999999999999999999999586409693723486162564295653965018573217093944549560546875e9_16,-2.147483648999999999999999999999999586409693723486162564295653965018573217093944549560546875e9_16,round),0_16))
+!CHECK:   PRINT *, " real", 16_4, "integer", 8_4, "round", bgt(transfer(x-merge(-9.2233720368547758084999999999999982236431605997495353221893310546875e18_16,-9.2233720368547758089999999999999982236431605997495353221893310546875e18_16,round),0_16),transfer(merge(9.22337203685477580749999999999999911182158029987476766109466552734375e18_16,9.22337203685477580799999999999999911182158029987476766109466552734375e18_16,round)-merge(-9.2233720368547758084999999999999982236431605997495353221893310546875e18_16,-9.2233720368547758089999999999999982236431605997495353221893310546875e18_16,round),0_16))
+!CHECK:   PRINT *, " real", 16_4, "integer", 16_4, "round", bgt(transfer(x-merge(-1.70141183460469231731687303715884105728e38_16,-1.70141183460469231731687303715884105728e38_16,round),0_16),transfer(merge(1.70141183460469231731687303715884089344e38_16,1.70141183460469231731687303715884089344e38_16,round)-merge(-1.70141183460469231731687303715884105728e38_16,-1.70141183460469231731687303715884105728e38_16,round),0_16))
+!CHECK:   PRINT *, " real", 2_4, "real", 2_4, .false._4
+!CHECK:   PRINT *, " real", 2_4, "real", 3_4, .false._4
+!CHECK:   PRINT *, " real", 2_4, "real", 4_4, .false._4
+!CHECK:   PRINT *, " real", 2_4, "real", 8_4, .false._4
+!CHECK:   PRINT *, " real", 2_4, "real", 10_4, .false._4
+!CHECK:   PRINT *, " real", 2_4, "real", 16_4, .false._4
+!CHECK:   PRINT *, " real", 3_4, "real", 2_4, blt(int(transfer(abs(x)-6.5536e4_3,0_2),kind=8)-1_8,32639_2)
+!CHECK:   PRINT *, " real", 3_4, "real", 3_4, .false._4
+!CHECK:   PRINT *, " real", 3_4, "real", 4_4, .false._4
+!CHECK:   PRINT *, " real", 3_4, "real", 8_4, .false._4
+!CHECK:   PRINT *, " real", 3_4, "real", 10_4, .false._4
+!CHECK:   PRINT *, " real", 3_4, "real", 16_4, .false._4
+!CHECK:   PRINT *, " real", 4_4, "real", 2_4, blt(int(transfer(abs(x)-6.5504e4_4,0_4),kind=8)-1_8,2139095039_4)
+!CHECK:   PRINT *, " real", 4_4, "real", 3_4, blt(int(transfer(abs(x)-3.3895313892515354759047080037148786688e38_4,0_4),kind=8)-1_8,2139095039_4)
+!CHECK:   PRINT *, " real", 4_4, "real", 4_4, .false._4
+!CHECK:   PRINT *, " real", 4_4, "real", 8_4, .false._4
+!CHECK:   PRINT *, " real", 4_4, "real", 10_4, .false._4
+!CHECK:   PRINT *, " real", 4_4, "real", 16_4, .false._4
+!CHECK:   PRINT *, " real", 8_4, "real", 2_4, blt(transfer(abs(x)-6.5504e4_8,0_8)-1_8,9218868437227405311_8)
+!CHECK:   PRINT *, " real", 8_4, "real", 3_4, blt(transfer(abs(x)-3.3895313892515354759047080037148786688e38_8,0_8)-1_8,9218868437227405311_8)
+!CHECK:   PRINT *, " real", 8_4, "real", 4_4, blt(transfer(abs(x)-3.4028234663852885981170418348451692544e38_8,0_8)-1_8,9218868437227405311_8)
+!CHECK:   PRINT *, " real", 8_4, "real", 8_4, .false._4
+!CHECK:   PRINT *, " real", 8_4, "real", 10_4, .false._4
+!CHECK:   PRINT *, " real", 8_4, "real", 16_4, .false._4
+!CHECK:   PRINT *, " real", 10_4, "real", 2_4, blt(transfer(abs(x)-6.5504e4_10,0_16)-1_16,604444463063240877801471_16)
+!CHECK:   PRINT *, " real", 10_4, "real", 3_4, blt(transfer(abs(x)-3.3895313892515354759047080037148786688e38_10,0_16)-1_16,604444463063240877801471_16)
+!CHECK:   PRINT *, " real", 10_4, "real", 4_4, blt(transfer(abs(x)-3.4028234663852885981170418348451692544e38_10,0_16)-1_16,604444463063240877801471_16)
+!CHECK:   PRINT *, " real", 10_4, "real", 8_4, blt(transfer(abs(x)-1.79769313486231570814527423731704356798070567525844996598917476803157260780028538760589558632766878171540458953514382464234321326889464182768467546703537516986049910576551282076245490090389328944075868508455133942304583236903222948165808559332123348274797826204144723168738177180919299881250404026184124858368e308_10,0_16)-1_16,604444463063240877801471_16)
+!CHECK:   PRINT *, " real", 10_4, "real", 10_4, .false._4
+!CHECK:   PRINT *, " real", 10_4, "real", 16_4, .false._4
+!CHECK:   PRINT *, " real", 16_4, "real", 2_4, blt(transfer(abs(x)-6.5504e4_16,0_16)-1_16,170135991163610696904058773219554885631_16)
+!CHECK:   PRINT *, " real", 16_4, "real", 3_4, blt(transfer(abs(x)-3.3895313892515354759047080037148786688e38_16,0_16)-1_16,170135991163610696904058773219554885631_16)
+!CHECK:   PRINT *, " real", 16_4, "real", 4_4, blt(transfer(abs(x)-3.4028234663852885981170418348451692544e38_16,0_16)-1_16,170135991163610696904058773219554885631_16)
+!CHECK:   PRINT *, " real", 16_4, "real", 8_4, blt(transfer(abs(x)-1.79769313486231570814527423731704356798070567525844996598917476803157260780028538760589558632766878171540458953514382464234321326889464182768467546703537516986049910576551282076245490090389328944075868508455133942304583236903222948165808559332123348274797826204144723168738177180919299881250404026184124858368e308_16,0_16)-1_16,170135991163610696904058773219554885631_16)
+!CHECK:   PRINT *, " real", 16_4, "real", 10_4, blt(transfer(abs(x)-1.18973149535723176502126385303097020516906332229462420044032373389173700552297072261641029033652888285354569780749557731442744315367028843419812557385374367867359320070697326320191591828296152436552951064679108661431179063216977883889613478656060039914875343321145491116008867984515486651285234014977303760000912547939396622315138362241783854274391783813871780588948754057516822634765923557697480511372564902088485522249479139937758502601177354918009979622602685950855888360815984690023564513234659447638493985927645628457966177293040780660922910271504608538808795932778162298682754783076808004015069494230341172895777710033571401055977524212405734700738625166011082837911962300846927720096515350020847447079244384854591288672300061908512647211195136146752763351956292759795725027800298079590419313960302147099703527646744553092202267965628099149823208332964124103850923918473478612192169721054348428704835340811304257300221642134891734717423480071488075100206439051723424765600472176809648610799494341570347632064355862420744350442438056613601760883747816538902780957697597728686007148702828795556714140463261583262360276289631617397848425448686060994827086796804807870251185893083854658422304090880599629459458620190376604844679092600222541053077590106576067134720012584640695703025713896098375799892695455305236856075868317922311363951946885088077187210470520395758748001314313144425494391994017575316933939236688185618912993172910425292123683515992232205099800167710278403536014082929639811512287776813570604578934353545169653956125404884644716978689321167108722908808277835051822885764606221873970285165508372099234948333443522898475123275372663606621390228126470623407535207172405866507951821730346378263135339370677490195019784169044182473806316282858685774143258116536404021840272491339332094921949842244273042701987304453662035026238695780468200360144729199712309553005720614186697485284685618651483271597448120312194675168637934309618961510733006555242148519520176285859509105183947250286387163249416761380499631979144187025430270675849519200883791516940158174004671147787720145964446117520405945350476472180797576111172084627363927960033967047003761337450955318415007379641260504792325166135484129188421134082301547330475406707281876350361733290800595189632520707167390454777712968226520622565143991937680440029238090311243791261477625596469422198137514696707944687035800439250765945161837981185939204954403611491531078225107269148697980924094677214272701240437718740921675661363493890045123235166814608932240069799317601780533819184998193300841098599393876029260139091141452600372028487213241195542428210183120421610446740462163533690058366460659115629876474552506814500393294140413149540067760295100596225302282300363147382468105964844244132486457313743759509641616804802412935187620466813563687753281467553879887177183651289394719533506188500326760735438867336800207438784965701457609034985757124304510203873049485425670247933932280911052604153852899484920399109194612991249163328991799809438033787952209313146694614970593966415237594928589096048991612194498998638483702248667224914892467841020618336462741696957630763248023558797524525373703543388296086275342774001633343405508353704850737454481975472222897528108302089868263302028525992308416805453968791141829762998896457648276528750456285492426516521775079951625966922911497778896235667095662713848201819134832168799586365263762097828507009933729439678463987902491451422274252700636394232799848397673998715441855420156224415492665301451550468548925862027608576183712976335876121538256512963353814166394951655600026415918655485005705261143195291991880795452239464962763563017858089669222640623538289853586759599064700838568712381032959192649484625076899225841930548076362021508902214922052806984201835084058693849381549890944546197789302911357651677540623227829831403347327660395223160342282471752818181884430488092132193355086987339586127607367086665237555567580317149010847732009642431878007000879734603290627894355374356444885190719161645514115576193939969076741515640282654366402676009508752394550734155613586793306603174472092444651353236664764973540085196704077110364053815007348689179836404957060618953500508984091382686953509006678332447257871219660441528492484004185093281190896363417573989716659600075948780061916409485433875852065711654107226099628815012314437794400874930194474433078438899570184271000480830501217712356062289507626904285680004771889315808935851559386317665294808903126774702966254511086154895839508779675546413794489596052797520987481383976257859210575628440175934932416214833956535018919681138909184379573470326940634289008780584694035245347939808067427323629788710086717580253156130235606487870925986528841635097252953709111431720488774740553905400942537542411931794417513706468964386151771884986701034153254238591108962471088538580868883777725864856414593426212108664758848926003176234596076950884914966244415660441955208681198977024e4932_16,0_16)-1_16,170135991163610696904058773219554885631_16)
+!CHECK:   PRINT *, " real", 16_4, "real", 16_4, .false._4


        


More information about the flang-commits mailing list