[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.
This commit is contained in:
Peter Klausler
GitHub
parent
fde5e471df
commit
1444e5acfb
@ -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 @@ private:
|
||||
(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
|
||||
|
||||
@ -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);
|
||||
|
||||
@ -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_
|
||||
|
||||
@ -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 @@ private:
|
||||
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 @@ private:
|
||||
}
|
||||
}
|
||||
|
||||
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_
|
||||
|
||||
@ -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 @@ public:
|
||||
}
|
||||
|
||||
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 @@ public:
|
||||
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
|
||||
|
||||
@ -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.
|
||||
|
||||
@ -83,6 +83,8 @@ public:
|
||||
return *this;
|
||||
}
|
||||
|
||||
RT_API_ATTRS bool IsInteger() const { return exponent_ >= 0; }
|
||||
|
||||
// Converts decimal floating-point to binary.
|
||||
RT_API_ATTRS ConversionToBinaryResult<PREC> ConvertToBinary();
|
||||
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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> diffBits{
|
||||
GetRealBits(context, std::move(absR) - std::move(moldHuge))};
|
||||
auto &diffBitsI{DEREF(UnwrapExpr<Expr<SomeInteger>>(diffBits))};
|
||||
Expr<SomeType> decr{std::move(diffBitsI) -
|
||||
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});
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
@ -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
|
||||
|
||||
208
flang/test/Evaluate/rewrite-out_of_range.F90
Normal file
208
flang/test/Evaluate/rewrite-out_of_range.F90
Normal file
File diff suppressed because one or more lines are too long
Loading…
x
Reference in New Issue
Block a user