2 ! { dg-skip-if "PR libfortran/78314" { aarch64*-*-gnu* arm*-*-gnueabi arm*-*-gnueabihf } }
4 ! This test will fail on older x86_64 glibc (< 2.20), due to this bug:
5 ! https://sourceware.org/bugzilla/show_bug.cgi?id=16198
6 ! We usually won't see it anyway, because on such systems x86_64 assembly
7 ! (libgfortran/config/fpu-387.h) is used.
12 type(ieee_status_type
) :: s1
, s2
13 logical :: flags(5), halt(5), haltworks
14 type(ieee_round_type
) :: mode
17 ! Test IEEE_GET_STATUS and IEEE_SET_STATUS
19 call ieee_set_flag(ieee_all
, .false
.)
20 call ieee_set_rounding_mode(ieee_down
)
21 call ieee_set_halting_mode(ieee_all
, .false
.)
22 haltworks
= ieee_support_halting(ieee_overflow
)
24 call ieee_get_status(s1
)
25 call ieee_set_status(s1
)
27 call ieee_get_flag(ieee_all
, flags
)
28 if (any(flags
)) STOP 1
29 call ieee_get_rounding_mode(mode
)
30 if (mode
/= ieee_down
) STOP 2
31 call ieee_get_halting_mode(ieee_all
, halt
)
34 call ieee_set_rounding_mode(ieee_to_zero
)
35 call ieee_set_flag(ieee_underflow
, .true
.)
36 call ieee_set_halting_mode(ieee_overflow
, .true
.)
39 if (.not
. ieee_is_nan(x
)) STOP 4
41 call ieee_get_status(s2
)
43 call ieee_get_flag(ieee_all
, flags
)
44 if (.not
. (all(flags
.eqv
. [.false
.,.false
.,.true
.,.true
.,.false
.]) &
45 .or
. all(flags
.eqv
. [.false
.,.false
.,.true
.,.true
.,.true
.]) &
46 .or
. all(flags
.eqv
. [.false
.,.false
.,.true
.,.false
.,.false
.]) &
47 .or
. all(flags
.eqv
. [.false
.,.false
.,.true
.,.false
.,.true
.]))) STOP 5
48 call ieee_get_rounding_mode(mode
)
49 if (mode
/= ieee_to_zero
) STOP 6
50 call ieee_get_halting_mode(ieee_all
, halt
)
51 if ((haltworks
.and
. .not
. halt(1)) .or
. any(halt(2:))) STOP 7
53 call ieee_set_status(s2
)
55 call ieee_get_flag(ieee_all
, flags
)
56 if (.not
. (all(flags
.eqv
. [.false
.,.false
.,.true
.,.true
.,.false
.]) &
57 .or
. all(flags
.eqv
. [.false
.,.false
.,.true
.,.true
.,.true
.]) &
58 .or
. all(flags
.eqv
. [.false
.,.false
.,.true
.,.false
.,.false
.]) &
59 .or
. all(flags
.eqv
. [.false
.,.false
.,.true
.,.false
.,.true
.]))) STOP 8
60 call ieee_get_rounding_mode(mode
)
61 if (mode
/= ieee_to_zero
) STOP 9
62 call ieee_get_halting_mode(ieee_all
, halt
)
63 if ((haltworks
.and
. .not
. halt(1)) .or
. any(halt(2:))) STOP 10
65 call ieee_set_status(s1
)
67 call ieee_get_flag(ieee_all
, flags
)
68 if (any(flags
)) STOP 11
69 call ieee_get_rounding_mode(mode
)
70 if (mode
/= ieee_down
) STOP 12
71 call ieee_get_halting_mode(ieee_all
, halt
)
72 if (any(halt
)) STOP 13
74 call ieee_set_status(s2
)
76 call ieee_get_flag(ieee_all
, flags
)
77 if (.not
. (all(flags
.eqv
. [.false
.,.false
.,.true
.,.true
.,.false
.]) &
78 .or
. all(flags
.eqv
. [.false
.,.false
.,.true
.,.true
.,.true
.]) &
79 .or
. all(flags
.eqv
. [.false
.,.false
.,.true
.,.false
.,.false
.]) &
80 .or
. all(flags
.eqv
. [.false
.,.false
.,.true
.,.false
.,.true
.]))) STOP 14
81 call ieee_get_rounding_mode(mode
)
82 if (mode
/= ieee_to_zero
) STOP 15
83 call ieee_get_halting_mode(ieee_all
, halt
)
84 if ((haltworks
.and
. .not
. halt(1)) .or
. any(halt(2:))) STOP 16