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