diff --git a/gcc/fortran/f95-lang.cc b/gcc/fortran/f95-lang.cc index 9684f1d4921cefa1898b690abe79505e6397142b..89944f4e383a55bfd06056aeba055ab0bb1502c6 100644 --- a/gcc/fortran/f95-lang.cc +++ b/gcc/fortran/f95-lang.cc @@ -836,6 +836,20 @@ gfc_init_builtin_functions (void) gfc_define_builtin ("__builtin_scalbnf", mfunc_float[2], BUILT_IN_SCALBNF, "scalbnf", ATTR_CONST_NOTHROW_LEAF_LIST); + gfc_define_builtin ("__builtin_fmaxl", mfunc_longdouble[1], + BUILT_IN_FMAXL, "fmaxl", ATTR_CONST_NOTHROW_LEAF_LIST); + gfc_define_builtin ("__builtin_fmax", mfunc_double[1], + BUILT_IN_FMAX, "fmax", ATTR_CONST_NOTHROW_LEAF_LIST); + gfc_define_builtin ("__builtin_fmaxf", mfunc_float[1], + BUILT_IN_FMAXF, "fmaxf", ATTR_CONST_NOTHROW_LEAF_LIST); + + gfc_define_builtin ("__builtin_fminl", mfunc_longdouble[1], + BUILT_IN_FMINL, "fminl", ATTR_CONST_NOTHROW_LEAF_LIST); + gfc_define_builtin ("__builtin_fmin", mfunc_double[1], + BUILT_IN_FMIN, "fmin", ATTR_CONST_NOTHROW_LEAF_LIST); + gfc_define_builtin ("__builtin_fminf", mfunc_float[1], + BUILT_IN_FMINF, "fminf", ATTR_CONST_NOTHROW_LEAF_LIST); + gfc_define_builtin ("__builtin_fmodl", mfunc_longdouble[1], BUILT_IN_FMODL, "fmodl", ATTR_CONST_NOTHROW_LEAF_LIST); gfc_define_builtin ("__builtin_fmod", mfunc_double[1], diff --git a/gcc/fortran/mathbuiltins.def b/gcc/fortran/mathbuiltins.def index c6bb3e88eeb6e5462a95087b3686771892385472..51cb9a4aa911dacab84fa8cdbafc81570d93b2f5 100644 --- a/gcc/fortran/mathbuiltins.def +++ b/gcc/fortran/mathbuiltins.def @@ -61,6 +61,8 @@ OTHER_BUILTIN (COPYSIGN, "copysign", 2, true) OTHER_BUILTIN (CPOW, "cpow", cpow, true) OTHER_BUILTIN (FABS, "fabs", 1, true) OTHER_BUILTIN (FMA, "fma", 3, true) +OTHER_BUILTIN (FMAX, "fmax", 2, true) +OTHER_BUILTIN (FMIN, "fmin", 2, true) OTHER_BUILTIN (FMOD, "fmod", 2, true) OTHER_BUILTIN (FREXP, "frexp", frexp, false) OTHER_BUILTIN (LOGB, "logb", 1, true) diff --git a/gcc/fortran/trans-intrinsic.cc b/gcc/fortran/trans-intrinsic.cc index a0e1110c5e05f9d1fffa27b4b9943d04765e1c19..b6ea26e413d700f8d56ef212676dc5448d1d466a 100644 --- a/gcc/fortran/trans-intrinsic.cc +++ b/gcc/fortran/trans-intrinsic.cc @@ -10263,6 +10263,119 @@ conv_intrinsic_ieee_fma (gfc_se * se, gfc_expr * expr) } +/* Generate code for IEEE_{MIN,MAX}_NUM{,_MAG}. */ + +static void +conv_intrinsic_ieee_minmax (gfc_se * se, gfc_expr * expr, int max, + const char *name) +{ + tree args[2], func; + built_in_function fn; + + conv_ieee_function_args (se, expr, args, 2); + gcc_assert (TYPE_PRECISION (TREE_TYPE (args[0])) == TYPE_PRECISION (TREE_TYPE (args[1]))); + args[0] = gfc_evaluate_now (args[0], &se->pre); + args[1] = gfc_evaluate_now (args[1], &se->pre); + + if (startswith (name, "mag")) + { + /* IEEE_MIN_NUM_MAG and IEEE_MAX_NUM_MAG translate to C functions + fminmag() and fmaxmag(), which do not exist as built-ins. + + Following glibc, we emit this: + + fminmag (x, y) { + ax = ABS (x); + ay = ABS (y); + if (isless (ax, ay)) + return x; + else if (isgreater (ax, ay)) + return y; + else if (ax == ay) + return x < y ? x : y; + else if (issignaling (x) || issignaling (y)) + return x + y; + else + return isnan (y) ? x : y; + } + + fmaxmag (x, y) { + ax = ABS (x); + ay = ABS (y); + if (isgreater (ax, ay)) + return x; + else if (isless (ax, ay)) + return y; + else if (ax == ay) + return x > y ? x : y; + else if (issignaling (x) || issignaling (y)) + return x + y; + else + return isnan (y) ? x : y; + } + + */ + + tree abs0, abs1, sig0, sig1; + tree cond1, cond2, cond3, cond4, cond5; + tree res; + tree type = TREE_TYPE (args[0]); + + func = gfc_builtin_decl_for_float_kind (BUILT_IN_FABS, expr->ts.kind); + abs0 = build_call_expr_loc (input_location, func, 1, args[0]); + abs1 = build_call_expr_loc (input_location, func, 1, args[1]); + abs0 = gfc_evaluate_now (abs0, &se->pre); + abs1 = gfc_evaluate_now (abs1, &se->pre); + + cond5 = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_ISNAN), + 1, args[1]); + res = fold_build3_loc (input_location, COND_EXPR, type, cond5, + args[0], args[1]); + + sig0 = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_ISSIGNALING), + 1, args[0]); + sig1 = build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_ISSIGNALING), + 1, args[1]); + cond4 = fold_build2_loc (input_location, TRUTH_ORIF_EXPR, + logical_type_node, sig0, sig1); + res = fold_build3_loc (input_location, COND_EXPR, type, cond4, + fold_build2_loc (input_location, PLUS_EXPR, + type, args[0], args[1]), + res); + + cond3 = fold_build2_loc (input_location, EQ_EXPR, logical_type_node, + abs0, abs1); + res = fold_build3_loc (input_location, COND_EXPR, type, cond3, + fold_build2_loc (input_location, + max ? MAX_EXPR : MIN_EXPR, + type, args[0], args[1]), + res); + + func = builtin_decl_explicit (max ? BUILT_IN_ISLESS : BUILT_IN_ISGREATER); + cond2 = build_call_expr_loc (input_location, func, 2, abs0, abs1); + res = fold_build3_loc (input_location, COND_EXPR, type, cond2, + args[1], res); + + func = builtin_decl_explicit (max ? BUILT_IN_ISGREATER : BUILT_IN_ISLESS); + cond1 = build_call_expr_loc (input_location, func, 2, abs0, abs1); + res = fold_build3_loc (input_location, COND_EXPR, type, cond1, + args[0], res); + + se->expr = res; + } + else + { + /* IEEE_MIN_NUM and IEEE_MAX_NUM translate to fmin() and fmax(). */ + fn = max ? BUILT_IN_FMAX : BUILT_IN_FMIN; + func = gfc_builtin_decl_for_float_kind (fn, expr->ts.kind); + se->expr = build_call_expr_loc_array (input_location, func, 2, args); + } +} + + /* Generate code for an intrinsic function from the IEEE_ARITHMETIC module. */ @@ -10301,6 +10414,10 @@ gfc_conv_ieee_arithmetic_function (gfc_se * se, gfc_expr * expr) conv_intrinsic_ieee_value (se, expr); else if (startswith (name, "_gfortran_ieee_fma")) conv_intrinsic_ieee_fma (se, expr); + else if (startswith (name, "_gfortran_ieee_min_num_")) + 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 /* 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/minmax_1.f90 b/gcc/testsuite/gfortran.dg/ieee/minmax_1.f90 new file mode 100644 index 0000000000000000000000000000000000000000..c820b134956c6cdd33f42bf45acbd2e42b07ff39 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ieee/minmax_1.f90 @@ -0,0 +1,235 @@ +! { dg-do run } +! +program test + call real() + call double() + call large1() + call large2() +end program test + + +subroutine real + use ieee_arithmetic + implicit none + + real :: inf, nan + + inf = ieee_value(inf, ieee_positive_inf) + nan = ieee_value(nan, ieee_quiet_nan) + + if (ieee_max_num_mag (0., 0.) /= 0.) stop 1 + if (ieee_max_num_mag (-0., -0.) /= -0.) stop 2 + if (.not. ieee_signbit (ieee_max_num_mag (-0., -0.))) stop 3 + if (ieee_max_num_mag (0., -0.) /= 0.) stop 4 + ! Processor-dependent + !if (ieee_signbit (ieee_max_num_mag (0., -0.))) stop 5 + if (ieee_max_num_mag (-0., 0.) /= 0.) stop 6 + ! Processor-dependent + !if (ieee_signbit (ieee_max_num_mag (-0., 0.))) stop 7 + + if (ieee_max_num_mag (9., 0.) /= 9.) stop 8 + if (ieee_max_num_mag (0., 9.) /= 9.) stop 9 + if (ieee_max_num_mag (-9., 0.) /= -9.) stop 10 + if (ieee_max_num_mag (0., -9.) /= -9.) stop 11 + + if (ieee_max_num_mag (inf, 9.) /= inf) stop 12 + if (ieee_max_num_mag (0., inf) /= inf) stop 13 + if (ieee_max_num_mag (-9., inf) /= inf) stop 14 + if (ieee_max_num_mag (inf, -9.) /= inf) stop 15 + if (ieee_max_num_mag (-inf, 9.) /= -inf) stop 16 + if (ieee_max_num_mag (0., -inf) /= -inf) stop 17 + if (ieee_max_num_mag (-9., -inf) /= -inf) stop 18 + if (ieee_max_num_mag (-inf, -9.) /= -inf) stop 19 + + if (ieee_max_num_mag (0., nan) /= 0.) stop 20 + if (ieee_max_num_mag (nan, 0.) /= 0.) stop 21 + if (ieee_max_num_mag (-0., nan) /= -0.) stop 22 + if (.not. ieee_signbit (ieee_max_num_mag (-0., nan))) stop 23 + if (ieee_max_num_mag (nan, -0.) /= -0.) stop 24 + if (.not. ieee_signbit (ieee_max_num_mag (nan, -0.))) stop 25 + if (ieee_max_num_mag (9., nan) /= 9.) stop 26 + if (ieee_max_num_mag (nan, 9.) /= 9.) stop 27 + if (ieee_max_num_mag (-9., nan) /= -9.) stop 28 + if (ieee_max_num_mag (nan, -9.) /= -9.) stop 29 + + if (ieee_max_num_mag (nan, inf) /= inf) stop 30 + if (ieee_max_num_mag (inf, nan) /= inf) stop 31 + if (ieee_max_num_mag (nan, -inf) /= -inf) stop 32 + if (ieee_max_num_mag (-inf, nan) /= -inf) stop 33 + + if (.not. ieee_is_nan (ieee_max_num_mag (nan, nan))) stop 34 +end subroutine real + + +subroutine double + use ieee_arithmetic + implicit none + + double precision :: inf, nan + + inf = ieee_value(inf, ieee_positive_inf) + nan = ieee_value(nan, ieee_quiet_nan) + + if (ieee_max_num_mag (0.d0, 0.d0) /= 0.d0) stop 35 + if (ieee_max_num_mag (-0.d0, -0.d0) /= -0.d0) stop 36 + if (.not. ieee_signbit (ieee_max_num_mag (-0.d0, -0.d0))) stop 37 + if (ieee_max_num_mag (0.d0, -0.d0) /= 0.d0) stop 38 + ! Processor-dependent + !if (ieee_signbit (ieee_max_num_mag (0.d0, -0.d0))) stop 39 + if (ieee_max_num_mag (-0.d0, 0.d0) /= 0.d0) stop 40 + ! Processor-dependent + !if (ieee_signbit (ieee_max_num_mag (-0.d0, 0.d0))) stop 41 + + if (ieee_max_num_mag (9.d0, 0.d0) /= 9.d0) stop 42 + if (ieee_max_num_mag (0.d0, 9.d0) /= 9.d0) stop 43 + if (ieee_max_num_mag (-9.d0, 0.d0) /= -9.d0) stop 44 + if (ieee_max_num_mag (0.d0, -9.d0) /= -9.d0) stop 45 + + if (ieee_max_num_mag (inf, 9.d0) /= inf) stop 46 + if (ieee_max_num_mag (0.d0, inf) /= inf) stop 47 + if (ieee_max_num_mag (-9.d0, inf) /= inf) stop 48 + if (ieee_max_num_mag (inf, -9.d0) /= inf) stop 49 + if (ieee_max_num_mag (-inf, 9.d0) /= -inf) stop 50 + if (ieee_max_num_mag (0.d0, -inf) /= -inf) stop 51 + if (ieee_max_num_mag (-9.d0, -inf) /= -inf) stop 52 + if (ieee_max_num_mag (-inf, -9.d0) /= -inf) stop 53 + + if (ieee_max_num_mag (0.d0, nan) /= 0.d0) stop 54 + if (ieee_max_num_mag (nan, 0.d0) /= 0.d0) stop 55 + if (ieee_max_num_mag (-0.d0, nan) /= -0.d0) stop 56 + if (.not. ieee_signbit (ieee_max_num_mag (-0.d0, nan))) stop 57 + if (ieee_max_num_mag (nan, -0.d0) /= -0.d0) stop 58 + if (.not. ieee_signbit (ieee_max_num_mag (nan, -0.d0))) stop 59 + if (ieee_max_num_mag (9.d0, nan) /= 9.d0) stop 60 + if (ieee_max_num_mag (nan, 9.d0) /= 9.d0) stop 61 + if (ieee_max_num_mag (-9.d0, nan) /= -9.d0) stop 62 + if (ieee_max_num_mag (nan, -9.d0) /= -9.d0) stop 63 + + if (ieee_max_num_mag (nan, inf) /= inf) stop 64 + if (ieee_max_num_mag (inf, nan) /= inf) stop 65 + if (ieee_max_num_mag (nan, -inf) /= -inf) stop 66 + if (ieee_max_num_mag (-inf, nan) /= -inf) stop 67 + + if (.not. ieee_is_nan (ieee_max_num_mag (nan, nan))) stop 68 +end subroutine double + + +subroutine large1 + use ieee_arithmetic + implicit none + + ! k1 and k2 will be large real kinds, if supported, and single/double + ! otherwise + integer, parameter :: k1 = & + max(ieee_selected_real_kind(precision(0.d0) + 1), kind(0.)) + integer, parameter :: k2 = & + max(ieee_selected_real_kind(precision(0._k1) + 1), kind(0.d0)) + + real(kind=k1) :: inf, nan + + inf = ieee_value(inf, ieee_positive_inf) + nan = ieee_value(nan, ieee_quiet_nan) + + if (ieee_max_num_mag (0._k1, 0._k1) /= 0._k1) stop 35 + if (ieee_max_num_mag (-0._k1, -0._k1) /= -0._k1) stop 36 + if (.not. ieee_signbit (ieee_max_num_mag (-0._k1, -0._k1))) stop 37 + if (ieee_max_num_mag (0._k1, -0._k1) /= 0._k1) stop 38 + ! Processor-dependent + !if (ieee_signbit (ieee_max_num_mag (0._k1, -0._k1))) stop 39 + if (ieee_max_num_mag (-0._k1, 0._k1) /= 0._k1) stop 40 + ! Processor-dependent + !if (ieee_signbit (ieee_max_num_mag (-0._k1, 0._k1))) stop 41 + + if (ieee_max_num_mag (9._k1, 0._k1) /= 9._k1) stop 42 + if (ieee_max_num_mag (0._k1, 9._k1) /= 9._k1) stop 43 + if (ieee_max_num_mag (-9._k1, 0._k1) /= -9._k1) stop 44 + if (ieee_max_num_mag (0._k1, -9._k1) /= -9._k1) stop 45 + + if (ieee_max_num_mag (inf, 9._k1) /= inf) stop 46 + if (ieee_max_num_mag (0._k1, inf) /= inf) stop 47 + if (ieee_max_num_mag (-9._k1, inf) /= inf) stop 48 + if (ieee_max_num_mag (inf, -9._k1) /= inf) stop 49 + if (ieee_max_num_mag (-inf, 9._k1) /= -inf) stop 50 + if (ieee_max_num_mag (0._k1, -inf) /= -inf) stop 51 + if (ieee_max_num_mag (-9._k1, -inf) /= -inf) stop 52 + if (ieee_max_num_mag (-inf, -9._k1) /= -inf) stop 53 + + if (ieee_max_num_mag (0._k1, nan) /= 0._k1) stop 54 + if (ieee_max_num_mag (nan, 0._k1) /= 0._k1) stop 55 + if (ieee_max_num_mag (-0._k1, nan) /= -0._k1) stop 56 + if (.not. ieee_signbit (ieee_max_num_mag (-0._k1, nan))) stop 57 + if (ieee_max_num_mag (nan, -0._k1) /= -0._k1) stop 58 + if (.not. ieee_signbit (ieee_max_num_mag (nan, -0._k1))) stop 59 + if (ieee_max_num_mag (9._k1, nan) /= 9._k1) stop 60 + if (ieee_max_num_mag (nan, 9._k1) /= 9._k1) stop 61 + if (ieee_max_num_mag (-9._k1, nan) /= -9._k1) stop 62 + if (ieee_max_num_mag (nan, -9._k1) /= -9._k1) stop 63 + + if (ieee_max_num_mag (nan, inf) /= inf) stop 64 + if (ieee_max_num_mag (inf, nan) /= inf) stop 65 + if (ieee_max_num_mag (nan, -inf) /= -inf) stop 66 + if (ieee_max_num_mag (-inf, nan) /= -inf) stop 67 + + if (.not. ieee_is_nan (ieee_max_num_mag (nan, nan))) stop 68 +end subroutine large1 + + +subroutine large2 + use ieee_arithmetic + implicit none + + ! k1 and k2 will be large real kinds, if supported, and single/double + ! otherwise + integer, parameter :: k1 = & + max(ieee_selected_real_kind(precision(0.d0) + 1), kind(0.)) + integer, parameter :: k2 = & + max(ieee_selected_real_kind(precision(0._k1) + 1), kind(0.d0)) + + real(kind=k2) :: inf, nan + + inf = ieee_value(inf, ieee_positive_inf) + nan = ieee_value(nan, ieee_quiet_nan) + + if (ieee_max_num_mag (0._k2, 0._k2) /= 0._k2) stop 35 + if (ieee_max_num_mag (-0._k2, -0._k2) /= -0._k2) stop 36 + if (.not. ieee_signbit (ieee_max_num_mag (-0._k2, -0._k2))) stop 37 + if (ieee_max_num_mag (0._k2, -0._k2) /= 0._k2) stop 38 + ! Processor-dependent + !if (ieee_signbit (ieee_max_num_mag (0._k2, -0._k2))) stop 39 + if (ieee_max_num_mag (-0._k2, 0._k2) /= 0._k2) stop 40 + ! Processor-dependent + !if (ieee_signbit (ieee_max_num_mag (-0._k2, 0._k2))) stop 41 + + if (ieee_max_num_mag (9._k2, 0._k2) /= 9._k2) stop 42 + if (ieee_max_num_mag (0._k2, 9._k2) /= 9._k2) stop 43 + if (ieee_max_num_mag (-9._k2, 0._k2) /= -9._k2) stop 44 + if (ieee_max_num_mag (0._k2, -9._k2) /= -9._k2) stop 45 + + if (ieee_max_num_mag (inf, 9._k2) /= inf) stop 46 + if (ieee_max_num_mag (0._k2, inf) /= inf) stop 47 + if (ieee_max_num_mag (-9._k2, inf) /= inf) stop 48 + if (ieee_max_num_mag (inf, -9._k2) /= inf) stop 49 + if (ieee_max_num_mag (-inf, 9._k2) /= -inf) stop 50 + if (ieee_max_num_mag (0._k2, -inf) /= -inf) stop 51 + if (ieee_max_num_mag (-9._k2, -inf) /= -inf) stop 52 + if (ieee_max_num_mag (-inf, -9._k2) /= -inf) stop 53 + + if (ieee_max_num_mag (0._k2, nan) /= 0._k2) stop 54 + if (ieee_max_num_mag (nan, 0._k2) /= 0._k2) stop 55 + if (ieee_max_num_mag (-0._k2, nan) /= -0._k2) stop 56 + if (.not. ieee_signbit (ieee_max_num_mag (-0._k2, nan))) stop 57 + if (ieee_max_num_mag (nan, -0._k2) /= -0._k2) stop 58 + if (.not. ieee_signbit (ieee_max_num_mag (nan, -0._k2))) stop 59 + if (ieee_max_num_mag (9._k2, nan) /= 9._k2) stop 60 + if (ieee_max_num_mag (nan, 9._k2) /= 9._k2) stop 61 + if (ieee_max_num_mag (-9._k2, nan) /= -9._k2) stop 62 + if (ieee_max_num_mag (nan, -9._k2) /= -9._k2) stop 63 + + if (ieee_max_num_mag (nan, inf) /= inf) stop 64 + if (ieee_max_num_mag (inf, nan) /= inf) stop 65 + if (ieee_max_num_mag (nan, -inf) /= -inf) stop 66 + if (ieee_max_num_mag (-inf, nan) /= -inf) stop 67 + + if (.not. ieee_is_nan (ieee_max_num_mag (nan, nan))) stop 68 +end subroutine large2 + diff --git a/gcc/testsuite/gfortran.dg/ieee/minmax_2.f90 b/gcc/testsuite/gfortran.dg/ieee/minmax_2.f90 new file mode 100644 index 0000000000000000000000000000000000000000..52c3fa015477036c1dd46c4730207b0388168049 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ieee/minmax_2.f90 @@ -0,0 +1,235 @@ +! { dg-do run } +! +program test + call real() + call double() + call large1() + call large2() +end program test + + +subroutine real + use ieee_arithmetic + implicit none + + real :: inf, nan + + inf = ieee_value(inf, ieee_positive_inf) + nan = ieee_value(nan, ieee_quiet_nan) + + if (ieee_min_num_mag (0., 0.) /= 0.) stop 1 + if (ieee_min_num_mag (-0., -0.) /= -0.) stop 2 + if (.not. ieee_signbit (ieee_min_num_mag (-0., -0.))) stop 3 + if (ieee_min_num_mag (0., -0.) /= -0.) stop 4 + ! Processor-dependent + !if (ieee_signbit (ieee_min_num_mag (0., -0.))) stop 5 + if (ieee_min_num_mag (-0., 0.) /= 0.) stop 6 + ! Processor-dependent + !if (ieee_signbit (ieee_min_num_mag (-0., 0.))) stop 7 + + if (ieee_min_num_mag (9., 0.) /= 0.) stop 8 + if (ieee_min_num_mag (0., 9.) /= 0.) stop 9 + if (ieee_min_num_mag (-9., 0.) /= 0.) stop 10 + if (ieee_min_num_mag (0., -9.) /= 0.) stop 11 + + if (ieee_min_num_mag (inf, 9.) /= 9.) stop 12 + if (ieee_min_num_mag (0., inf) /= 0.) stop 13 + if (ieee_min_num_mag (-9., inf) /= -9.) stop 14 + if (ieee_min_num_mag (inf, -9.) /= -9.) stop 15 + if (ieee_min_num_mag (-inf, 9.) /= 9.) stop 16 + if (ieee_min_num_mag (0., -inf) /= 0.) stop 17 + if (ieee_min_num_mag (-9., -inf) /= -9.) stop 18 + if (ieee_min_num_mag (-inf, -9.) /= -9.) stop 19 + + if (ieee_min_num_mag (0., nan) /= 0.) stop 20 + if (ieee_min_num_mag (nan, 0.) /= 0.) stop 21 + if (ieee_min_num_mag (-0., nan) /= -0.) stop 22 + if (.not. ieee_signbit (ieee_min_num_mag (-0., nan))) stop 23 + if (ieee_min_num_mag (nan, -0.) /= -0.) stop 24 + if (.not. ieee_signbit (ieee_min_num_mag (nan, -0.))) stop 25 + if (ieee_min_num_mag (9., nan) /= 9.) stop 26 + if (ieee_min_num_mag (nan, 9.) /= 9.) stop 27 + if (ieee_min_num_mag (-9., nan) /= -9.) stop 28 + if (ieee_min_num_mag (nan, -9.) /= -9.) stop 29 + + if (ieee_min_num_mag (nan, inf) /= inf) stop 30 + if (ieee_min_num_mag (inf, nan) /= inf) stop 31 + if (ieee_min_num_mag (nan, -inf) /= -inf) stop 32 + if (ieee_min_num_mag (-inf, nan) /= -inf) stop 33 + + if (.not. ieee_is_nan (ieee_min_num_mag (nan, nan))) stop 34 +end subroutine real + + +subroutine double + use ieee_arithmetic + implicit none + + double precision :: inf, nan + + inf = ieee_value(inf, ieee_positive_inf) + nan = ieee_value(nan, ieee_quiet_nan) + + if (ieee_min_num_mag (0.d0, 0.d0) /= 0.d0) stop 35 + if (ieee_min_num_mag (-0.d0, -0.d0) /= -0.d0) stop 36 + if (.not. ieee_signbit (ieee_min_num_mag (-0.d0, -0.d0))) stop 37 + if (ieee_min_num_mag (0.d0, -0.d0) /= 0.d0) stop 38 + ! Processor-dependent + !if (ieee_signbit (ieee_min_num_mag (0.d0, -0.d0))) stop 39 + if (ieee_min_num_mag (-0.d0, 0.d0) /= 0.d0) stop 40 + ! Processor-dependent + !if (ieee_signbit (ieee_min_num_mag (-0.d0, 0.d0))) stop 41 + + if (ieee_min_num_mag (9.d0, 0.d0) /= 0.d0) stop 42 + if (ieee_min_num_mag (0.d0, 9.d0) /= 0.d0) stop 43 + if (ieee_min_num_mag (-9.d0, 0.d0) /= 0.d0) stop 44 + if (ieee_min_num_mag (0.d0, -9.d0) /= 0.d0) stop 45 + + if (ieee_min_num_mag (inf, 9.d0) /= 9.d0) stop 46 + if (ieee_min_num_mag (0.d0, inf) /= 0.d0) stop 47 + if (ieee_min_num_mag (-9.d0, inf) /= -9.d0) stop 48 + if (ieee_min_num_mag (inf, -9.d0) /= -9.d0) stop 49 + if (ieee_min_num_mag (-inf, 9.d0) /= 9.d0) stop 50 + if (ieee_min_num_mag (0.d0, -inf) /= 0.d0) stop 51 + if (ieee_min_num_mag (-9.d0, -inf) /= -9.d0) stop 52 + if (ieee_min_num_mag (-inf, -9.d0) /= -9.d0) stop 53 + + if (ieee_min_num_mag (0.d0, nan) /= 0.d0) stop 54 + if (ieee_min_num_mag (nan, 0.d0) /= 0.d0) stop 55 + if (ieee_min_num_mag (-0.d0, nan) /= -0.d0) stop 56 + if (.not. ieee_signbit (ieee_min_num_mag (-0.d0, nan))) stop 57 + if (ieee_min_num_mag (nan, -0.d0) /= -0.d0) stop 58 + if (.not. ieee_signbit (ieee_min_num_mag (nan, -0.d0))) stop 59 + if (ieee_min_num_mag (9.d0, nan) /= 9.d0) stop 60 + if (ieee_min_num_mag (nan, 9.d0) /= 9.d0) stop 61 + if (ieee_min_num_mag (-9.d0, nan) /= -9.d0) stop 62 + if (ieee_min_num_mag (nan, -9.d0) /= -9.d0) stop 63 + + if (ieee_min_num_mag (nan, inf) /= inf) stop 64 + if (ieee_min_num_mag (inf, nan) /= inf) stop 65 + if (ieee_min_num_mag (nan, -inf) /= -inf) stop 66 + if (ieee_min_num_mag (-inf, nan) /= -inf) stop 67 + + if (.not. ieee_is_nan (ieee_min_num_mag (nan, nan))) stop 68 +end subroutine double + + +subroutine large1 + use ieee_arithmetic + implicit none + + ! k1 and k2 will be large real kinds, if supported, and single/double + ! otherwise + integer, parameter :: k1 = & + max(ieee_selected_real_kind(precision(0.d0) + 1), kind(0.)) + integer, parameter :: k2 = & + max(ieee_selected_real_kind(precision(0._k1) + 1), kind(0.d0)) + + real(kind=k1) :: inf, nan + + inf = ieee_value(inf, ieee_positive_inf) + nan = ieee_value(nan, ieee_quiet_nan) + + if (ieee_min_num_mag (0._k1, 0._k1) /= 0._k1) stop 35 + if (ieee_min_num_mag (-0._k1, -0._k1) /= -0._k1) stop 36 + if (.not. ieee_signbit (ieee_min_num_mag (-0._k1, -0._k1))) stop 37 + if (ieee_min_num_mag (0._k1, -0._k1) /= 0._k1) stop 38 + ! Processor-dependent + !if (ieee_signbit (ieee_min_num_mag (0._k1, -0._k1))) stop 39 + if (ieee_min_num_mag (-0._k1, 0._k1) /= 0._k1) stop 40 + ! Processor-dependent + !if (ieee_signbit (ieee_min_num_mag (-0._k1, 0._k1))) stop 41 + + if (ieee_min_num_mag (9._k1, 0._k1) /= 0._k1) stop 42 + if (ieee_min_num_mag (0._k1, 9._k1) /= 0._k1) stop 43 + if (ieee_min_num_mag (-9._k1, 0._k1) /= 0._k1) stop 44 + if (ieee_min_num_mag (0._k1, -9._k1) /= 0._k1) stop 45 + + if (ieee_min_num_mag (inf, 9._k1) /= 9._k1) stop 46 + if (ieee_min_num_mag (0._k1, inf) /= 0._k1) stop 47 + if (ieee_min_num_mag (-9._k1, inf) /= -9._k1) stop 48 + if (ieee_min_num_mag (inf, -9._k1) /= -9._k1) stop 49 + if (ieee_min_num_mag (-inf, 9._k1) /= 9._k1) stop 50 + if (ieee_min_num_mag (0._k1, -inf) /= 0._k1) stop 51 + if (ieee_min_num_mag (-9._k1, -inf) /= -9._k1) stop 52 + if (ieee_min_num_mag (-inf, -9._k1) /= -9._k1) stop 53 + + if (ieee_min_num_mag (0._k1, nan) /= 0._k1) stop 54 + if (ieee_min_num_mag (nan, 0._k1) /= 0._k1) stop 55 + if (ieee_min_num_mag (-0._k1, nan) /= -0._k1) stop 56 + if (.not. ieee_signbit (ieee_min_num_mag (-0._k1, nan))) stop 57 + if (ieee_min_num_mag (nan, -0._k1) /= -0._k1) stop 58 + if (.not. ieee_signbit (ieee_min_num_mag (nan, -0._k1))) stop 59 + if (ieee_min_num_mag (9._k1, nan) /= 9._k1) stop 60 + if (ieee_min_num_mag (nan, 9._k1) /= 9._k1) stop 61 + if (ieee_min_num_mag (-9._k1, nan) /= -9._k1) stop 62 + if (ieee_min_num_mag (nan, -9._k1) /= -9._k1) stop 63 + + if (ieee_min_num_mag (nan, inf) /= inf) stop 64 + if (ieee_min_num_mag (inf, nan) /= inf) stop 65 + if (ieee_min_num_mag (nan, -inf) /= -inf) stop 66 + if (ieee_min_num_mag (-inf, nan) /= -inf) stop 67 + + if (.not. ieee_is_nan (ieee_min_num_mag (nan, nan))) stop 68 +end subroutine large1 + + +subroutine large2 + use ieee_arithmetic + implicit none + + ! k1 and k2 will be large real kinds, if supported, and single/double + ! otherwise + integer, parameter :: k1 = & + max(ieee_selected_real_kind(precision(0.d0) + 1), kind(0.)) + integer, parameter :: k2 = & + max(ieee_selected_real_kind(precision(0._k1) + 1), kind(0.d0)) + + real(kind=k2) :: inf, nan + + inf = ieee_value(inf, ieee_positive_inf) + nan = ieee_value(nan, ieee_quiet_nan) + + if (ieee_min_num_mag (0._k2, 0._k2) /= 0._k2) stop 35 + if (ieee_min_num_mag (-0._k2, -0._k2) /= -0._k2) stop 36 + if (.not. ieee_signbit (ieee_min_num_mag (-0._k2, -0._k2))) stop 37 + if (ieee_min_num_mag (0._k2, -0._k2) /= 0._k2) stop 38 + ! Processor-dependent + !if (ieee_signbit (ieee_min_num_mag (0._k2, -0._k2))) stop 39 + if (ieee_min_num_mag (-0._k2, 0._k2) /= 0._k2) stop 40 + ! Processor-dependent + !if (ieee_signbit (ieee_min_num_mag (-0._k2, 0._k2))) stop 41 + + if (ieee_min_num_mag (9._k2, 0._k2) /= 0._k2) stop 42 + if (ieee_min_num_mag (0._k2, 9._k2) /= 0._k2) stop 43 + if (ieee_min_num_mag (-9._k2, 0._k2) /= 0._k2) stop 44 + if (ieee_min_num_mag (0._k2, -9._k2) /= 0._k2) stop 45 + + if (ieee_min_num_mag (inf, 9._k2) /= 9._k2) stop 46 + if (ieee_min_num_mag (0._k2, inf) /= 0._k2) stop 47 + if (ieee_min_num_mag (-9._k2, inf) /= -9._k2) stop 48 + if (ieee_min_num_mag (inf, -9._k2) /= -9._k2) stop 49 + if (ieee_min_num_mag (-inf, 9._k2) /= 9._k2) stop 50 + if (ieee_min_num_mag (0._k2, -inf) /= 0._k2) stop 51 + if (ieee_min_num_mag (-9._k2, -inf) /= -9._k2) stop 52 + if (ieee_min_num_mag (-inf, -9._k2) /= -9._k2) stop 53 + + if (ieee_min_num_mag (0._k2, nan) /= 0._k2) stop 54 + if (ieee_min_num_mag (nan, 0._k2) /= 0._k2) stop 55 + if (ieee_min_num_mag (-0._k2, nan) /= -0._k2) stop 56 + if (.not. ieee_signbit (ieee_min_num_mag (-0._k2, nan))) stop 57 + if (ieee_min_num_mag (nan, -0._k2) /= -0._k2) stop 58 + if (.not. ieee_signbit (ieee_min_num_mag (nan, -0._k2))) stop 59 + if (ieee_min_num_mag (9._k2, nan) /= 9._k2) stop 60 + if (ieee_min_num_mag (nan, 9._k2) /= 9._k2) stop 61 + if (ieee_min_num_mag (-9._k2, nan) /= -9._k2) stop 62 + if (ieee_min_num_mag (nan, -9._k2) /= -9._k2) stop 63 + + if (ieee_min_num_mag (nan, inf) /= inf) stop 64 + if (ieee_min_num_mag (inf, nan) /= inf) stop 65 + if (ieee_min_num_mag (nan, -inf) /= -inf) stop 66 + if (ieee_min_num_mag (-inf, nan) /= -inf) stop 67 + + if (.not. ieee_is_nan (ieee_min_num_mag (nan, nan))) stop 68 +end subroutine large2 + diff --git a/gcc/testsuite/gfortran.dg/ieee/minmax_3.f90 b/gcc/testsuite/gfortran.dg/ieee/minmax_3.f90 new file mode 100644 index 0000000000000000000000000000000000000000..337bb368d0bf0e6bc3a22b7ddf67eb5486f5e284 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ieee/minmax_3.f90 @@ -0,0 +1,235 @@ +! { dg-do run } +! +program test + call real() + call double() + call large1() + call large2() +end program test + + +subroutine real + use ieee_arithmetic + implicit none + + real :: inf, nan + + inf = ieee_value(inf, ieee_positive_inf) + nan = ieee_value(nan, ieee_quiet_nan) + + if (ieee_max_num (0., 0.) /= 0.) stop 1 + if (ieee_max_num (-0., -0.) /= -0.) stop 2 + if (.not. ieee_signbit (ieee_max_num (-0., -0.))) stop 3 + if (ieee_max_num (0., -0.) /= 0.) stop 4 + ! Processor-dependent + !if (ieee_signbit (ieee_max_num (0., -0.))) stop 5 + if (ieee_max_num (-0., 0.) /= 0.) stop 6 + ! Processor-dependent + !if (ieee_signbit (ieee_max_num (-0., 0.))) stop 7 + + if (ieee_max_num (9., 0.) /= 9.) stop 8 + if (ieee_max_num (0., 9.) /= 9.) stop 9 + if (ieee_max_num (-9., 0.) /= 0.) stop 10 + if (ieee_max_num (0., -9.) /= 0.) stop 11 + + if (ieee_max_num (inf, 9.) /= inf) stop 12 + if (ieee_max_num (0., inf) /= inf) stop 13 + if (ieee_max_num (-9., inf) /= inf) stop 14 + if (ieee_max_num (inf, -9.) /= inf) stop 15 + if (ieee_max_num (-inf, 9.) /= 9.) stop 16 + if (ieee_max_num (0., -inf) /= 0.) stop 17 + if (ieee_max_num (-9., -inf) /= -9.) stop 18 + if (ieee_max_num (-inf, -9.) /= -9.) stop 19 + + if (ieee_max_num (0., nan) /= 0.) stop 20 + if (ieee_max_num (nan, 0.) /= 0.) stop 21 + if (ieee_max_num (-0., nan) /= -0.) stop 22 + if (.not. ieee_signbit (ieee_max_num (-0., nan))) stop 23 + if (ieee_max_num (nan, -0.) /= -0.) stop 24 + if (.not. ieee_signbit (ieee_max_num (nan, -0.))) stop 25 + if (ieee_max_num (9., nan) /= 9.) stop 26 + if (ieee_max_num (nan, 9.) /= 9.) stop 27 + if (ieee_max_num (-9., nan) /= -9.) stop 28 + if (ieee_max_num (nan, -9.) /= -9.) stop 29 + + if (ieee_max_num (nan, inf) /= inf) stop 30 + if (ieee_max_num (inf, nan) /= inf) stop 31 + if (ieee_max_num (nan, -inf) /= -inf) stop 32 + if (ieee_max_num (-inf, nan) /= -inf) stop 33 + + if (.not. ieee_is_nan (ieee_max_num (nan, nan))) stop 34 +end subroutine real + + +subroutine double + use ieee_arithmetic + implicit none + + double precision :: inf, nan + + inf = ieee_value(inf, ieee_positive_inf) + nan = ieee_value(nan, ieee_quiet_nan) + + if (ieee_max_num (0.d0, 0.d0) /= 0.d0) stop 35 + if (ieee_max_num (-0.d0, -0.d0) /= -0.d0) stop 36 + if (.not. ieee_signbit (ieee_max_num (-0.d0, -0.d0))) stop 37 + if (ieee_max_num (0.d0, -0.d0) /= 0.d0) stop 38 + ! Processor-dependent + !if (ieee_signbit (ieee_max_num (0.d0, -0.d0))) stop 39 + if (ieee_max_num (-0.d0, 0.d0) /= 0.d0) stop 40 + ! Processor-dependent + !if (ieee_signbit (ieee_max_num (-0.d0, 0.d0))) stop 41 + + if (ieee_max_num (9.d0, 0.d0) /= 9.d0) stop 42 + if (ieee_max_num (0.d0, 9.d0) /= 9.d0) stop 43 + if (ieee_max_num (-9.d0, 0.d0) /= 0.d0) stop 44 + if (ieee_max_num (0.d0, -9.d0) /= 0.d0) stop 45 + + if (ieee_max_num (inf, 9.d0) /= inf) stop 46 + if (ieee_max_num (0.d0, inf) /= inf) stop 47 + if (ieee_max_num (-9.d0, inf) /= inf) stop 48 + if (ieee_max_num (inf, -9.d0) /= inf) stop 49 + if (ieee_max_num (-inf, 9.d0) /= 9.d0) stop 50 + if (ieee_max_num (0.d0, -inf) /= 0.d0) stop 51 + if (ieee_max_num (-9.d0, -inf) /= -9.d0) stop 52 + if (ieee_max_num (-inf, -9.d0) /= -9.d0) stop 53 + + if (ieee_max_num (0.d0, nan) /= 0.d0) stop 54 + if (ieee_max_num (nan, 0.d0) /= 0.d0) stop 55 + if (ieee_max_num (-0.d0, nan) /= -0.d0) stop 56 + if (.not. ieee_signbit (ieee_max_num (-0.d0, nan))) stop 57 + if (ieee_max_num (nan, -0.d0) /= -0.d0) stop 58 + if (.not. ieee_signbit (ieee_max_num (nan, -0.d0))) stop 59 + if (ieee_max_num (9.d0, nan) /= 9.d0) stop 60 + if (ieee_max_num (nan, 9.d0) /= 9.d0) stop 61 + if (ieee_max_num (-9.d0, nan) /= -9.d0) stop 62 + if (ieee_max_num (nan, -9.d0) /= -9.d0) stop 63 + + if (ieee_max_num (nan, inf) /= inf) stop 64 + if (ieee_max_num (inf, nan) /= inf) stop 65 + if (ieee_max_num (nan, -inf) /= -inf) stop 66 + if (ieee_max_num (-inf, nan) /= -inf) stop 67 + + if (.not. ieee_is_nan (ieee_max_num (nan, nan))) stop 68 +end subroutine double + + +subroutine large1 + use ieee_arithmetic + implicit none + + ! k1 and k2 will be large real kinds, if supported, and single/double + ! otherwise + integer, parameter :: k1 = & + max(ieee_selected_real_kind(precision(0.d0) + 1), kind(0.)) + integer, parameter :: k2 = & + max(ieee_selected_real_kind(precision(0._k1) + 1), kind(0.d0)) + + real(kind=k1) :: inf, nan + + inf = ieee_value(inf, ieee_positive_inf) + nan = ieee_value(nan, ieee_quiet_nan) + + if (ieee_max_num (0._k1, 0._k1) /= 0._k1) stop 35 + if (ieee_max_num (-0._k1, -0._k1) /= -0._k1) stop 36 + if (.not. ieee_signbit (ieee_max_num (-0._k1, -0._k1))) stop 37 + if (ieee_max_num (0._k1, -0._k1) /= 0._k1) stop 38 + ! Processor-dependent + !if (ieee_signbit (ieee_max_num (0._k1, -0._k1))) stop 39 + if (ieee_max_num (-0._k1, 0._k1) /= 0._k1) stop 40 + ! Processor-dependent + !if (ieee_signbit (ieee_max_num (-0._k1, 0._k1))) stop 41 + + if (ieee_max_num (9._k1, 0._k1) /= 9._k1) stop 42 + if (ieee_max_num (0._k1, 9._k1) /= 9._k1) stop 43 + if (ieee_max_num (-9._k1, 0._k1) /= 0._k1) stop 44 + if (ieee_max_num (0._k1, -9._k1) /= 0._k1) stop 45 + + if (ieee_max_num (inf, 9._k1) /= inf) stop 46 + if (ieee_max_num (0._k1, inf) /= inf) stop 47 + if (ieee_max_num (-9._k1, inf) /= inf) stop 48 + if (ieee_max_num (inf, -9._k1) /= inf) stop 49 + if (ieee_max_num (-inf, 9._k1) /= 9._k1) stop 50 + if (ieee_max_num (0._k1, -inf) /= 0._k1) stop 51 + if (ieee_max_num (-9._k1, -inf) /= -9._k1) stop 52 + if (ieee_max_num (-inf, -9._k1) /= -9._k1) stop 53 + + if (ieee_max_num (0._k1, nan) /= 0._k1) stop 54 + if (ieee_max_num (nan, 0._k1) /= 0._k1) stop 55 + if (ieee_max_num (-0._k1, nan) /= -0._k1) stop 56 + if (.not. ieee_signbit (ieee_max_num (-0._k1, nan))) stop 57 + if (ieee_max_num (nan, -0._k1) /= -0._k1) stop 58 + if (.not. ieee_signbit (ieee_max_num (nan, -0._k1))) stop 59 + if (ieee_max_num (9._k1, nan) /= 9._k1) stop 60 + if (ieee_max_num (nan, 9._k1) /= 9._k1) stop 61 + if (ieee_max_num (-9._k1, nan) /= -9._k1) stop 62 + if (ieee_max_num (nan, -9._k1) /= -9._k1) stop 63 + + if (ieee_max_num (nan, inf) /= inf) stop 64 + if (ieee_max_num (inf, nan) /= inf) stop 65 + if (ieee_max_num (nan, -inf) /= -inf) stop 66 + if (ieee_max_num (-inf, nan) /= -inf) stop 67 + + if (.not. ieee_is_nan (ieee_max_num (nan, nan))) stop 68 +end subroutine large1 + + +subroutine large2 + use ieee_arithmetic + implicit none + + ! k1 and k2 will be large real kinds, if supported, and single/double + ! otherwise + integer, parameter :: k1 = & + max(ieee_selected_real_kind(precision(0.d0) + 1), kind(0.)) + integer, parameter :: k2 = & + max(ieee_selected_real_kind(precision(0._k1) + 1), kind(0.d0)) + + real(kind=k2) :: inf, nan + + inf = ieee_value(inf, ieee_positive_inf) + nan = ieee_value(nan, ieee_quiet_nan) + + if (ieee_max_num (0._k2, 0._k2) /= 0._k2) stop 35 + if (ieee_max_num (-0._k2, -0._k2) /= -0._k2) stop 36 + if (.not. ieee_signbit (ieee_max_num (-0._k2, -0._k2))) stop 37 + if (ieee_max_num (0._k2, -0._k2) /= 0._k2) stop 38 + ! Processor-dependent + !if (ieee_signbit (ieee_max_num (0._k2, -0._k2))) stop 39 + if (ieee_max_num (-0._k2, 0._k2) /= 0._k2) stop 40 + ! Processor-dependent + !if (ieee_signbit (ieee_max_num (-0._k2, 0._k2))) stop 41 + + if (ieee_max_num (9._k2, 0._k2) /= 9._k2) stop 42 + if (ieee_max_num (0._k2, 9._k2) /= 9._k2) stop 43 + if (ieee_max_num (-9._k2, 0._k2) /= 0._k2) stop 44 + if (ieee_max_num (0._k2, -9._k2) /= 0._k2) stop 45 + + if (ieee_max_num (inf, 9._k2) /= inf) stop 46 + if (ieee_max_num (0._k2, inf) /= inf) stop 47 + if (ieee_max_num (-9._k2, inf) /= inf) stop 48 + if (ieee_max_num (inf, -9._k2) /= inf) stop 49 + if (ieee_max_num (-inf, 9._k2) /= 9._k2) stop 50 + if (ieee_max_num (0._k2, -inf) /= 0._k2) stop 51 + if (ieee_max_num (-9._k2, -inf) /= -9._k2) stop 52 + if (ieee_max_num (-inf, -9._k2) /= -9._k2) stop 53 + + if (ieee_max_num (0._k2, nan) /= 0._k2) stop 54 + if (ieee_max_num (nan, 0._k2) /= 0._k2) stop 55 + if (ieee_max_num (-0._k2, nan) /= -0._k2) stop 56 + if (.not. ieee_signbit (ieee_max_num (-0._k2, nan))) stop 57 + if (ieee_max_num (nan, -0._k2) /= -0._k2) stop 58 + if (.not. ieee_signbit (ieee_max_num (nan, -0._k2))) stop 59 + if (ieee_max_num (9._k2, nan) /= 9._k2) stop 60 + if (ieee_max_num (nan, 9._k2) /= 9._k2) stop 61 + if (ieee_max_num (-9._k2, nan) /= -9._k2) stop 62 + if (ieee_max_num (nan, -9._k2) /= -9._k2) stop 63 + + if (ieee_max_num (nan, inf) /= inf) stop 64 + if (ieee_max_num (inf, nan) /= inf) stop 65 + if (ieee_max_num (nan, -inf) /= -inf) stop 66 + if (ieee_max_num (-inf, nan) /= -inf) stop 67 + + if (.not. ieee_is_nan (ieee_max_num (nan, nan))) stop 68 +end subroutine large2 + diff --git a/gcc/testsuite/gfortran.dg/ieee/minmax_4.f90 b/gcc/testsuite/gfortran.dg/ieee/minmax_4.f90 new file mode 100644 index 0000000000000000000000000000000000000000..f55a96ba6523cf7ec41554b04d8793c0fd87c5d5 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/ieee/minmax_4.f90 @@ -0,0 +1,235 @@ +! { dg-do run } +! +program test + call real() + call double() + call large1() + call large2() +end program test + + +subroutine real + use ieee_arithmetic + implicit none + + real :: inf, nan + + inf = ieee_value(inf, ieee_positive_inf) + nan = ieee_value(nan, ieee_quiet_nan) + + if (ieee_min_num (0., 0.) /= 0.) stop 1 + if (ieee_min_num (-0., -0.) /= -0.) stop 2 + if (.not. ieee_signbit (ieee_min_num (-0., -0.))) stop 3 + if (ieee_min_num (0., -0.) /= -0.) stop 4 + ! Processor-dependent + !if (ieee_signbit (ieee_min_num (0., -0.))) stop 5 + if (ieee_min_num (-0., 0.) /= 0.) stop 6 + ! Processor-dependent + !if (ieee_signbit (ieee_min_num (-0., 0.))) stop 7 + + if (ieee_min_num (9., 0.) /= 0.) stop 8 + if (ieee_min_num (0., 9.) /= 0.) stop 9 + if (ieee_min_num (-9., 0.) /= -9.) stop 10 + if (ieee_min_num (0., -9.) /= -9.) stop 11 + + if (ieee_min_num (inf, 9.) /= 9.) stop 12 + if (ieee_min_num (0., inf) /= 0.) stop 13 + if (ieee_min_num (-9., inf) /= -9.) stop 14 + if (ieee_min_num (inf, -9.) /= -9.) stop 15 + if (ieee_min_num (-inf, 9.) /= -inf) stop 16 + if (ieee_min_num (0., -inf) /= -inf) stop 17 + if (ieee_min_num (-9., -inf) /= -inf) stop 18 + if (ieee_min_num (-inf, -9.) /= -inf) stop 19 + + if (ieee_min_num (0., nan) /= 0.) stop 20 + if (ieee_min_num (nan, 0.) /= 0.) stop 21 + if (ieee_min_num (-0., nan) /= -0.) stop 22 + if (.not. ieee_signbit (ieee_min_num (-0., nan))) stop 23 + if (ieee_min_num (nan, -0.) /= -0.) stop 24 + if (.not. ieee_signbit (ieee_min_num (nan, -0.))) stop 25 + if (ieee_min_num (9., nan) /= 9.) stop 26 + if (ieee_min_num (nan, 9.) /= 9.) stop 27 + if (ieee_min_num (-9., nan) /= -9.) stop 28 + if (ieee_min_num (nan, -9.) /= -9.) stop 29 + + if (ieee_min_num (nan, inf) /= inf) stop 30 + if (ieee_min_num (inf, nan) /= inf) stop 31 + if (ieee_min_num (nan, -inf) /= -inf) stop 32 + if (ieee_min_num (-inf, nan) /= -inf) stop 33 + + if (.not. ieee_is_nan (ieee_min_num (nan, nan))) stop 34 +end subroutine real + + +subroutine double + use ieee_arithmetic + implicit none + + double precision :: inf, nan + + inf = ieee_value(inf, ieee_positive_inf) + nan = ieee_value(nan, ieee_quiet_nan) + + if (ieee_min_num (0.d0, 0.d0) /= 0.d0) stop 35 + if (ieee_min_num (-0.d0, -0.d0) /= -0.d0) stop 36 + if (.not. ieee_signbit (ieee_min_num (-0.d0, -0.d0))) stop 37 + if (ieee_min_num (0.d0, -0.d0) /= 0.d0) stop 38 + ! Processor-dependent + !if (ieee_signbit (ieee_min_num (0.d0, -0.d0))) stop 39 + if (ieee_min_num (-0.d0, 0.d0) /= 0.d0) stop 40 + ! Processor-dependent + !if (ieee_signbit (ieee_min_num (-0.d0, 0.d0))) stop 41 + + if (ieee_min_num (9.d0, 0.d0) /= 0.d0) stop 42 + if (ieee_min_num (0.d0, 9.d0) /= 0.d0) stop 43 + if (ieee_min_num (-9.d0, 0.d0) /= -9.d0) stop 44 + if (ieee_min_num (0.d0, -9.d0) /= -9.d0) stop 45 + + if (ieee_min_num (inf, 9.d0) /= 9.d0) stop 46 + if (ieee_min_num (0.d0, inf) /= 0.d0) stop 47 + if (ieee_min_num (-9.d0, inf) /= -9.d0) stop 48 + if (ieee_min_num (inf, -9.d0) /= -9.d0) stop 49 + if (ieee_min_num (-inf, 9.d0) /= -inf) stop 50 + if (ieee_min_num (0.d0, -inf) /= -inf) stop 51 + if (ieee_min_num (-9.d0, -inf) /= -inf) stop 52 + if (ieee_min_num (-inf, -9.d0) /= -inf) stop 53 + + if (ieee_min_num (0.d0, nan) /= 0.d0) stop 54 + if (ieee_min_num (nan, 0.d0) /= 0.d0) stop 55 + if (ieee_min_num (-0.d0, nan) /= -0.d0) stop 56 + if (.not. ieee_signbit (ieee_min_num (-0.d0, nan))) stop 57 + if (ieee_min_num (nan, -0.d0) /= -0.d0) stop 58 + if (.not. ieee_signbit (ieee_min_num (nan, -0.d0))) stop 59 + if (ieee_min_num (9.d0, nan) /= 9.d0) stop 60 + if (ieee_min_num (nan, 9.d0) /= 9.d0) stop 61 + if (ieee_min_num (-9.d0, nan) /= -9.d0) stop 62 + if (ieee_min_num (nan, -9.d0) /= -9.d0) stop 63 + + if (ieee_min_num (nan, inf) /= inf) stop 64 + if (ieee_min_num (inf, nan) /= inf) stop 65 + if (ieee_min_num (nan, -inf) /= -inf) stop 66 + if (ieee_min_num (-inf, nan) /= -inf) stop 67 + + if (.not. ieee_is_nan (ieee_min_num (nan, nan))) stop 68 +end subroutine double + + +subroutine large1 + use ieee_arithmetic + implicit none + + ! k1 and k2 will be large real kinds, if supported, and single/double + ! otherwise + integer, parameter :: k1 = & + max(ieee_selected_real_kind(precision(0.d0) + 1), kind(0.)) + integer, parameter :: k2 = & + max(ieee_selected_real_kind(precision(0._k1) + 1), kind(0.d0)) + + real(kind=k1) :: inf, nan + + inf = ieee_value(inf, ieee_positive_inf) + nan = ieee_value(nan, ieee_quiet_nan) + + if (ieee_min_num (0._k1, 0._k1) /= 0._k1) stop 35 + if (ieee_min_num (-0._k1, -0._k1) /= -0._k1) stop 36 + if (.not. ieee_signbit (ieee_min_num (-0._k1, -0._k1))) stop 37 + if (ieee_min_num (0._k1, -0._k1) /= 0._k1) stop 38 + ! Processor-dependent + !if (ieee_signbit (ieee_min_num (0._k1, -0._k1))) stop 39 + if (ieee_min_num (-0._k1, 0._k1) /= 0._k1) stop 40 + ! Processor-dependent + !if (ieee_signbit (ieee_min_num (-0._k1, 0._k1))) stop 41 + + if (ieee_min_num (9._k1, 0._k1) /= 0._k1) stop 42 + if (ieee_min_num (0._k1, 9._k1) /= 0._k1) stop 43 + if (ieee_min_num (-9._k1, 0._k1) /= -9._k1) stop 44 + if (ieee_min_num (0._k1, -9._k1) /= -9._k1) stop 45 + + if (ieee_min_num (inf, 9._k1) /= 9._k1) stop 46 + if (ieee_min_num (0._k1, inf) /= 0._k1) stop 47 + if (ieee_min_num (-9._k1, inf) /= -9._k1) stop 48 + if (ieee_min_num (inf, -9._k1) /= -9._k1) stop 49 + if (ieee_min_num (-inf, 9._k1) /= -inf) stop 50 + if (ieee_min_num (0._k1, -inf) /= -inf) stop 51 + if (ieee_min_num (-9._k1, -inf) /= -inf) stop 52 + if (ieee_min_num (-inf, -9._k1) /= -inf) stop 53 + + if (ieee_min_num (0._k1, nan) /= 0._k1) stop 54 + if (ieee_min_num (nan, 0._k1) /= 0._k1) stop 55 + if (ieee_min_num (-0._k1, nan) /= -0._k1) stop 56 + if (.not. ieee_signbit (ieee_min_num (-0._k1, nan))) stop 57 + if (ieee_min_num (nan, -0._k1) /= -0._k1) stop 58 + if (.not. ieee_signbit (ieee_min_num (nan, -0._k1))) stop 59 + if (ieee_min_num (9._k1, nan) /= 9._k1) stop 60 + if (ieee_min_num (nan, 9._k1) /= 9._k1) stop 61 + if (ieee_min_num (-9._k1, nan) /= -9._k1) stop 62 + if (ieee_min_num (nan, -9._k1) /= -9._k1) stop 63 + + if (ieee_min_num (nan, inf) /= inf) stop 64 + if (ieee_min_num (inf, nan) /= inf) stop 65 + if (ieee_min_num (nan, -inf) /= -inf) stop 66 + if (ieee_min_num (-inf, nan) /= -inf) stop 67 + + if (.not. ieee_is_nan (ieee_min_num (nan, nan))) stop 68 +end subroutine large1 + + +subroutine large2 + use ieee_arithmetic + implicit none + + ! k1 and k2 will be large real kinds, if supported, and single/double + ! otherwise + integer, parameter :: k1 = & + max(ieee_selected_real_kind(precision(0.d0) + 1), kind(0.)) + integer, parameter :: k2 = & + max(ieee_selected_real_kind(precision(0._k1) + 1), kind(0.d0)) + + real(kind=k2) :: inf, nan + + inf = ieee_value(inf, ieee_positive_inf) + nan = ieee_value(nan, ieee_quiet_nan) + + if (ieee_min_num (0._k2, 0._k2) /= 0._k2) stop 35 + if (ieee_min_num (-0._k2, -0._k2) /= -0._k2) stop 36 + if (.not. ieee_signbit (ieee_min_num (-0._k2, -0._k2))) stop 37 + if (ieee_min_num (0._k2, -0._k2) /= 0._k2) stop 38 + ! Processor-dependent + !if (ieee_signbit (ieee_min_num (0._k2, -0._k2))) stop 39 + if (ieee_min_num (-0._k2, 0._k2) /= 0._k2) stop 40 + ! Processor-dependent + !if (ieee_signbit (ieee_min_num (-0._k2, 0._k2))) stop 41 + + if (ieee_min_num (9._k2, 0._k2) /= 0._k2) stop 42 + if (ieee_min_num (0._k2, 9._k2) /= 0._k2) stop 43 + if (ieee_min_num (-9._k2, 0._k2) /= -9._k2) stop 44 + if (ieee_min_num (0._k2, -9._k2) /= -9._k2) stop 45 + + if (ieee_min_num (inf, 9._k2) /= 9._k2) stop 46 + if (ieee_min_num (0._k2, inf) /= 0._k2) stop 47 + if (ieee_min_num (-9._k2, inf) /= -9._k2) stop 48 + if (ieee_min_num (inf, -9._k2) /= -9._k2) stop 49 + if (ieee_min_num (-inf, 9._k2) /= -inf) stop 50 + if (ieee_min_num (0._k2, -inf) /= -inf) stop 51 + if (ieee_min_num (-9._k2, -inf) /= -inf) stop 52 + if (ieee_min_num (-inf, -9._k2) /= -inf) stop 53 + + if (ieee_min_num (0._k2, nan) /= 0._k2) stop 54 + if (ieee_min_num (nan, 0._k2) /= 0._k2) stop 55 + if (ieee_min_num (-0._k2, nan) /= -0._k2) stop 56 + if (.not. ieee_signbit (ieee_min_num (-0._k2, nan))) stop 57 + if (ieee_min_num (nan, -0._k2) /= -0._k2) stop 58 + if (.not. ieee_signbit (ieee_min_num (nan, -0._k2))) stop 59 + if (ieee_min_num (9._k2, nan) /= 9._k2) stop 60 + if (ieee_min_num (nan, 9._k2) /= 9._k2) stop 61 + if (ieee_min_num (-9._k2, nan) /= -9._k2) stop 62 + if (ieee_min_num (nan, -9._k2) /= -9._k2) stop 63 + + if (ieee_min_num (nan, inf) /= inf) stop 64 + if (ieee_min_num (inf, nan) /= inf) stop 65 + if (ieee_min_num (nan, -inf) /= -inf) stop 66 + if (ieee_min_num (-inf, nan) /= -inf) stop 67 + + if (.not. ieee_is_nan (ieee_min_num (nan, nan))) stop 68 +end subroutine large2 + diff --git a/libgfortran/ieee/ieee_arithmetic.F90 b/libgfortran/ieee/ieee_arithmetic.F90 index 9c0b9f3173076fcf75054249716376124bf6fc02..d34ece6c8d27e9801009d32e61a4302ad3a7abe0 100644 --- a/libgfortran/ieee/ieee_arithmetic.F90 +++ b/libgfortran/ieee/ieee_arithmetic.F90 @@ -223,6 +223,132 @@ module IEEE_ARITHMETIC end interface public :: IEEE_IS_NORMAL + ! IEEE_MIN_NUM, IEEE_MAX_NUM, IEEE_MIN_NUM_MAG, IEEE_MAX_NUM_MAG + + interface + elemental real(kind=4) function _gfortran_ieee_max_num_4(X, Y) + real(kind=4), intent(in) :: X, Y + end function + elemental real(kind=8) function _gfortran_ieee_max_num_8(X, Y) + real(kind=8), intent(in) :: X, Y + end function +#ifdef HAVE_GFC_REAL_10 + elemental real(kind=10) function _gfortran_ieee_max_num_10(X, Y) + real(kind=10), intent(in) :: X, Y + end function +#endif +#ifdef HAVE_GFC_REAL_16 + elemental real(kind=16) function _gfortran_ieee_max_num_16(X, Y) + real(kind=16), intent(in) :: X, Y + end function +#endif + end interface + + interface IEEE_MAX_NUM + procedure & +#ifdef HAVE_GFC_REAL_16 + _gfortran_ieee_max_num_16, & +#endif +#ifdef HAVE_GFC_REAL_10 + _gfortran_ieee_max_num_10, & +#endif + _gfortran_ieee_max_num_8, _gfortran_ieee_max_num_4 + end interface + public :: IEEE_MAX_NUM + + interface + elemental real(kind=4) function _gfortran_ieee_max_num_mag_4(X, Y) + real(kind=4), intent(in) :: X, Y + end function + elemental real(kind=8) function _gfortran_ieee_max_num_mag_8(X, Y) + real(kind=8), intent(in) :: X, Y + end function +#ifdef HAVE_GFC_REAL_10 + elemental real(kind=10) function _gfortran_ieee_max_num_mag_10(X, Y) + real(kind=10), intent(in) :: X, Y + end function +#endif +#ifdef HAVE_GFC_REAL_16 + elemental real(kind=16) function _gfortran_ieee_max_num_mag_16(X, Y) + real(kind=16), intent(in) :: X, Y + end function +#endif + end interface + + interface IEEE_MAX_NUM_MAG + procedure & +#ifdef HAVE_GFC_REAL_16 + _gfortran_ieee_max_num_mag_16, & +#endif +#ifdef HAVE_GFC_REAL_10 + _gfortran_ieee_max_num_mag_10, & +#endif + _gfortran_ieee_max_num_mag_8, _gfortran_ieee_max_num_mag_4 + end interface + public :: IEEE_MAX_NUM_MAG + + interface + elemental real(kind=4) function _gfortran_ieee_min_num_4(X, Y) + real(kind=4), intent(in) :: X, Y + end function + elemental real(kind=8) function _gfortran_ieee_min_num_8(X, Y) + real(kind=8), intent(in) :: X, Y + end function +#ifdef HAVE_GFC_REAL_10 + elemental real(kind=10) function _gfortran_ieee_min_num_10(X, Y) + real(kind=10), intent(in) :: X, Y + end function +#endif +#ifdef HAVE_GFC_REAL_16 + elemental real(kind=16) function _gfortran_ieee_min_num_16(X, Y) + real(kind=16), intent(in) :: X, Y + end function +#endif + end interface + + interface IEEE_MIN_NUM + procedure & +#ifdef HAVE_GFC_REAL_16 + _gfortran_ieee_min_num_16, & +#endif +#ifdef HAVE_GFC_REAL_10 + _gfortran_ieee_min_num_10, & +#endif + _gfortran_ieee_min_num_8, _gfortran_ieee_min_num_4 + end interface + public :: IEEE_MIN_NUM + + interface + elemental real(kind=4) function _gfortran_ieee_min_num_mag_4(X, Y) + real(kind=4), intent(in) :: X, Y + end function + elemental real(kind=8) function _gfortran_ieee_min_num_mag_8(X, Y) + real(kind=8), intent(in) :: X, Y + end function +#ifdef HAVE_GFC_REAL_10 + elemental real(kind=10) function _gfortran_ieee_min_num_mag_10(X, Y) + real(kind=10), intent(in) :: X, Y + end function +#endif +#ifdef HAVE_GFC_REAL_16 + elemental real(kind=16) function _gfortran_ieee_min_num_mag_16(X, Y) + real(kind=16), intent(in) :: X, Y + end function +#endif + end interface + + interface IEEE_MIN_NUM_MAG + procedure & +#ifdef HAVE_GFC_REAL_16 + _gfortran_ieee_min_num_mag_16, & +#endif +#ifdef HAVE_GFC_REAL_10 + _gfortran_ieee_min_num_mag_10, & +#endif + _gfortran_ieee_min_num_mag_8, _gfortran_ieee_min_num_mag_4 + end interface + public :: IEEE_MIN_NUM_MAG + ! IEEE_COPY_SIGN #define COPYSIGN_MACRO(A,B) \