1! { dg-do run }
2
3  use :: ieee_arithmetic
4  implicit none
5
6  real :: sx1, sx2, sx3
7  double precision :: dx1, dx2, dx3
8  integer, parameter :: s = kind(sx1), d = kind(dx1)
9  type(ieee_round_type) :: mode
10
11  ! Test IEEE_IS_FINITE
12
13  if (ieee_support_datatype(0._s)) then
14    if (.not. ieee_is_finite(0.2_s)) call abort
15    if (.not. ieee_is_finite(-0.2_s)) call abort
16    if (.not. ieee_is_finite(0._s)) call abort
17    if (.not. ieee_is_finite(-0._s)) call abort
18    if (.not. ieee_is_finite(tiny(0._s))) call abort
19    if (.not. ieee_is_finite(tiny(0._s)/100)) call abort
20    if (.not. ieee_is_finite(huge(0._s))) call abort
21    if (.not. ieee_is_finite(-huge(0._s))) call abort
22    sx1 = huge(sx1)
23    if (ieee_is_finite(2*sx1)) call abort
24    if (ieee_is_finite(2*(-sx1))) call abort
25    sx1 = ieee_value(sx1, ieee_quiet_nan)
26    if (ieee_is_finite(sx1)) call abort
27  end if
28
29  if (ieee_support_datatype(0._d)) then
30    if (.not. ieee_is_finite(0.2_d)) call abort
31    if (.not. ieee_is_finite(-0.2_d)) call abort
32    if (.not. ieee_is_finite(0._d)) call abort
33    if (.not. ieee_is_finite(-0._d)) call abort
34    if (.not. ieee_is_finite(tiny(0._d))) call abort
35    if (.not. ieee_is_finite(tiny(0._d)/100)) call abort
36    if (.not. ieee_is_finite(huge(0._d))) call abort
37    if (.not. ieee_is_finite(-huge(0._d))) call abort
38    dx1 = huge(dx1)
39    if (ieee_is_finite(2*dx1)) call abort
40    if (ieee_is_finite(2*(-dx1))) call abort
41    dx1 = ieee_value(dx1, ieee_quiet_nan)
42    if (ieee_is_finite(dx1)) call abort
43  end if
44
45  ! Test IEEE_IS_NAN
46
47  if (ieee_support_datatype(0._s)) then
48    if (ieee_is_nan(0.2_s)) call abort
49    if (ieee_is_nan(-0.2_s)) call abort
50    if (ieee_is_nan(0._s)) call abort
51    if (ieee_is_nan(-0._s)) call abort
52    if (ieee_is_nan(tiny(0._s))) call abort
53    if (ieee_is_nan(tiny(0._s)/100)) call abort
54    if (ieee_is_nan(huge(0._s))) call abort
55    if (ieee_is_nan(-huge(0._s))) call abort
56    sx1 = huge(sx1)
57    if (ieee_is_nan(2*sx1)) call abort
58    if (ieee_is_nan(2*(-sx1))) call abort
59    sx1 = ieee_value(sx1, ieee_quiet_nan)
60    if (.not. ieee_is_nan(sx1)) call abort
61    sx1 = -1
62    if (.not. ieee_is_nan(sqrt(sx1))) call abort
63  end if
64
65  if (ieee_support_datatype(0._d)) then
66    if (ieee_is_nan(0.2_d)) call abort
67    if (ieee_is_nan(-0.2_d)) call abort
68    if (ieee_is_nan(0._d)) call abort
69    if (ieee_is_nan(-0._d)) call abort
70    if (ieee_is_nan(tiny(0._d))) call abort
71    if (ieee_is_nan(tiny(0._d)/100)) call abort
72    if (ieee_is_nan(huge(0._d))) call abort
73    if (ieee_is_nan(-huge(0._d))) call abort
74    dx1 = huge(dx1)
75    if (ieee_is_nan(2*dx1)) call abort
76    if (ieee_is_nan(2*(-dx1))) call abort
77    dx1 = ieee_value(dx1, ieee_quiet_nan)
78    if (.not. ieee_is_nan(dx1)) call abort
79    dx1 = -1
80    if (.not. ieee_is_nan(sqrt(dx1))) call abort
81  end if
82
83  ! IEEE_IS_NEGATIVE
84
85  if (ieee_support_datatype(0._s)) then
86    if (ieee_is_negative(0.2_s)) call abort
87    if (.not. ieee_is_negative(-0.2_s)) call abort
88    if (ieee_is_negative(0._s)) call abort
89    if (.not. ieee_is_negative(-0._s)) call abort
90    if (ieee_is_negative(tiny(0._s))) call abort
91    if (ieee_is_negative(tiny(0._s)/100)) call abort
92    if (.not. ieee_is_negative(-tiny(0._s))) call abort
93    if (.not. ieee_is_negative(-tiny(0._s)/100)) call abort
94    if (ieee_is_negative(huge(0._s))) call abort
95    if (.not. ieee_is_negative(-huge(0._s))) call abort
96    sx1 = huge(sx1)
97    if (ieee_is_negative(2*sx1)) call abort
98    if (.not. ieee_is_negative(2*(-sx1))) call abort
99    sx1 = ieee_value(sx1, ieee_quiet_nan)
100    if (ieee_is_negative(sx1)) call abort
101    sx1 = -1
102    if (ieee_is_negative(sqrt(sx1))) call abort
103  end if
104
105  if (ieee_support_datatype(0._d)) then
106    if (ieee_is_negative(0.2_d)) call abort
107    if (.not. ieee_is_negative(-0.2_d)) call abort
108    if (ieee_is_negative(0._d)) call abort
109    if (.not. ieee_is_negative(-0._d)) call abort
110    if (ieee_is_negative(tiny(0._d))) call abort
111    if (ieee_is_negative(tiny(0._d)/100)) call abort
112    if (.not. ieee_is_negative(-tiny(0._d))) call abort
113    if (.not. ieee_is_negative(-tiny(0._d)/100)) call abort
114    if (ieee_is_negative(huge(0._d))) call abort
115    if (.not. ieee_is_negative(-huge(0._d))) call abort
116    dx1 = huge(dx1)
117    if (ieee_is_negative(2*dx1)) call abort
118    if (.not. ieee_is_negative(2*(-dx1))) call abort
119    dx1 = ieee_value(dx1, ieee_quiet_nan)
120    if (ieee_is_negative(dx1)) call abort
121    dx1 = -1
122    if (ieee_is_negative(sqrt(dx1))) call abort
123  end if
124
125  ! Test IEEE_IS_NORMAL
126
127  if (ieee_support_datatype(0._s)) then
128    if (.not. ieee_is_normal(0.2_s)) call abort
129    if (.not. ieee_is_normal(-0.2_s)) call abort
130    if (.not. ieee_is_normal(0._s)) call abort
131    if (.not. ieee_is_normal(-0._s)) call abort
132    if (.not. ieee_is_normal(tiny(0._s))) call abort
133    if (ieee_is_normal(tiny(0._s)/100)) call abort
134    if (.not. ieee_is_normal(-tiny(0._s))) call abort
135    if (ieee_is_normal(-tiny(0._s)/100)) call abort
136    if (.not. ieee_is_normal(huge(0._s))) call abort
137    if (.not. ieee_is_normal(-huge(0._s))) call abort
138    sx1 = huge(sx1)
139    if (ieee_is_normal(2*sx1)) call abort
140    if (ieee_is_normal(2*(-sx1))) call abort
141    sx1 = ieee_value(sx1, ieee_quiet_nan)
142    if (ieee_is_normal(sx1)) call abort
143    sx1 = -1
144    if (ieee_is_normal(sqrt(sx1))) call abort
145  end if
146
147  if (ieee_support_datatype(0._d)) then
148    if (.not. ieee_is_normal(0.2_d)) call abort
149    if (.not. ieee_is_normal(-0.2_d)) call abort
150    if (.not. ieee_is_normal(0._d)) call abort
151    if (.not. ieee_is_normal(-0._d)) call abort
152    if (.not. ieee_is_normal(tiny(0._d))) call abort
153    if (ieee_is_normal(tiny(0._d)/100)) call abort
154    if (.not. ieee_is_normal(-tiny(0._d))) call abort
155    if (ieee_is_normal(-tiny(0._d)/100)) call abort
156    if (.not. ieee_is_normal(huge(0._d))) call abort
157    if (.not. ieee_is_normal(-huge(0._d))) call abort
158    dx1 = huge(dx1)
159    if (ieee_is_normal(2*dx1)) call abort
160    if (ieee_is_normal(2*(-dx1))) call abort
161    dx1 = ieee_value(dx1, ieee_quiet_nan)
162    if (ieee_is_normal(dx1)) call abort
163    dx1 = -1
164    if (ieee_is_normal(sqrt(dx1))) call abort
165  end if
166
167end
168