mirror of
https://gcc.gnu.org/git/gcc.git
synced 2024-11-30 23:35:00 +08:00
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.
This commit is contained in:
Francois-Xavier Coudert
parent
34cf27a64e
commit
dca2874897
@ -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) \
|
||||
|
||||
@ -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. */
|
||||
|
||||
282
gcc/testsuite/gfortran.dg/ieee/comparisons_1.f90
Normal file
282
gcc/testsuite/gfortran.dg/ieee/comparisons_1.f90
Normal file
@ -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
|
||||
282
gcc/testsuite/gfortran.dg/ieee/comparisons_2.f90
Normal file
282
gcc/testsuite/gfortran.dg/ieee/comparisons_2.f90
Normal file
@ -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
|
||||
487
gcc/testsuite/gfortran.dg/ieee/comparisons_3.F90
Normal file
487
gcc/testsuite/gfortran.dg/ieee/comparisons_3.F90
Normal file
@ -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
|
||||
@ -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
|
||||
|
||||
Loading…
Reference in New Issue
Block a user