diff --git a/flang/lib/Evaluate/fold-logical.cpp b/flang/lib/Evaluate/fold-logical.cpp --- a/flang/lib/Evaluate/fold-logical.cpp +++ b/flang/lib/Evaluate/fold-logical.cpp @@ -108,6 +108,18 @@ } } else if (name == "merge") { return FoldMerge(context, std::move(funcRef)); + } else if (name == "__builtin_ieee_support_datatype" || + name == "__builtin_ieee_support_denormal" || + name == "__builtin_ieee_support_divide" || + name == "__builtin_ieee_support_divide" || + name == "__builtin_ieee_support_inf" || + name == "__builtin_ieee_support_io" || + name == "__builtin_ieee_support_nan" || + name == "__builtin_ieee_support_sqrt" || + name == "__builtin_ieee_support_standard" || + name == "__builtin_ieee_support_subnormal" || + name == "__builtin_ieee_support_underflow_control") { + return Expr{true}; } // TODO: btest, cshift, dot_product, eoshift, is_iostat_end, // is_iostat_eor, lge, lgt, lle, llt, logical, matmul, out_of_range, diff --git a/flang/lib/Evaluate/intrinsics.cpp b/flang/lib/Evaluate/intrinsics.cpp --- a/flang/lib/Evaluate/intrinsics.cpp +++ b/flang/lib/Evaluate/intrinsics.cpp @@ -772,6 +772,36 @@ {"back", AnyLogical, Rank::elemental, Optionality::optional}, DefaultingKIND}, KINDInt}, + {"__builtin_ieee_support_datatype", + {{"x", AnyReal, Rank::elemental, Optionality::optional}}, + DefaultLogical}, + {"__builtin_ieee_support_denormal", + {{"x", AnyReal, Rank::elemental, Optionality::optional}}, + DefaultLogical}, + {"__builtin_ieee_support_divide", + {{"x", AnyReal, Rank::elemental, Optionality::optional}}, + DefaultLogical}, + {"__builtin_ieee_support_inf", + {{"x", AnyReal, Rank::elemental, Optionality::optional}}, + DefaultLogical}, + {"__builtin_ieee_support_io", + {{"x", AnyReal, Rank::elemental, Optionality::optional}}, + DefaultLogical}, + {"__builtin_ieee_support_nan", + {{"x", AnyReal, Rank::elemental, Optionality::optional}}, + DefaultLogical}, + {"__builtin_ieee_support_sqrt", + {{"x", AnyReal, Rank::elemental, Optionality::optional}}, + DefaultLogical}, + {"__builtin_ieee_support_standard", + {{"x", AnyReal, Rank::elemental, Optionality::optional}}, + DefaultLogical}, + {"__builtin_ieee_support_subnormal", + {{"x", AnyReal, Rank::elemental, Optionality::optional}}, + DefaultLogical}, + {"__builtin_ieee_support_underflow_control", + {{"x", AnyReal, Rank::elemental, Optionality::optional}}, + DefaultLogical}, }; // TODO: Coarray intrinsic functions diff --git a/flang/module/__fortran_builtins.f90 b/flang/module/__fortran_builtins.f90 --- a/flang/module/__fortran_builtins.f90 +++ b/flang/module/__fortran_builtins.f90 @@ -31,4 +31,11 @@ end type procedure(type(__builtin_c_ptr)) :: __builtin_c_loc + + intrinsic :: __builtin_ieee_support_datatype, & + __builtin_ieee_support_denormal, __builtin_ieee_support_divide, & + __builtin_ieee_support_inf, __builtin_ieee_support_io, & + __builtin_ieee_support_nan, __builtin_ieee_support_sqrt, & + __builtin_ieee_support_standard, __builtin_ieee_support_subnormal, & + __builtin_ieee_support_underflow_control end module diff --git a/flang/module/ieee_arithmetic.f90 b/flang/module/ieee_arithmetic.f90 --- a/flang/module/ieee_arithmetic.f90 +++ b/flang/module/ieee_arithmetic.f90 @@ -9,6 +9,18 @@ ! See Fortran 2018, clause 17.2 module ieee_arithmetic + use __Fortran_builtins, only: & + ieee_support_datatype => __builtin_ieee_support_datatype, & + ieee_support_denormal => __builtin_ieee_support_denormal, & + ieee_support_divide => __builtin_ieee_support_divide, & + ieee_support_inf => __builtin_ieee_support_inf, & + ieee_support_io => __builtin_ieee_support_io, & + ieee_support_nan => __builtin_ieee_support_nan, & + ieee_support_sqrt => __builtin_ieee_support_sqrt, & + ieee_support_standard => __builtin_ieee_support_standard, & + ieee_support_subnormal => __builtin_ieee_support_subnormal, & + ieee_support_underflow_control => __builtin_ieee_support_underflow_control + type :: ieee_class_type private integer(kind=1) :: which = 0 @@ -72,6 +84,15 @@ module procedure ieee_copy_sign_a16 end interface ieee_copy_sign + generic :: ieee_support_rounding => ieee_support_rounding_, & + ieee_support_rounding_2, ieee_support_rounding_3, & + ieee_support_rounding_4, ieee_support_rounding_8, & + ieee_support_rounding_10, ieee_support_rounding_16 + private :: ieee_support_rounding_, & + ieee_support_rounding_2, ieee_support_rounding_3, & + ieee_support_rounding_4, ieee_support_rounding_8, & + ieee_support_rounding_10, ieee_support_rounding_16 + ! TODO: more interfaces (_fma, &c.) private :: classify @@ -181,4 +202,39 @@ _COPYSIGN(16,16,128) #undef _COPYSIGN + pure logical function ieee_support_rounding_(round_type) + type(ieee_round_type), intent(in) :: round_type + ieee_support_rounding_ = .true. + end function + pure logical function ieee_support_rounding_2(round_type,x) + type(ieee_round_type), intent(in) :: round_type + real(kind=2), intent(in) :: x + ieee_support_rounding_2 = .true. + end function + pure logical function ieee_support_rounding_3(round_type,x) + type(ieee_round_type), intent(in) :: round_type + real(kind=3), intent(in) :: x + ieee_support_rounding_3 = .true. + end function + pure logical function ieee_support_rounding_4(round_type,x) + type(ieee_round_type), intent(in) :: round_type + real(kind=4), intent(in) :: x + ieee_support_rounding_4 = .true. + end function + pure logical function ieee_support_rounding_8(round_type,x) + type(ieee_round_type), intent(in) :: round_type + real(kind=8), intent(in) :: x + ieee_support_rounding_8 = .true. + end function + pure logical function ieee_support_rounding_10(round_type,x) + type(ieee_round_type), intent(in) :: round_type + real(kind=10), intent(in) :: x + ieee_support_rounding_10 = .true. + end function + pure logical function ieee_support_rounding_16(round_type,x) + type(ieee_round_type), intent(in) :: round_type + real(kind=16), intent(in) :: x + ieee_support_rounding_16 = .true. + end function + end module ieee_arithmetic diff --git a/flang/test/Evaluate/folding18.f90 b/flang/test/Evaluate/folding18.f90 new file mode 100644 --- /dev/null +++ b/flang/test/Evaluate/folding18.f90 @@ -0,0 +1,75 @@ +! RUN: %S/test_folding.sh %s %t %f18 +! Test implementations of IEEE inquiry functions +module m + use ieee_arithmetic + logical, parameter :: test_ieee_support_datatype = ieee_support_datatype() & + .and. ieee_support_datatype(1.0_2) & + .and. ieee_support_datatype(1.0_3) & + .and. ieee_support_datatype(1.0_4) & + .and. ieee_support_datatype(1.0_8) & + .and. ieee_support_datatype(1.0_10) & + .and. ieee_support_datatype(1.0_16) + logical, parameter :: test_ieee_support_denormal = ieee_support_denormal() & + .and. ieee_support_denormal(1.0_2) & + .and. ieee_support_denormal(1.0_3) & + .and. ieee_support_denormal(1.0_4) & + .and. ieee_support_denormal(1.0_8) & + .and. ieee_support_denormal(1.0_10) & + .and. ieee_support_denormal(1.0_16) + logical, parameter :: test_ieee_support_divide = ieee_support_divide() & + .and. ieee_support_divide(1.0_2) & + .and. ieee_support_divide(1.0_3) & + .and. ieee_support_divide(1.0_4) & + .and. ieee_support_divide(1.0_8) & + .and. ieee_support_divide(1.0_10) & + .and. ieee_support_divide(1.0_16) + logical, parameter :: test_ieee_support_inf = ieee_support_inf() & + .and. ieee_support_inf(1.0_2) & + .and. ieee_support_inf(1.0_3) & + .and. ieee_support_inf(1.0_4) & + .and. ieee_support_inf(1.0_8) & + .and. ieee_support_inf(1.0_10) & + .and. ieee_support_inf(1.0_16) + logical, parameter :: test_ieee_support_io = ieee_support_io() & + .and. ieee_support_io(1.0_2) & + .and. ieee_support_io(1.0_3) & + .and. ieee_support_io(1.0_4) & + .and. ieee_support_io(1.0_8) & + .and. ieee_support_io(1.0_10) & + .and. ieee_support_io(1.0_16) + logical, parameter :: test_ieee_support_nan = ieee_support_nan() & + .and. ieee_support_nan(1.0_2) & + .and. ieee_support_nan(1.0_3) & + .and. ieee_support_nan(1.0_4) & + .and. ieee_support_nan(1.0_8) & + .and. ieee_support_nan(1.0_10) & + .and. ieee_support_nan(1.0_16) + logical, parameter :: test_ieee_support_sqrt = ieee_support_sqrt() & + .and. ieee_support_sqrt(1.0_2) & + .and. ieee_support_sqrt(1.0_3) & + .and. ieee_support_sqrt(1.0_4) & + .and. ieee_support_sqrt(1.0_8) & + .and. ieee_support_sqrt(1.0_10) & + .and. ieee_support_sqrt(1.0_16) + logical, parameter :: test_ieee_support_standard = ieee_support_standard() & + .and. ieee_support_standard(1.0_2) & + .and. ieee_support_standard(1.0_3) & + .and. ieee_support_standard(1.0_4) & + .and. ieee_support_standard(1.0_8) & + .and. ieee_support_standard(1.0_10) & + .and. ieee_support_standard(1.0_16) + logical, parameter :: test_ieee_support_subnormal = ieee_support_subnormal() & + .and. ieee_support_subnormal(1.0_2) & + .and. ieee_support_subnormal(1.0_3) & + .and. ieee_support_subnormal(1.0_4) & + .and. ieee_support_subnormal(1.0_8) & + .and. ieee_support_subnormal(1.0_10) & + .and. ieee_support_subnormal(1.0_16) + logical, parameter :: test_ieee_support_underflow_control = ieee_support_underflow_control() & + .and. ieee_support_underflow_control(1.0_2) & + .and. ieee_support_underflow_control(1.0_3) & + .and. ieee_support_underflow_control(1.0_4) & + .and. ieee_support_underflow_control(1.0_8) & + .and. ieee_support_underflow_control(1.0_10) & + .and. ieee_support_underflow_control(1.0_16) +end module