1! { dg-do run } 2! { dg-additional-options "-fno-range-check" } 3! 4! Check handling of special values by FRACTION, EXPONENT, 5! SPACING, RRSPACING and SET_EXPONENT. 6 7program test 8 implicit none 9 real, parameter :: inf = 2 * huge(0.) 10 real, parameter :: nan = 0. / 0. 11 12 real, volatile :: x 13 14 x = 0. 15 call check_positive_zero(fraction(x)) 16 if (exponent(x) /= 0) call abort 17 if (spacing(x) /= spacing(tiny(x))) call abort 18 call check_positive_zero(rrspacing(x)) 19 call check_positive_zero(set_exponent(x,42)) 20 21 x = -0. 22 call check_negative_zero(fraction(x)) 23 if (exponent(x) /= 0) call abort 24 if (spacing(x) /= spacing(tiny(x))) call abort 25 call check_positive_zero(rrspacing(x)) 26 call check_negative_zero(set_exponent(x,42)) 27 28 x = inf 29 if (.not. isnan(fraction(x))) call abort 30 if (exponent(x) /= huge(0)) call abort 31 if (.not. isnan(spacing(x))) call abort 32 if (.not. isnan(rrspacing(x))) call abort 33 if (.not. isnan(set_exponent(x, 42))) call abort 34 35 x = -inf 36 if (.not. isnan(fraction(x))) call abort 37 if (exponent(x) /= huge(0)) call abort 38 if (.not. isnan(spacing(x))) call abort 39 if (.not. isnan(rrspacing(x))) call abort 40 if (.not. isnan(set_exponent(x, 42))) call abort 41 42 x = nan 43 if (.not. isnan(fraction(x))) call abort 44 if (exponent(x) /= huge(0)) call abort 45 if (.not. isnan(spacing(x))) call abort 46 if (.not. isnan(rrspacing(x))) call abort 47 if (.not. isnan(set_exponent(x, 42))) call abort 48 49contains 50 51 subroutine check_positive_zero(x) 52 use ieee_arithmetic 53 implicit none 54 real, value :: x 55 56 if (ieee_class (x) /= ieee_positive_zero) call abort 57 end 58 59 subroutine check_negative_zero(x) 60 use ieee_arithmetic 61 implicit none 62 real, value :: x 63 64 if (ieee_class (x) /= ieee_negative_zero) call abort 65 end 66 67end 68