2 ! { dg-additional-options "-ffree-line-length-none" }
4 ! Use dg-additional-options rather than dg-options to avoid overwriting the
5 ! default IEEE options which are passed by ieee.exp and necessary.
7 use ieee_features, only : ieee_datatype, ieee_denormal, ieee_divide, &
8 ieee_halting, ieee_inexact_flag, ieee_inf, ieee_invalid_flag, &
9 ieee_nan, ieee_rounding, ieee_sqrt, ieee_underflow_flag
15 procedure use_real_4, use_real_8
16 end interface use_real
18 type(ieee_flag_type), parameter :: x(5) = &
19 [ IEEE_INVALID, IEEE_OVERFLOW, IEEE_DIVIDE_BY_ZERO, &
20 IEEE_UNDERFLOW, IEEE_INEXACT ]
21 logical :: l(5) = .false.
24 #define FLAGS_STRING(S) \
25 call ieee_get_flag(x, l) ; \
26 write(S,"(5(A1))") merge(["I","O","Z","U","P"],[" "," "," "," "," "],l)
28 #define CHECK_FLAGS(expected) \
30 if (s /= expected) then ; \
31 write (*,"(A,I0,A,A)") "Flags at line ", __LINE__, ": ", s ; \
37 double precision :: dx
39 ! This file tests IEEE_SET_FLAG and IEEE_GET_FLAG
43 ! Initial flags are all off
46 ! Check we can clear them
47 call ieee_set_flag(ieee_all, .false.)
50 ! Raise invalid, then clear
56 call ieee_set_flag(ieee_all, .false.)
59 ! Raise overflow and precision
66 ! Also raise divide-by-zero
73 call ieee_set_flag([ieee_overflow,ieee_inexact,&
74 ieee_divide_by_zero],[.false.,.false.,.true.])
76 call ieee_set_flag(ieee_divide_by_zero, .false.)
87 call ieee_set_flag(ieee_all, .true.)
91 call ieee_set_flag(ieee_all, .false.)
96 ! Initial flags are all off
99 ! Check we can clear them
100 call ieee_set_flag(ieee_all, .false.)
103 ! Raise invalid, then clear
109 call ieee_set_flag(ieee_all, .false.)
112 ! Raise overflow and precision
119 ! Also raise divide-by-zero
126 call ieee_set_flag([ieee_overflow,ieee_inexact,&
127 ieee_divide_by_zero],[.false.,.false.,.true.])
129 call ieee_set_flag(ieee_divide_by_zero, .false.)
140 call ieee_set_flag(ieee_all, .true.)
144 call ieee_set_flag(ieee_all, .false.)
149 subroutine check_flag_sub
151 logical :: l(5) = .false.
152 type(ieee_flag_type), parameter :: x(5) = &
153 [ IEEE_INVALID, IEEE_OVERFLOW, IEEE_DIVIDE_BY_ZERO, &
154 IEEE_UNDERFLOW, IEEE_INEXACT ]
155 call ieee_get_flag(x, l)
158 print *, "Flags not cleared in subroutine"
163 ! Interface to a routine that avoids calculations to be optimized out,
164 ! making it appear that we use the result
165 subroutine use_real_4(x)
167 if (x == 123456.789) print *, "toto"
169 subroutine use_real_8(x)
170 double precision :: x
171 if (x == 123456.789) print *, "toto"