Add ieee_is_normal/ieee_is_negative to ieee_arithmetic module.

flang/include/flang/Evaluate/real.h

@@ -88,6 +88,9 @@ public:
   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)};

flang/lib/Evaluate/fold-logical.cpp

@@ -118,6 +118,20 @@ Expr<Type<TypeCategory::Logical, KIND>> FoldIntrinsicFunction(
         ScalarFunc<T, DefaultReal>([](const Scalar<DefaultReal> &x) {
           return Scalar<T>{x.IsNotANumber()};
         }));
+  } else if (name == "__builtin_ieee_is_negative") {
+    auto restorer{context.messages().DiscardMessages()};
+    using DefaultReal = Type<TypeCategory::Real, 4>;
+    return FoldElementalIntrinsic<T, DefaultReal>(context, std::move(funcRef),
+        ScalarFunc<T, DefaultReal>([](const Scalar<DefaultReal> &x) {
+          return Scalar<T>{x.IsNegative()};
+        }));
+  } else if (name == "__builtin_ieee_is_normal") {
+    auto restorer{context.messages().DiscardMessages()};
+    using DefaultReal = Type<TypeCategory::Real, 4>;
+    return FoldElementalIntrinsic<T, DefaultReal>(context, std::move(funcRef),
+        ScalarFunc<T, DefaultReal>([](const Scalar<DefaultReal> &x) {
+          return Scalar<T>{x.IsNormal()};
+        }));
   } else if (name == "is_contiguous") {
     if (args.at(0)) {
       if (auto *expr{args[0]->UnwrapExpr()}) {

flang/lib/Evaluate/intrinsics.cpp

@@ -793,6 +793,8 @@ static const IntrinsicInterface genericIntrinsicFunction[]{
             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},

flang/module/__fortran_builtins.f90

@@ -41,7 +41,8 @@ module __Fortran_builtins
 
   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

flang/module/ieee_arithmetic.f90

@@ -11,6 +11,8 @@ module ieee_arithmetic
 
   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 @@ module ieee_arithmetic
   _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); \