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