Index: flang/include/flang/Evaluate/real.h =================================================================== --- flang/include/flang/Evaluate/real.h +++ flang/include/flang/Evaluate/real.h @@ -88,6 +88,9 @@ constexpr bool IsSubnormal() const { return Exponent() == 0 && !GetSignificand().IsZero(); } + constexpr bool IsNormal() const { + return !(IsInfinite() || IsNotANumber() || IsSubnormal()); + } constexpr Real ABS() const { // non-arithmetic, no flags returned return {word_.IBCLR(bits - 1)}; Index: flang/lib/Evaluate/fold-logical.cpp =================================================================== --- flang/lib/Evaluate/fold-logical.cpp +++ flang/lib/Evaluate/fold-logical.cpp @@ -118,6 +118,20 @@ ScalarFunc([](const Scalar &x) { return Scalar{x.IsNotANumber()}; })); + } else if (name == "__builtin_ieee_is_negative") { + auto restorer{context.messages().DiscardMessages()}; + using DefaultReal = Type; + return FoldElementalIntrinsic(context, std::move(funcRef), + ScalarFunc([](const Scalar &x) { + return Scalar{x.IsNegative()}; + })); + } else if (name == "__builtin_ieee_is_normal") { + auto restorer{context.messages().DiscardMessages()}; + using DefaultReal = Type; + return FoldElementalIntrinsic(context, std::move(funcRef), + ScalarFunc([](const Scalar &x) { + return Scalar{x.IsNormal()}; + })); } else if (name == "is_contiguous") { if (args.at(0)) { if (auto *expr{args[0]->UnwrapExpr()}) { Index: flang/lib/Evaluate/intrinsics.cpp =================================================================== --- flang/lib/Evaluate/intrinsics.cpp +++ flang/lib/Evaluate/intrinsics.cpp @@ -793,6 +793,8 @@ DefaultingKIND}, KINDInt}, {"__builtin_ieee_is_nan", {{"a", AnyFloating}}, DefaultLogical}, + {"__builtin_ieee_is_normal", {{"a", AnyFloating}}, DefaultLogical}, + {"__builtin_ieee_is_negative", {{"a", AnyFloating}}, DefaultLogical}, {"__builtin_ieee_next_after", {{"x", SameReal}, {"y", AnyReal}}, SameReal}, {"__builtin_ieee_next_down", {{"x", SameReal}}, SameReal}, {"__builtin_ieee_next_up", {{"x", SameReal}}, SameReal}, Index: flang/module/__fortran_builtins.f90 =================================================================== --- flang/module/__fortran_builtins.f90 +++ flang/module/__fortran_builtins.f90 @@ -41,7 +41,8 @@ procedure(type(__builtin_c_ptr)) :: __builtin_c_loc - intrinsic :: __builtin_ieee_is_nan + intrinsic :: __builtin_ieee_is_nan, __builtin_ieee_is_normal, & + __builtin_ieee_is_negative intrinsic :: __builtin_ieee_next_after, __builtin_ieee_next_down, & __builtin_ieee_next_up intrinsic :: scale ! for ieee_scalb Index: flang/module/ieee_arithmetic.f90 =================================================================== --- flang/module/ieee_arithmetic.f90 +++ flang/module/ieee_arithmetic.f90 @@ -11,6 +11,8 @@ use __Fortran_builtins, only: & ieee_is_nan => __builtin_ieee_is_nan, & + ieee_is_normal => __builtin_ieee_is_normal, & + ieee_is_negative => __builtin_ieee_is_negative, & ieee_next_after => __builtin_ieee_next_after, & ieee_next_down => __builtin_ieee_next_down, & ieee_next_up => __builtin_ieee_next_up, & @@ -235,6 +237,40 @@ _IS_FINITE(16) #undef _IS_FINITE +#define _IS_NEGATIVE(KIND) \ + elemental function ieee_is_negative_a##KIND(x) result(res); \ + real(kind=KIND), intent(in) :: x; \ + logical :: res; \ + type(ieee_class_type) :: classification; \ + classification = ieee_class(x); \ + res = classification == ieee_negative_zero .or. classification == ieee_negative_denormal \ + .or. classification == ieee_negative_normal .or. classification == ieee_negative_inf; \ + end function + _IS_NEGATIVE(2) + _IS_NEGATIVE(3) + _IS_NEGATIVE(4) + _IS_NEGATIVE(8) + _IS_NEGATIVE(10) + _IS_NEGATIVE(16) +#undef _IS_NEGATIVE + +#define _IS_NORMAL(KIND) \ + elemental function ieee_is_normal_a##KIND(x) result(res); \ + real(kind=KIND), intent(in) :: x; \ + logical :: res; \ + type(ieee_class_type) :: classification; \ + classification = ieee_class(x); \ + res = classification == ieee_negative_normal .or. classification == ieee_positive_normal \ + .or. classification == ieee_negative_zero .or. classification == ieee_positive_zero; \ + end function + _IS_NORMAL(2) + _IS_NORMAL(3) + _IS_NORMAL(4) + _IS_NORMAL(8) + _IS_NORMAL(10) + _IS_NORMAL(16) +#undef _IS_NORMAL + ! TODO: handle edge cases from 17.11.31 #define _REM(XKIND,YKIND) \ elemental function ieee_rem_a##XKIND##_a##YKIND(x, y) result(res); \