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