Fortran: add IEEE_QUIET_* and IEEE_SIGNALING_* comparisons

Those operations were added to Fortran 2018, and correspond to
well-defined IEEE comparison operations, with defined signaling
semantics for NaNs. All are implemented in terms of GCC expressions and
built-ins, with no library support needed.

gcc/fortran/

	* f95-lang.cc (gfc_init_builtin_functions): Add __builtin_iseqsig.
	* trans-intrinsic.cc (conv_intrinsic_ieee_comparison): New
	function.
	(gfc_conv_ieee_arithmetic_function): Handle IEEE comparisons.

gcc/testsuite/

	* gfortran.dg/ieee/comparisons_1.f90: New test.
	* gfortran.dg/ieee/comparisons_2.f90: New test.
	* gfortran.dg/ieee/comparisons_3.F90: New test.

libgfortran/
	* ieee/ieee_arithmetic.F90: Add IEEE_QUIET_* and
	IEEE_SIGNALING_* functions.

diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc
index 89944f4e383a55bfd06056aeba055ab0bb1502c6..350e6e379eb74ada21f752fd27aa5ed1443e877b 100644 (file)
--- a/gcc/fortran/f95-lang.cc
+++ b/gcc/fortran/f95-lang.cc
@@ -1047,6 +1047,8 @@ gfc_init_builtin_functions (void)
                      ATTR_CONST_NOTHROW_LEAF_LIST);
   gfc_define_builtin ("__builtin_isunordered", ftype, BUILT_IN_ISUNORDERED,
                      "__builtin_isunordered", ATTR_CONST_NOTHROW_LEAF_LIST);
+  gfc_define_builtin ("__builtin_iseqsig", ftype, BUILT_IN_ISEQSIG,
+                     "__builtin_iseqsig", ATTR_CONST_NOTHROW_LEAF_LIST);
 
 
 #define DEF_PRIMITIVE_TYPE(ENUM, VALUE) \

diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc
index b6ea26e413d700f8d56ef212676dc5448d1d466a..e0f86b1ab551e4a6d834ed9a305dd046daa3d491 100644 (file)
--- a/gcc/fortran/trans-intrinsic.cc
+++ b/gcc/fortran/trans-intrinsic.cc
@@ -10376,6 +10376,178 @@ conv_intrinsic_ieee_minmax (gfc_se * se, gfc_expr * expr, int max,
 }
 
 
+/* Generate code for comparison functions IEEE_QUIET_* and
+   IEEE_SIGNALING_*.  */
+
+static void
+conv_intrinsic_ieee_comparison (gfc_se * se, gfc_expr * expr, int signaling,
+                               const char *name)
+{
+  tree args[2];
+  tree arg1, arg2, res;
+
+  /* Evaluate arguments only once.  */
+  conv_ieee_function_args (se, expr, args, 2);
+  arg1 = gfc_evaluate_now (args[0], &se->pre);
+  arg2 = gfc_evaluate_now (args[1], &se->pre);
+
+  if (startswith (name, "eq"))
+    {
+      if (signaling)
+       res = build_call_expr_loc (input_location,
+                                  builtin_decl_explicit (BUILT_IN_ISEQSIG),
+                                  2, arg1, arg2);
+      else
+       res = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+                              arg1, arg2);
+    }
+  else if (startswith (name, "ne"))
+    {
+      if (signaling)
+       {
+         res = build_call_expr_loc (input_location,
+                                    builtin_decl_explicit (BUILT_IN_ISEQSIG),
+                                    2, arg1, arg2);
+         res = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
+                                logical_type_node, res);
+       }
+      else
+       res = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
+                              arg1, arg2);
+    }
+  else if (startswith (name, "ge"))
+    {
+      if (signaling)
+       res = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
+                              arg1, arg2);
+      else
+       res = build_call_expr_loc (input_location,
+                                  builtin_decl_explicit (BUILT_IN_ISGREATEREQUAL),
+                                  2, arg1, arg2);
+    }
+  else if (startswith (name, "gt"))
+    {
+      if (signaling)
+       res = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
+                              arg1, arg2);
+      else
+       res = build_call_expr_loc (input_location,
+                                  builtin_decl_explicit (BUILT_IN_ISGREATER),
+                                  2, arg1, arg2);
+    }
+  else if (startswith (name, "le"))
+    {
+      if (signaling)
+       res = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
+                              arg1, arg2);
+      else
+       res = build_call_expr_loc (input_location,
+                                  builtin_decl_explicit (BUILT_IN_ISLESSEQUAL),
+                                  2, arg1, arg2);
+    }
+  else if (startswith (name, "lt"))
+    {
+      if (signaling)
+       res = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
+                              arg1, arg2);
+      else
+       res = build_call_expr_loc (input_location,
+                                  builtin_decl_explicit (BUILT_IN_ISLESS),
+                                  2, arg1, arg2);
+    }
+  else
+    gcc_unreachable ();
+
+  se->expr = fold_convert (gfc_typenode_for_spec (&expr->ts), res);
+}
+
+
+/* Generate code for comparison functions IEEE_QUIET_* and
+   IEEE_SIGNALING_*.  */
+
+static void
+conv_intrinsic_ieee_comparison (gfc_se * se, gfc_expr * expr, int signaling,
+                               const char *name)
+{
+  tree args[2];
+  tree arg1, arg2, res;
+
+  /* Evaluate arguments only once.  */
+  conv_ieee_function_args (se, expr, args, 2);
+  arg1 = gfc_evaluate_now (args[0], &se->pre);
+  arg2 = gfc_evaluate_now (args[1], &se->pre);
+
+  if (startswith (name, "eq"))
+    {
+      if (signaling)
+       res = build_call_expr_loc (input_location,
+                                  builtin_decl_explicit (BUILT_IN_ISEQSIG),
+                                  2, arg1, arg2);
+      else
+       res = fold_build2_loc (input_location, EQ_EXPR, logical_type_node,
+                              arg1, arg2);
+    }
+  else if (startswith (name, "ne"))
+    {
+      if (signaling)
+       {
+         res = build_call_expr_loc (input_location,
+                                    builtin_decl_explicit (BUILT_IN_ISEQSIG),
+                                    2, arg1, arg2);
+         res = fold_build1_loc (input_location, TRUTH_NOT_EXPR,
+                                logical_type_node, res);
+       }
+      else
+       res = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
+                              arg1, arg2);
+    }
+  else if (startswith (name, "ge"))
+    {
+      if (signaling)
+       res = fold_build2_loc (input_location, GE_EXPR, logical_type_node,
+                              arg1, arg2);
+      else
+       res = build_call_expr_loc (input_location,
+                                  builtin_decl_explicit (BUILT_IN_ISGREATEREQUAL),
+                                  2, arg1, arg2);
+    }
+  else if (startswith (name, "gt"))
+    {
+      if (signaling)
+       res = fold_build2_loc (input_location, GT_EXPR, logical_type_node,
+                              arg1, arg2);
+      else
+       res = build_call_expr_loc (input_location,
+                                  builtin_decl_explicit (BUILT_IN_ISGREATER),
+                                  2, arg1, arg2);
+    }
+  else if (startswith (name, "le"))
+    {
+      if (signaling)
+       res = fold_build2_loc (input_location, LE_EXPR, logical_type_node,
+                              arg1, arg2);
+      else
+       res = build_call_expr_loc (input_location,
+                                  builtin_decl_explicit (BUILT_IN_ISLESSEQUAL),
+                                  2, arg1, arg2);
+    }
+  else if (startswith (name, "lt"))
+    {
+      if (signaling)
+       res = fold_build2_loc (input_location, LT_EXPR, logical_type_node,
+                              arg1, arg2);
+      else
+       res = build_call_expr_loc (input_location,
+                                  builtin_decl_explicit (BUILT_IN_ISLESS),
+                                  2, arg1, arg2);
+    }
+  else
+    gcc_unreachable ();
+
+  se->expr = fold_convert (gfc_typenode_for_spec (&expr->ts), res);
+}
+
+
 /* Generate code for an intrinsic function from the IEEE_ARITHMETIC
    module.  */
 
@@ -10418,6 +10590,10 @@ gfc_conv_ieee_arithmetic_function (gfc_se * se, gfc_expr * expr)
     conv_intrinsic_ieee_minmax (se, expr, 0, name + 23);
   else if (startswith (name, "_gfortran_ieee_max_num_"))
     conv_intrinsic_ieee_minmax (se, expr, 1, name + 23);
+  else if (startswith (name, "_gfortran_ieee_quiet_"))
+    conv_intrinsic_ieee_comparison (se, expr, 0, name + 21);
+  else if (startswith (name, "_gfortran_ieee_signaling_"))
+    conv_intrinsic_ieee_comparison (se, expr, 1, name + 25);
   else
     /* It is not among the functions we translate directly.  We return
        false, so a library function call is emitted.  */

diff --git a/gcc/testsuite/gfortran.dg/ieee/comparisons_1.f90 b/gcc/testsuite/gfortran.dg/ieee/comparisons_1.f90
new file mode 100644 (file)
index 0000000..39a8abd
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ieee/comparisons_1.f90
@@ -0,0 +1,282 @@
+! { dg-do run }
+program foo
+   use ieee_arithmetic
+   use iso_fortran_env
+   implicit none
+
+   ! This allows us to test REAL128 if it exists, and still compile
+   ! on platforms were it is not present
+   ! https://gcc.gnu.org/bugzilla/show_bug.cgi?id=89639
+   integer, parameter :: large = merge(real128, real64, real128 > 0)
+
+   real, volatile :: rnan, rinf
+   double precision, volatile :: dnan, dinf
+   real(kind=large), volatile :: lnan, linf
+
+   rinf = ieee_value(0., ieee_positive_inf)
+   rnan = ieee_value(0., ieee_quiet_nan)
+
+   dinf = ieee_value(0.d0, ieee_positive_inf)
+   dnan = ieee_value(0.d0, ieee_quiet_nan)
+
+   linf = ieee_value(0._large, ieee_positive_inf)
+   lnan = ieee_value(0._large, ieee_quiet_nan)
+
+   if (.not. ieee_quiet_eq (0., 0.)) stop 1
+   if (.not. ieee_quiet_eq (0., -0.)) stop 2
+   if (.not. ieee_quiet_eq (1., 1.)) stop 3
+   if (.not. ieee_quiet_eq (rinf, rinf)) stop 4
+   if (.not. ieee_quiet_eq (-rinf, -rinf)) stop 5
+   if (ieee_quiet_eq (rnan, rnan)) stop 6
+   if (ieee_quiet_eq (0., 1.)) stop 7
+   if (ieee_quiet_eq (0., -1.)) stop 8
+   if (ieee_quiet_eq (0., rnan)) stop 9
+   if (ieee_quiet_eq (1., rnan)) stop 10
+   if (ieee_quiet_eq (0., rinf)) stop 11
+   if (ieee_quiet_eq (1., rinf)) stop 12
+   if (ieee_quiet_eq (rinf, rnan)) stop 13
+
+   if (.not. ieee_quiet_eq (0.d0, 0.d0)) stop 14
+   if (.not. ieee_quiet_eq (0.d0, -0.d0)) stop 15
+   if (.not. ieee_quiet_eq (1.d0, 1.d0)) stop 16
+   if (.not. ieee_quiet_eq (dinf, dinf)) stop 17
+   if (.not. ieee_quiet_eq (-dinf, -dinf)) stop 18
+   if (ieee_quiet_eq (dnan, dnan)) stop 19
+   if (ieee_quiet_eq (0.d0, 1.d0)) stop 20
+   if (ieee_quiet_eq (0.d0, -1.d0)) stop 21
+   if (ieee_quiet_eq (0.d0, dnan)) stop 22
+   if (ieee_quiet_eq (1.d0, dnan)) stop 23
+   if (ieee_quiet_eq (0.d0, dinf)) stop 24
+   if (ieee_quiet_eq (1.d0, dinf)) stop 25
+   if (ieee_quiet_eq (dinf, dnan)) stop 26
+
+   if (.not. ieee_quiet_eq (0._large, 0._large)) stop 27
+   if (.not. ieee_quiet_eq (0._large, -0._large)) stop 28
+   if (.not. ieee_quiet_eq (1._large, 1._large)) stop 29
+   if (.not. ieee_quiet_eq (linf, linf)) stop 30
+   if (.not. ieee_quiet_eq (-linf, -linf)) stop 31
+   if (ieee_quiet_eq (lnan, lnan)) stop 32
+   if (ieee_quiet_eq (0._large, 1._large)) stop 33
+   if (ieee_quiet_eq (0._large, -1._large)) stop 34
+   if (ieee_quiet_eq (0._large, lnan)) stop 35
+   if (ieee_quiet_eq (1._large, lnan)) stop 36
+   if (ieee_quiet_eq (0._large, linf)) stop 37
+   if (ieee_quiet_eq (1._large, linf)) stop 38
+   if (ieee_quiet_eq (linf, lnan)) stop 39
+
+
+   if (ieee_quiet_ne (0., 0.)) stop 40
+   if (ieee_quiet_ne (0., -0.)) stop 41
+   if (ieee_quiet_ne (1., 1.)) stop 42
+   if (ieee_quiet_ne (rinf, rinf)) stop 43
+   if (ieee_quiet_ne (-rinf, -rinf)) stop 44
+   if (.not. ieee_quiet_ne (rnan, rnan)) stop 45
+   if (.not. ieee_quiet_ne (0., 1.)) stop 46
+   if (.not. ieee_quiet_ne (0., -1.)) stop 47
+   if (.not. ieee_quiet_ne (0., rnan)) stop 48
+   if (.not. ieee_quiet_ne (1., rnan)) stop 49
+   if (.not. ieee_quiet_ne (0., rinf)) stop 50
+   if (.not. ieee_quiet_ne (1., rinf)) stop 51
+   if (.not. ieee_quiet_ne (rinf, rnan)) stop 52
+
+   if (ieee_quiet_ne (0.d0, 0.d0)) stop 53
+   if (ieee_quiet_ne (0.d0, -0.d0)) stop 54
+   if (ieee_quiet_ne (1.d0, 1.d0)) stop 55
+   if (ieee_quiet_ne (dinf, dinf)) stop 56
+   if (ieee_quiet_ne (-dinf, -dinf)) stop 57
+   if (.not. ieee_quiet_ne (dnan, dnan)) stop 58
+   if (.not. ieee_quiet_ne (0.d0, 1.d0)) stop 59
+   if (.not. ieee_quiet_ne (0.d0, -1.d0)) stop 60
+   if (.not. ieee_quiet_ne (0.d0, dnan)) stop 61
+   if (.not. ieee_quiet_ne (1.d0, dnan)) stop 62
+   if (.not. ieee_quiet_ne (0.d0, dinf)) stop 63
+   if (.not. ieee_quiet_ne (1.d0, dinf)) stop 64
+   if (.not. ieee_quiet_ne (dinf, dnan)) stop 65
+
+   if (ieee_quiet_ne (0._large, 0._large)) stop 66
+   if (ieee_quiet_ne (0._large, -0._large)) stop 67
+   if (ieee_quiet_ne (1._large, 1._large)) stop 68
+   if (ieee_quiet_ne (linf, linf)) stop 69
+   if (ieee_quiet_ne (-linf, -linf)) stop 70
+   if (.not. ieee_quiet_ne (lnan, lnan)) stop 71
+   if (.not. ieee_quiet_ne (0._large, 1._large)) stop 72
+   if (.not. ieee_quiet_ne (0._large, -1._large)) stop 73
+   if (.not. ieee_quiet_ne (0._large, lnan)) stop 74
+   if (.not. ieee_quiet_ne (1._large, lnan)) stop 75
+   if (.not. ieee_quiet_ne (0._large, linf)) stop 76
+   if (.not. ieee_quiet_ne (1._large, linf)) stop 77
+   if (.not. ieee_quiet_ne (linf, lnan)) stop 78
+
+
+   if (.not. ieee_quiet_le (0., 0.)) stop 79
+   if (.not. ieee_quiet_le (0., -0.)) stop 80
+   if (.not. ieee_quiet_le (1., 1.)) stop 81
+   if (.not. ieee_quiet_le (rinf, rinf)) stop 82
+   if (.not. ieee_quiet_le (-rinf, -rinf)) stop 83
+   if (ieee_quiet_le (rnan, rnan)) stop 84
+   if (.not. ieee_quiet_le (0., 1.)) stop 85
+   if (ieee_quiet_le (0., -1.)) stop 86
+   if (ieee_quiet_le (0., rnan)) stop 87
+   if (ieee_quiet_le (1., rnan)) stop 88
+   if (.not. ieee_quiet_le (0., rinf)) stop 89
+   if (.not. ieee_quiet_le (1., rinf)) stop 90
+   if (ieee_quiet_le (rinf, rnan)) stop 91
+
+   if (.not. ieee_quiet_le (0.d0, 0.d0)) stop 92
+   if (.not. ieee_quiet_le (0.d0, -0.d0)) stop 93
+   if (.not. ieee_quiet_le (1.d0, 1.d0)) stop 94
+   if (.not. ieee_quiet_le (dinf, dinf)) stop 95
+   if (.not. ieee_quiet_le (-dinf, -dinf)) stop 96
+   if (ieee_quiet_le (dnan, dnan)) stop 97
+   if (.not. ieee_quiet_le (0.d0, 1.d0)) stop 98
+   if (ieee_quiet_le (0.d0, -1.d0)) stop 99
+   if (ieee_quiet_le (0.d0, dnan)) stop 100
+   if (ieee_quiet_le (1.d0, dnan)) stop 101
+   if (.not. ieee_quiet_le (0.d0, dinf)) stop 102
+   if (.not. ieee_quiet_le (1.d0, dinf)) stop 103
+   if (ieee_quiet_le (dinf, dnan)) stop 104
+
+   if (.not. ieee_quiet_le (0._large, 0._large)) stop 105
+   if (.not. ieee_quiet_le (0._large, -0._large)) stop 106
+   if (.not. ieee_quiet_le (1._large, 1._large)) stop 107
+   if (.not. ieee_quiet_le (linf, linf)) stop 108
+   if (.not. ieee_quiet_le (-linf, -linf)) stop 109
+   if (ieee_quiet_le (lnan, lnan)) stop 110
+   if (.not. ieee_quiet_le (0._large, 1._large)) stop 111
+   if (ieee_quiet_le (0._large, -1._large)) stop 112
+   if (ieee_quiet_le (0._large, lnan)) stop 113
+   if (ieee_quiet_le (1._large, lnan)) stop 114
+   if (.not. ieee_quiet_le (0._large, linf)) stop 115
+   if (.not. ieee_quiet_le (1._large, linf)) stop 116
+   if (ieee_quiet_le (linf, lnan)) stop 117
+
+
+   if (.not. ieee_quiet_ge (0., 0.)) stop 118
+   if (.not. ieee_quiet_ge (0., -0.)) stop 119
+   if (.not. ieee_quiet_ge (1., 1.)) stop 120
+   if (.not. ieee_quiet_ge (rinf, rinf)) stop 121
+   if (.not. ieee_quiet_ge (-rinf, -rinf)) stop 122
+   if (ieee_quiet_ge (rnan, rnan)) stop 123
+   if (ieee_quiet_ge (0., 1.)) stop 124
+   if (.not. ieee_quiet_ge (0., -1.)) stop 125
+   if (ieee_quiet_ge (0., rnan)) stop 126
+   if (ieee_quiet_ge (1., rnan)) stop 127
+   if (ieee_quiet_ge (0., rinf)) stop 128
+   if (ieee_quiet_ge (1., rinf)) stop 129
+   if (ieee_quiet_ge (rinf, rnan)) stop 130
+
+   if (.not. ieee_quiet_ge (0.d0, 0.d0)) stop 131
+   if (.not. ieee_quiet_ge (0.d0, -0.d0)) stop 132
+   if (.not. ieee_quiet_ge (1.d0, 1.d0)) stop 133
+   if (.not. ieee_quiet_ge (dinf, dinf)) stop 134
+   if (.not. ieee_quiet_ge (-dinf, -dinf)) stop 135
+   if (ieee_quiet_ge (dnan, dnan)) stop 136
+   if (ieee_quiet_ge (0.d0, 1.d0)) stop 137
+   if (.not. ieee_quiet_ge (0.d0, -1.d0)) stop 138
+   if (ieee_quiet_ge (0.d0, dnan)) stop 139
+   if (ieee_quiet_ge (1.d0, dnan)) stop 140
+   if (ieee_quiet_ge (0.d0, dinf)) stop 141
+   if (ieee_quiet_ge (1.d0, dinf)) stop 142
+   if (ieee_quiet_ge (dinf, dnan)) stop 143
+
+   if (.not. ieee_quiet_ge (0._large, 0._large)) stop 144
+   if (.not. ieee_quiet_ge (0._large, -0._large)) stop 145
+   if (.not. ieee_quiet_ge (1._large, 1._large)) stop 146
+   if (.not. ieee_quiet_ge (linf, linf)) stop 147
+   if (.not. ieee_quiet_ge (-linf, -linf)) stop 148
+   if (ieee_quiet_ge (lnan, lnan)) stop 149
+   if (ieee_quiet_ge (0._large, 1._large)) stop 150
+   if (.not. ieee_quiet_ge (0._large, -1._large)) stop 151
+   if (ieee_quiet_ge (0._large, lnan)) stop 152
+   if (ieee_quiet_ge (1._large, lnan)) stop 153
+   if (ieee_quiet_ge (0._large, linf)) stop 154
+   if (ieee_quiet_ge (1._large, linf)) stop 155
+   if (ieee_quiet_ge (linf, lnan)) stop 156
+
+
+   if (ieee_quiet_lt (0., 0.)) stop 157
+   if (ieee_quiet_lt (0., -0.)) stop 158
+   if (ieee_quiet_lt (1., 1.)) stop 159
+   if (ieee_quiet_lt (rinf, rinf)) stop 160
+   if (ieee_quiet_lt (-rinf, -rinf)) stop 161
+   if (ieee_quiet_lt (rnan, rnan)) stop 162
+   if (.not. ieee_quiet_lt (0., 1.)) stop 163
+   if (ieee_quiet_lt (0., -1.)) stop 164
+   if (ieee_quiet_lt (0., rnan)) stop 165
+   if (ieee_quiet_lt (1., rnan)) stop 166
+   if (.not. ieee_quiet_lt (0., rinf)) stop 167
+   if (.not. ieee_quiet_lt (1., rinf)) stop 168
+   if (ieee_quiet_lt (rinf, rnan)) stop 169
+
+   if (ieee_quiet_lt (0.d0, 0.d0)) stop 170
+   if (ieee_quiet_lt (0.d0, -0.d0)) stop 171
+   if (ieee_quiet_lt (1.d0, 1.d0)) stop 172
+   if (ieee_quiet_lt (dinf, dinf)) stop 173
+   if (ieee_quiet_lt (-dinf, -dinf)) stop 174
+   if (ieee_quiet_lt (dnan, dnan)) stop 175
+   if (.not. ieee_quiet_lt (0.d0, 1.d0)) stop 176
+   if (ieee_quiet_lt (0.d0, -1.d0)) stop 177
+   if (ieee_quiet_lt (0.d0, dnan)) stop 178
+   if (ieee_quiet_lt (1.d0, dnan)) stop 179
+   if (.not. ieee_quiet_lt (0.d0, dinf)) stop 180
+   if (.not. ieee_quiet_lt (1.d0, dinf)) stop 181
+   if (ieee_quiet_lt (dinf, dnan)) stop 182
+
+   if (ieee_quiet_lt (0._large, 0._large)) stop 183
+   if (ieee_quiet_lt (0._large, -0._large)) stop 184
+   if (ieee_quiet_lt (1._large, 1._large)) stop 185
+   if (ieee_quiet_lt (linf, linf)) stop 186
+   if (ieee_quiet_lt (-linf, -linf)) stop 187
+   if (ieee_quiet_lt (lnan, lnan)) stop 188
+   if (.not. ieee_quiet_lt (0._large, 1._large)) stop 189
+   if (ieee_quiet_lt (0._large, -1._large)) stop 190
+   if (ieee_quiet_lt (0._large, lnan)) stop 191
+   if (ieee_quiet_lt (1._large, lnan)) stop 192
+   if (.not. ieee_quiet_lt (0._large, linf)) stop 193
+   if (.not. ieee_quiet_lt (1._large, linf)) stop 194
+   if (ieee_quiet_lt (linf, lnan)) stop 195
+
+
+   if (ieee_quiet_gt (0., 0.)) stop 196
+   if (ieee_quiet_gt (0., -0.)) stop 197
+   if (ieee_quiet_gt (1., 1.)) stop 198
+   if (ieee_quiet_gt (rinf, rinf)) stop 199
+   if (ieee_quiet_gt (-rinf, -rinf)) stop 200
+   if (ieee_quiet_gt (rnan, rnan)) stop 201
+   if (ieee_quiet_gt (0., 1.)) stop 202
+   if (.not. ieee_quiet_gt (0., -1.)) stop 203
+   if (ieee_quiet_gt (0., rnan)) stop 204
+   if (ieee_quiet_gt (1., rnan)) stop 205
+   if (ieee_quiet_gt (0., rinf)) stop 206
+   if (ieee_quiet_gt (1., rinf)) stop 207
+   if (ieee_quiet_gt (rinf, rnan)) stop 208
+
+   if (ieee_quiet_gt (0.d0, 0.d0)) stop 209
+   if (ieee_quiet_gt (0.d0, -0.d0)) stop 210
+   if (ieee_quiet_gt (1.d0, 1.d0)) stop 211
+   if (ieee_quiet_gt (dinf, dinf)) stop 212
+   if (ieee_quiet_gt (-dinf, -dinf)) stop 213
+   if (ieee_quiet_gt (dnan, dnan)) stop 214
+   if (ieee_quiet_gt (0.d0, 1.d0)) stop 215
+   if (.not. ieee_quiet_gt (0.d0, -1.d0)) stop 216
+   if (ieee_quiet_gt (0.d0, dnan)) stop 217
+   if (ieee_quiet_gt (1.d0, dnan)) stop 218
+   if (ieee_quiet_gt (0.d0, dinf)) stop 219
+   if (ieee_quiet_gt (1.d0, dinf)) stop 220
+   if (ieee_quiet_gt (dinf, dnan)) stop 221
+
+   if (ieee_quiet_gt (0._large, 0._large)) stop 222
+   if (ieee_quiet_gt (0._large, -0._large)) stop 223
+   if (ieee_quiet_gt (1._large, 1._large)) stop 224
+   if (ieee_quiet_gt (linf, linf)) stop 225
+   if (ieee_quiet_gt (-linf, -linf)) stop 226
+   if (ieee_quiet_gt (lnan, lnan)) stop 227
+   if (ieee_quiet_gt (0._large, 1._large)) stop 228
+   if (.not. ieee_quiet_gt (0._large, -1._large)) stop 229
+   if (ieee_quiet_gt (0._large, lnan)) stop 230
+   if (ieee_quiet_gt (1._large, lnan)) stop 231
+   if (ieee_quiet_gt (0._large, linf)) stop 232
+   if (ieee_quiet_gt (1._large, linf)) stop 233
+   if (ieee_quiet_gt (linf, lnan)) stop 234
+
+end program foo

diff --git a/gcc/testsuite/gfortran.dg/ieee/comparisons_2.f90 b/gcc/testsuite/gfortran.dg/ieee/comparisons_2.f90
new file mode 100644 (file)
index 0000000..35aa1fc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ieee/comparisons_2.f90
@@ -0,0 +1,282 @@
+! { dg-do run }
+program foo
+   use ieee_arithmetic
+   use iso_fortran_env
+   implicit none
+
+   ! This allows us to test REAL128 if it exists, and still compile
+   ! on platforms were it is not present
+   ! https://gcc.gnu.org/bugzilla/show_bug.cgi?id=89639
+   integer, parameter :: large = merge(real128, real64, real128 > 0)
+
+   real, volatile :: rnan, rinf
+   double precision, volatile :: dnan, dinf
+   real(kind=large), volatile :: lnan, linf
+
+   rinf = ieee_value(0., ieee_positive_inf)
+   rnan = ieee_value(0., ieee_quiet_nan)
+
+   dinf = ieee_value(0.d0, ieee_positive_inf)
+   dnan = ieee_value(0.d0, ieee_quiet_nan)
+
+   linf = ieee_value(0._large, ieee_positive_inf)
+   lnan = ieee_value(0._large, ieee_quiet_nan)
+
+   if (.not. ieee_signaling_eq (0., 0.)) stop 1
+   if (.not. ieee_signaling_eq (0., -0.)) stop 2
+   if (.not. ieee_signaling_eq (1., 1.)) stop 3
+   if (.not. ieee_signaling_eq (rinf, rinf)) stop 4
+   if (.not. ieee_signaling_eq (-rinf, -rinf)) stop 5
+   if (ieee_signaling_eq (rnan, rnan)) stop 6
+   if (ieee_signaling_eq (0., 1.)) stop 7
+   if (ieee_signaling_eq (0., -1.)) stop 8
+   if (ieee_signaling_eq (0., rnan)) stop 9
+   if (ieee_signaling_eq (1., rnan)) stop 10
+   if (ieee_signaling_eq (0., rinf)) stop 11
+   if (ieee_signaling_eq (1., rinf)) stop 12
+   if (ieee_signaling_eq (rinf, rnan)) stop 13
+
+   if (.not. ieee_signaling_eq (0.d0, 0.d0)) stop 14
+   if (.not. ieee_signaling_eq (0.d0, -0.d0)) stop 15
+   if (.not. ieee_signaling_eq (1.d0, 1.d0)) stop 16
+   if (.not. ieee_signaling_eq (dinf, dinf)) stop 17
+   if (.not. ieee_signaling_eq (-dinf, -dinf)) stop 18
+   if (ieee_signaling_eq (dnan, dnan)) stop 19
+   if (ieee_signaling_eq (0.d0, 1.d0)) stop 20
+   if (ieee_signaling_eq (0.d0, -1.d0)) stop 21
+   if (ieee_signaling_eq (0.d0, dnan)) stop 22
+   if (ieee_signaling_eq (1.d0, dnan)) stop 23
+   if (ieee_signaling_eq (0.d0, dinf)) stop 24
+   if (ieee_signaling_eq (1.d0, dinf)) stop 25
+   if (ieee_signaling_eq (dinf, dnan)) stop 26
+
+   if (.not. ieee_signaling_eq (0._large, 0._large)) stop 27
+   if (.not. ieee_signaling_eq (0._large, -0._large)) stop 28
+   if (.not. ieee_signaling_eq (1._large, 1._large)) stop 29
+   if (.not. ieee_signaling_eq (linf, linf)) stop 30
+   if (.not. ieee_signaling_eq (-linf, -linf)) stop 31
+   if (ieee_signaling_eq (lnan, lnan)) stop 32
+   if (ieee_signaling_eq (0._large, 1._large)) stop 33
+   if (ieee_signaling_eq (0._large, -1._large)) stop 34
+   if (ieee_signaling_eq (0._large, lnan)) stop 35
+   if (ieee_signaling_eq (1._large, lnan)) stop 36
+   if (ieee_signaling_eq (0._large, linf)) stop 37
+   if (ieee_signaling_eq (1._large, linf)) stop 38
+   if (ieee_signaling_eq (linf, lnan)) stop 39
+
+
+   if (ieee_signaling_ne (0., 0.)) stop 40
+   if (ieee_signaling_ne (0., -0.)) stop 41
+   if (ieee_signaling_ne (1., 1.)) stop 42
+   if (ieee_signaling_ne (rinf, rinf)) stop 43
+   if (ieee_signaling_ne (-rinf, -rinf)) stop 44
+   if (.not. ieee_signaling_ne (rnan, rnan)) stop 45
+   if (.not. ieee_signaling_ne (0., 1.)) stop 46
+   if (.not. ieee_signaling_ne (0., -1.)) stop 47
+   if (.not. ieee_signaling_ne (0., rnan)) stop 48
+   if (.not. ieee_signaling_ne (1., rnan)) stop 49
+   if (.not. ieee_signaling_ne (0., rinf)) stop 50
+   if (.not. ieee_signaling_ne (1., rinf)) stop 51
+   if (.not. ieee_signaling_ne (rinf, rnan)) stop 52
+
+   if (ieee_signaling_ne (0.d0, 0.d0)) stop 53
+   if (ieee_signaling_ne (0.d0, -0.d0)) stop 54
+   if (ieee_signaling_ne (1.d0, 1.d0)) stop 55
+   if (ieee_signaling_ne (dinf, dinf)) stop 56
+   if (ieee_signaling_ne (-dinf, -dinf)) stop 57
+   if (.not. ieee_signaling_ne (dnan, dnan)) stop 58
+   if (.not. ieee_signaling_ne (0.d0, 1.d0)) stop 59
+   if (.not. ieee_signaling_ne (0.d0, -1.d0)) stop 60
+   if (.not. ieee_signaling_ne (0.d0, dnan)) stop 61
+   if (.not. ieee_signaling_ne (1.d0, dnan)) stop 62
+   if (.not. ieee_signaling_ne (0.d0, dinf)) stop 63
+   if (.not. ieee_signaling_ne (1.d0, dinf)) stop 64
+   if (.not. ieee_signaling_ne (dinf, dnan)) stop 65
+
+   if (ieee_signaling_ne (0._large, 0._large)) stop 66
+   if (ieee_signaling_ne (0._large, -0._large)) stop 67
+   if (ieee_signaling_ne (1._large, 1._large)) stop 68
+   if (ieee_signaling_ne (linf, linf)) stop 69
+   if (ieee_signaling_ne (-linf, -linf)) stop 70
+   if (.not. ieee_signaling_ne (lnan, lnan)) stop 71
+   if (.not. ieee_signaling_ne (0._large, 1._large)) stop 72
+   if (.not. ieee_signaling_ne (0._large, -1._large)) stop 73
+   if (.not. ieee_signaling_ne (0._large, lnan)) stop 74
+   if (.not. ieee_signaling_ne (1._large, lnan)) stop 75
+   if (.not. ieee_signaling_ne (0._large, linf)) stop 76
+   if (.not. ieee_signaling_ne (1._large, linf)) stop 77
+   if (.not. ieee_signaling_ne (linf, lnan)) stop 78
+
+
+   if (.not. ieee_signaling_le (0., 0.)) stop 79
+   if (.not. ieee_signaling_le (0., -0.)) stop 80
+   if (.not. ieee_signaling_le (1., 1.)) stop 81
+   if (.not. ieee_signaling_le (rinf, rinf)) stop 82
+   if (.not. ieee_signaling_le (-rinf, -rinf)) stop 83
+   if (ieee_signaling_le (rnan, rnan)) stop 84
+   if (.not. ieee_signaling_le (0., 1.)) stop 85
+   if (ieee_signaling_le (0., -1.)) stop 86
+   if (ieee_signaling_le (0., rnan)) stop 87
+   if (ieee_signaling_le (1., rnan)) stop 88
+   if (.not. ieee_signaling_le (0., rinf)) stop 89
+   if (.not. ieee_signaling_le (1., rinf)) stop 90
+   if (ieee_signaling_le (rinf, rnan)) stop 91
+
+   if (.not. ieee_signaling_le (0.d0, 0.d0)) stop 92
+   if (.not. ieee_signaling_le (0.d0, -0.d0)) stop 93
+   if (.not. ieee_signaling_le (1.d0, 1.d0)) stop 94
+   if (.not. ieee_signaling_le (dinf, dinf)) stop 95
+   if (.not. ieee_signaling_le (-dinf, -dinf)) stop 96
+   if (ieee_signaling_le (dnan, dnan)) stop 97
+   if (.not. ieee_signaling_le (0.d0, 1.d0)) stop 98
+   if (ieee_signaling_le (0.d0, -1.d0)) stop 99
+   if (ieee_signaling_le (0.d0, dnan)) stop 100
+   if (ieee_signaling_le (1.d0, dnan)) stop 101
+   if (.not. ieee_signaling_le (0.d0, dinf)) stop 102
+   if (.not. ieee_signaling_le (1.d0, dinf)) stop 103
+   if (ieee_signaling_le (dinf, dnan)) stop 104
+
+   if (.not. ieee_signaling_le (0._large, 0._large)) stop 105
+   if (.not. ieee_signaling_le (0._large, -0._large)) stop 106
+   if (.not. ieee_signaling_le (1._large, 1._large)) stop 107
+   if (.not. ieee_signaling_le (linf, linf)) stop 108
+   if (.not. ieee_signaling_le (-linf, -linf)) stop 109
+   if (ieee_signaling_le (lnan, lnan)) stop 110
+   if (.not. ieee_signaling_le (0._large, 1._large)) stop 111
+   if (ieee_signaling_le (0._large, -1._large)) stop 112
+   if (ieee_signaling_le (0._large, lnan)) stop 113
+   if (ieee_signaling_le (1._large, lnan)) stop 114
+   if (.not. ieee_signaling_le (0._large, linf)) stop 115
+   if (.not. ieee_signaling_le (1._large, linf)) stop 116
+   if (ieee_signaling_le (linf, lnan)) stop 117
+
+
+   if (.not. ieee_signaling_ge (0., 0.)) stop 118
+   if (.not. ieee_signaling_ge (0., -0.)) stop 119
+   if (.not. ieee_signaling_ge (1., 1.)) stop 120
+   if (.not. ieee_signaling_ge (rinf, rinf)) stop 121
+   if (.not. ieee_signaling_ge (-rinf, -rinf)) stop 122
+   if (ieee_signaling_ge (rnan, rnan)) stop 123
+   if (ieee_signaling_ge (0., 1.)) stop 124
+   if (.not. ieee_signaling_ge (0., -1.)) stop 125
+   if (ieee_signaling_ge (0., rnan)) stop 126
+   if (ieee_signaling_ge (1., rnan)) stop 127
+   if (ieee_signaling_ge (0., rinf)) stop 128
+   if (ieee_signaling_ge (1., rinf)) stop 129
+   if (ieee_signaling_ge (rinf, rnan)) stop 130
+
+   if (.not. ieee_signaling_ge (0.d0, 0.d0)) stop 131
+   if (.not. ieee_signaling_ge (0.d0, -0.d0)) stop 132
+   if (.not. ieee_signaling_ge (1.d0, 1.d0)) stop 133
+   if (.not. ieee_signaling_ge (dinf, dinf)) stop 134
+   if (.not. ieee_signaling_ge (-dinf, -dinf)) stop 135
+   if (ieee_signaling_ge (dnan, dnan)) stop 136
+   if (ieee_signaling_ge (0.d0, 1.d0)) stop 137
+   if (.not. ieee_signaling_ge (0.d0, -1.d0)) stop 138
+   if (ieee_signaling_ge (0.d0, dnan)) stop 139
+   if (ieee_signaling_ge (1.d0, dnan)) stop 140
+   if (ieee_signaling_ge (0.d0, dinf)) stop 141
+   if (ieee_signaling_ge (1.d0, dinf)) stop 142
+   if (ieee_signaling_ge (dinf, dnan)) stop 143
+
+   if (.not. ieee_signaling_ge (0._large, 0._large)) stop 144
+   if (.not. ieee_signaling_ge (0._large, -0._large)) stop 145
+   if (.not. ieee_signaling_ge (1._large, 1._large)) stop 146
+   if (.not. ieee_signaling_ge (linf, linf)) stop 147
+   if (.not. ieee_signaling_ge (-linf, -linf)) stop 148
+   if (ieee_signaling_ge (lnan, lnan)) stop 149
+   if (ieee_signaling_ge (0._large, 1._large)) stop 150
+   if (.not. ieee_signaling_ge (0._large, -1._large)) stop 151
+   if (ieee_signaling_ge (0._large, lnan)) stop 152
+   if (ieee_signaling_ge (1._large, lnan)) stop 153
+   if (ieee_signaling_ge (0._large, linf)) stop 154
+   if (ieee_signaling_ge (1._large, linf)) stop 155
+   if (ieee_signaling_ge (linf, lnan)) stop 156
+
+
+   if (ieee_signaling_lt (0., 0.)) stop 157
+   if (ieee_signaling_lt (0., -0.)) stop 158
+   if (ieee_signaling_lt (1., 1.)) stop 159
+   if (ieee_signaling_lt (rinf, rinf)) stop 160
+   if (ieee_signaling_lt (-rinf, -rinf)) stop 161
+   if (ieee_signaling_lt (rnan, rnan)) stop 162
+   if (.not. ieee_signaling_lt (0., 1.)) stop 163
+   if (ieee_signaling_lt (0., -1.)) stop 164
+   if (ieee_signaling_lt (0., rnan)) stop 165
+   if (ieee_signaling_lt (1., rnan)) stop 166
+   if (.not. ieee_signaling_lt (0., rinf)) stop 167
+   if (.not. ieee_signaling_lt (1., rinf)) stop 168
+   if (ieee_signaling_lt (rinf, rnan)) stop 169
+
+   if (ieee_signaling_lt (0.d0, 0.d0)) stop 170
+   if (ieee_signaling_lt (0.d0, -0.d0)) stop 171
+   if (ieee_signaling_lt (1.d0, 1.d0)) stop 172
+   if (ieee_signaling_lt (dinf, dinf)) stop 173
+   if (ieee_signaling_lt (-dinf, -dinf)) stop 174
+   if (ieee_signaling_lt (dnan, dnan)) stop 175
+   if (.not. ieee_signaling_lt (0.d0, 1.d0)) stop 176
+   if (ieee_signaling_lt (0.d0, -1.d0)) stop 177
+   if (ieee_signaling_lt (0.d0, dnan)) stop 178
+   if (ieee_signaling_lt (1.d0, dnan)) stop 179
+   if (.not. ieee_signaling_lt (0.d0, dinf)) stop 180
+   if (.not. ieee_signaling_lt (1.d0, dinf)) stop 181
+   if (ieee_signaling_lt (dinf, dnan)) stop 182
+
+   if (ieee_signaling_lt (0._large, 0._large)) stop 183
+   if (ieee_signaling_lt (0._large, -0._large)) stop 184
+   if (ieee_signaling_lt (1._large, 1._large)) stop 185
+   if (ieee_signaling_lt (linf, linf)) stop 186
+   if (ieee_signaling_lt (-linf, -linf)) stop 187
+   if (ieee_signaling_lt (lnan, lnan)) stop 188
+   if (.not. ieee_signaling_lt (0._large, 1._large)) stop 189
+   if (ieee_signaling_lt (0._large, -1._large)) stop 190
+   if (ieee_signaling_lt (0._large, lnan)) stop 191
+   if (ieee_signaling_lt (1._large, lnan)) stop 192
+   if (.not. ieee_signaling_lt (0._large, linf)) stop 193
+   if (.not. ieee_signaling_lt (1._large, linf)) stop 194
+   if (ieee_signaling_lt (linf, lnan)) stop 195
+
+
+   if (ieee_signaling_gt (0., 0.)) stop 196
+   if (ieee_signaling_gt (0., -0.)) stop 197
+   if (ieee_signaling_gt (1., 1.)) stop 198
+   if (ieee_signaling_gt (rinf, rinf)) stop 199
+   if (ieee_signaling_gt (-rinf, -rinf)) stop 200
+   if (ieee_signaling_gt (rnan, rnan)) stop 201
+   if (ieee_signaling_gt (0., 1.)) stop 202
+   if (.not. ieee_signaling_gt (0., -1.)) stop 203
+   if (ieee_signaling_gt (0., rnan)) stop 204
+   if (ieee_signaling_gt (1., rnan)) stop 205
+   if (ieee_signaling_gt (0., rinf)) stop 206
+   if (ieee_signaling_gt (1., rinf)) stop 207
+   if (ieee_signaling_gt (rinf, rnan)) stop 208
+
+   if (ieee_signaling_gt (0.d0, 0.d0)) stop 209
+   if (ieee_signaling_gt (0.d0, -0.d0)) stop 210
+   if (ieee_signaling_gt (1.d0, 1.d0)) stop 211
+   if (ieee_signaling_gt (dinf, dinf)) stop 212
+   if (ieee_signaling_gt (-dinf, -dinf)) stop 213
+   if (ieee_signaling_gt (dnan, dnan)) stop 214
+   if (ieee_signaling_gt (0.d0, 1.d0)) stop 215
+   if (.not. ieee_signaling_gt (0.d0, -1.d0)) stop 216
+   if (ieee_signaling_gt (0.d0, dnan)) stop 217
+   if (ieee_signaling_gt (1.d0, dnan)) stop 218
+   if (ieee_signaling_gt (0.d0, dinf)) stop 219
+   if (ieee_signaling_gt (1.d0, dinf)) stop 220
+   if (ieee_signaling_gt (dinf, dnan)) stop 221
+
+   if (ieee_signaling_gt (0._large, 0._large)) stop 222
+   if (ieee_signaling_gt (0._large, -0._large)) stop 223
+   if (ieee_signaling_gt (1._large, 1._large)) stop 224
+   if (ieee_signaling_gt (linf, linf)) stop 225
+   if (ieee_signaling_gt (-linf, -linf)) stop 226
+   if (ieee_signaling_gt (lnan, lnan)) stop 227
+   if (ieee_signaling_gt (0._large, 1._large)) stop 228
+   if (.not. ieee_signaling_gt (0._large, -1._large)) stop 229
+   if (ieee_signaling_gt (0._large, lnan)) stop 230
+   if (ieee_signaling_gt (1._large, lnan)) stop 231
+   if (ieee_signaling_gt (0._large, linf)) stop 232
+   if (ieee_signaling_gt (1._large, linf)) stop 233
+   if (ieee_signaling_gt (linf, lnan)) stop 234
+
+end program foo

diff --git a/gcc/testsuite/gfortran.dg/ieee/comparisons_3.F90 b/gcc/testsuite/gfortran.dg/ieee/comparisons_3.F90
new file mode 100644 (file)
index 0000000..c15678f
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/ieee/comparisons_3.F90
@@ -0,0 +1,487 @@
+! { dg-do run }
+! { dg-options "-ffree-line-length-none" }
+program foo
+  use ieee_arithmetic
+  use iso_fortran_env
+  implicit none
+
+  ! This allows us to test REAL128 if it exists, and still compile
+  ! on platforms were it is not present
+  ! https://gcc.gnu.org/bugzilla/show_bug.cgi?id=89639
+  integer, parameter :: large = merge(real128, real64, real128 > 0)
+
+  real, volatile :: rnan, rinf
+  double precision, volatile :: dnan, dinf
+  real(kind=large), volatile :: lnan, linf
+
+  logical :: flag
+
+  rinf = ieee_value(0., ieee_positive_inf)
+  rnan = ieee_value(0., ieee_quiet_nan)
+
+  dinf = ieee_value(0.d0, ieee_positive_inf)
+  dnan = ieee_value(0.d0, ieee_quiet_nan)
+
+  linf = ieee_value(0._large, ieee_positive_inf)
+  lnan = ieee_value(0._large, ieee_quiet_nan)
+
+#define CHECK_INVALID(expected) \
+  call ieee_get_flag(ieee_invalid, flag) ; \
+  if (flag .neqv. expected) then ; \
+    write (*,*) "Check failed at ", __LINE__ ; \
+    stop 1; \
+  end if ; \
+  call ieee_set_flag(ieee_invalid, .false.)
+
+  !! REAL
+
+  ! Signaling versions
+
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_eq (0., 0.)) stop 11
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_eq (0., -0.)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_eq (0., rnan)) stop 13
+  CHECK_INVALID(.true.)
+  if (ieee_signaling_eq (0., rinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_eq (rnan, rnan)) stop 15
+  CHECK_INVALID(.true.)
+
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_ne (0., 0.)) stop 11
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_ne (0., -0.)) stop 12
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_ne (0., rnan)) stop 13
+  CHECK_INVALID(.true.)
+  if (.not. ieee_signaling_ne (0., rinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_ne (rnan, rnan)) stop 15
+  CHECK_INVALID(.true.)
+
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_le (0., 0.)) stop 11
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_le (0., -0.)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_le (0., rnan)) stop 13
+  CHECK_INVALID(.true.)
+  if (.not. ieee_signaling_le (0., rinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_le (rnan, rnan)) stop 15
+  CHECK_INVALID(.true.)
+
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_lt (0., 0.)) stop 11
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_lt (0., -0.)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_lt (0., rnan)) stop 13
+  CHECK_INVALID(.true.)
+  if (.not. ieee_signaling_lt (0., rinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_lt (rnan, rnan)) stop 15
+  CHECK_INVALID(.true.)
+
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_ge (0., 0.)) stop 11
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_ge (0., -0.)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_ge (0., rnan)) stop 13
+  CHECK_INVALID(.true.)
+  if (ieee_signaling_ge (0., rinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_ge (rnan, rnan)) stop 15
+  CHECK_INVALID(.true.)
+
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_gt (0., 0.)) stop 11
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_gt (0., -0.)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_gt (0., rnan)) stop 13
+  CHECK_INVALID(.true.)
+  if (ieee_signaling_gt (0., rinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_gt (rnan, rnan)) stop 15
+  CHECK_INVALID(.true.)
+
+  ! Quiet versions
+
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_eq (0., 0.)) stop 11
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_eq (0., -0.)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_eq (0., rnan)) stop 13
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_eq (0., rinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_eq (rnan, rnan)) stop 15
+  CHECK_INVALID(.false.)
+
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_ne (0., 0.)) stop 11
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_ne (0., -0.)) stop 12
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_ne (0., rnan)) stop 13
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_ne (0., rinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_ne (rnan, rnan)) stop 15
+  CHECK_INVALID(.false.)
+
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_le (0., 0.)) stop 11
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_le (0., -0.)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_le (0., rnan)) stop 13
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_le (0., rinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_le (rnan, rnan)) stop 15
+  CHECK_INVALID(.false.)
+
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_lt (0., 0.)) stop 11
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_lt (0., -0.)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_lt (0., rnan)) stop 13
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_lt (0., rinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_lt (rnan, rnan)) stop 15
+  CHECK_INVALID(.false.)
+
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_ge (0., 0.)) stop 11
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_ge (0., -0.)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_ge (0., rnan)) stop 13
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_ge (0., rinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_ge (rnan, rnan)) stop 15
+  CHECK_INVALID(.false.)
+
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_gt (0., 0.)) stop 11
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_gt (0., -0.)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_gt (0., rnan)) stop 13
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_gt (0., rinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_gt (rnan, rnan)) stop 15
+  CHECK_INVALID(.false.)
+
+  !! DOUBLE PRECISION
+
+  ! Signaling versions
+
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_eq (0.d0, 0.d0)) stop 11
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_eq (0.d0, -0.d0)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_eq (0.d0, dnan)) stop 13
+  CHECK_INVALID(.true.)
+  if (ieee_signaling_eq (0.d0, dinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_eq (dnan, dnan)) stop 15
+  CHECK_INVALID(.true.)
+
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_ne (0.d0, 0.d0)) stop 11
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_ne (0.d0, -0.d0)) stop 12
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_ne (0.d0, dnan)) stop 13
+  CHECK_INVALID(.true.)
+  if (.not. ieee_signaling_ne (0.d0, dinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_ne (dnan, dnan)) stop 15
+  CHECK_INVALID(.true.)
+
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_le (0.d0, 0.d0)) stop 11
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_le (0.d0, -0.d0)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_le (0.d0, dnan)) stop 13
+  CHECK_INVALID(.true.)
+  if (.not. ieee_signaling_le (0.d0, dinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_le (dnan, dnan)) stop 15
+  CHECK_INVALID(.true.)
+
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_lt (0.d0, 0.d0)) stop 11
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_lt (0.d0, -0.d0)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_lt (0.d0, dnan)) stop 13
+  CHECK_INVALID(.true.)
+  if (.not. ieee_signaling_lt (0.d0, dinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_lt (dnan, dnan)) stop 15
+  CHECK_INVALID(.true.)
+
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_ge (0.d0, 0.d0)) stop 11
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_ge (0.d0, -0.d0)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_ge (0.d0, dnan)) stop 13
+  CHECK_INVALID(.true.)
+  if (ieee_signaling_ge (0.d0, dinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_ge (dnan, dnan)) stop 15
+  CHECK_INVALID(.true.)
+
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_gt (0.d0, 0.d0)) stop 11
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_gt (0.d0, -0.d0)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_gt (0.d0, dnan)) stop 13
+  CHECK_INVALID(.true.)
+  if (ieee_signaling_gt (0.d0, dinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_gt (dnan, dnan)) stop 15
+  CHECK_INVALID(.true.)
+
+  ! Quiet versions
+
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_eq (0.d0, 0.d0)) stop 11
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_eq (0.d0, -0.d0)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_eq (0.d0, dnan)) stop 13
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_eq (0.d0, dinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_eq (dnan, dnan)) stop 15
+  CHECK_INVALID(.false.)
+
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_ne (0.d0, 0.d0)) stop 11
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_ne (0.d0, -0.d0)) stop 12
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_ne (0.d0, dnan)) stop 13
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_ne (0.d0, dinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_ne (dnan, dnan)) stop 15
+  CHECK_INVALID(.false.)
+
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_le (0.d0, 0.d0)) stop 11
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_le (0.d0, -0.d0)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_le (0.d0, dnan)) stop 13
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_le (0.d0, dinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_le (dnan, dnan)) stop 15
+  CHECK_INVALID(.false.)
+
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_lt (0.d0, 0.d0)) stop 11
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_lt (0.d0, -0.d0)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_lt (0.d0, dnan)) stop 13
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_lt (0.d0, dinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_lt (dnan, dnan)) stop 15
+  CHECK_INVALID(.false.)
+
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_ge (0.d0, 0.d0)) stop 11
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_ge (0.d0, -0.d0)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_ge (0.d0, dnan)) stop 13
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_ge (0.d0, dinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_ge (dnan, dnan)) stop 15
+  CHECK_INVALID(.false.)
+
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_gt (0.d0, 0.d0)) stop 11
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_gt (0.d0, -0.d0)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_gt (0.d0, dnan)) stop 13
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_gt (0.d0, dinf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_gt (dnan, dnan)) stop 15
+  CHECK_INVALID(.false.)
+
+  !! LARGE KIND
+
+  ! Signaling versions
+
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_eq (0._large, 0._large)) stop 11
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_eq (0._large, -0._large)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_eq (0._large, lnan)) stop 13
+  CHECK_INVALID(.true.)
+  if (ieee_signaling_eq (0._large, linf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_eq (lnan, lnan)) stop 15
+  CHECK_INVALID(.true.)
+
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_ne (0._large, 0._large)) stop 11
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_ne (0._large, -0._large)) stop 12
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_ne (0._large, lnan)) stop 13
+  CHECK_INVALID(.true.)
+  if (.not. ieee_signaling_ne (0._large, linf)) stop 14
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_ne (lnan, lnan)) stop 15
+  CHECK_INVALID(.true.)
+
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_le (0._large, 0._large)) stop 11
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_le (0._large, -0._large)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_le (0._large, lnan)) stop 13
+  CHECK_INVALID(.true.)
+  if (.not. ieee_signaling_le (0._large, linf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_le (lnan, lnan)) stop 15
+  CHECK_INVALID(.true.)
+
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_lt (0._large, 0._large)) stop 11
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_lt (0._large, -0._large)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_lt (0._large, lnan)) stop 13
+  CHECK_INVALID(.true.)
+  if (.not. ieee_signaling_lt (0._large, linf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_lt (lnan, lnan)) stop 15
+  CHECK_INVALID(.true.)
+
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_ge (0._large, 0._large)) stop 11
+  CHECK_INVALID(.false.)
+  if (.not. ieee_signaling_ge (0._large, -0._large)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_ge (0._large, lnan)) stop 13
+  CHECK_INVALID(.true.)
+  if (ieee_signaling_ge (0._large, linf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_ge (lnan, lnan)) stop 15
+  CHECK_INVALID(.true.)
+
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_gt (0._large, 0._large)) stop 11
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_gt (0._large, -0._large)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_gt (0._large, lnan)) stop 13
+  CHECK_INVALID(.true.)
+  if (ieee_signaling_gt (0._large, linf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_signaling_gt (lnan, lnan)) stop 15
+  CHECK_INVALID(.true.)
+
+  ! Quiet versions
+
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_eq (0._large, 0._large)) stop 11
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_eq (0._large, -0._large)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_eq (0._large, lnan)) stop 13
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_eq (0._large, linf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_eq (lnan, lnan)) stop 15
+  CHECK_INVALID(.false.)
+
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_ne (0._large, 0._large)) stop 11
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_ne (0._large, -0._large)) stop 12
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_ne (0._large, lnan)) stop 13
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_ne (0._large, linf)) stop 14
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_ne (lnan, lnan)) stop 15
+  CHECK_INVALID(.false.)
+
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_le (0._large, 0._large)) stop 11
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_le (0._large, -0._large)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_le (0._large, lnan)) stop 13
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_le (0._large, linf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_le (lnan, lnan)) stop 15
+  CHECK_INVALID(.false.)
+
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_lt (0._large, 0._large)) stop 11
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_lt (0._large, -0._large)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_lt (0._large, lnan)) stop 13
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_lt (0._large, linf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_lt (lnan, lnan)) stop 15
+  CHECK_INVALID(.false.)
+
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_ge (0._large, 0._large)) stop 11
+  CHECK_INVALID(.false.)
+  if (.not. ieee_quiet_ge (0._large, -0._large)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_ge (0._large, lnan)) stop 13
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_ge (0._large, linf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_ge (lnan, lnan)) stop 15
+  CHECK_INVALID(.false.)
+
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_gt (0._large, 0._large)) stop 11
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_gt (0._large, -0._large)) stop 12
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_gt (0._large, lnan)) stop 13
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_gt (0._large, linf)) stop 14
+  CHECK_INVALID(.false.)
+  if (ieee_quiet_gt (lnan, lnan)) stop 15
+  CHECK_INVALID(.false.)
+
+
+end program foo

diff --git a/libgfortran/ieee/ieee_arithmetic.F90 b/libgfortran/ieee/ieee_arithmetic.F90
index d34ece6c8d27e9801009d32e61a4302ad3a7abe0..aa897abae39ca432e05ea0f18f9a147a972e8034 100644 (file)
--- a/libgfortran/ieee/ieee_arithmetic.F90
+++ b/libgfortran/ieee/ieee_arithmetic.F90
@@ -504,6 +504,75 @@ UNORDERED_MACRO(4,4)
   end interface
   public :: IEEE_FMA
 
+  ! IEEE_QUIET_* and IEEE_SIGNALING_* comparison functions
+
+#define COMP_MACRO(TYPE,OP,K) \
+  elemental logical function \
+    _gfortran_ieee_/**/TYPE/**/_/**/OP/**/_/**/K (X,Y) ; \
+      real(kind = K), intent(in) :: X ; \
+      real(kind = K), intent(in) :: Y ; \
+  end function
+
+#ifdef HAVE_GFC_REAL_16
+#  define EXPAND_COMP_MACRO_16(TYPE,OP) COMP_MACRO(TYPE,OP,16)
+#else
+#  define EXPAND_COMP_MACRO_16(TYPE,OP)
+#endif
+
+#undef EXPAND_MACRO_10
+#ifdef HAVE_GFC_REAL_10
+#  define EXPAND_COMP_MACRO_10(TYPE,OP) COMP_MACRO(TYPE,OP,10)
+#else
+#  define EXPAND_COMP_MACRO_10(TYPE,OP)
+#endif
+
+#define COMP_FUNCTION(TYPE,OP) \
+  interface ; \
+    COMP_MACRO(TYPE,OP,4) ; \
+    COMP_MACRO(TYPE,OP,8) ; \
+    EXPAND_COMP_MACRO_10(TYPE,OP) ; \
+    EXPAND_COMP_MACRO_16(TYPE,OP) ; \
+  end interface
+
+#ifdef HAVE_GFC_REAL_16
+#  define EXPAND_INTER_MACRO_16(TYPE,OP) _gfortran_ieee_/**/TYPE/**/_/**/OP/**/_16
+#else
+#  define EXPAND_INTER_MACRO_16(TYPE,OP)
+#endif
+
+#ifdef HAVE_GFC_REAL_10
+#  define EXPAND_INTER_MACRO_10(TYPE,OP) _gfortran_ieee_/**/TYPE/**/_/**/OP/**/_10
+#else
+#  define EXPAND_INTER_MACRO_10(TYPE,OP)
+#endif
+
+#define COMP_INTERFACE(TYPE,OP) \
+  interface IEEE_/**/TYPE/**/_/**/OP ; \
+    procedure \
+      EXPAND_INTER_MACRO_16(TYPE,OP) , \
+      EXPAND_INTER_MACRO_10(TYPE,OP) , \
+      _gfortran_ieee_/**/TYPE/**/_/**/OP/**/_8 , \
+      _gfortran_ieee_/**/TYPE/**/_/**/OP/**/_4 ; \
+  end interface ; \
+  public :: IEEE_/**/TYPE/**/_/**/OP
+
+#define IEEE_COMPARISON(TYPE,OP) \
+  COMP_FUNCTION(TYPE,OP) ; \
+  COMP_INTERFACE(TYPE,OP)
+
+  IEEE_COMPARISON(QUIET,EQ)
+  IEEE_COMPARISON(QUIET,GE)
+  IEEE_COMPARISON(QUIET,GT)
+  IEEE_COMPARISON(QUIET,LE)
+  IEEE_COMPARISON(QUIET,LT)
+  IEEE_COMPARISON(QUIET,NE)
+  IEEE_COMPARISON(SIGNALING,EQ)
+  IEEE_COMPARISON(SIGNALING,GE)
+  IEEE_COMPARISON(SIGNALING,GT)
+  IEEE_COMPARISON(SIGNALING,LE)
+  IEEE_COMPARISON(SIGNALING,LT)
+  IEEE_COMPARISON(SIGNALING,NE)
+
   ! IEEE_LOGB
 
   interface