1! { dg-do run }
2! { dg-add-options ieee }
3! { dg-skip-if "NaN not supported" { spu-*-* } { "*" } { "" } }
4!
5! PR fortran/34209
6!
7! Test run-time implementation of NEAREST
8!
9program test
10  implicit none
11  real(4), volatile :: r4
12  real(8), volatile :: r8
13
14! Single precision with single-precision sign
15
16  r4 = 0.0_4
17  ! 0+ > 0
18  if (nearest(r4, 1.0) &
19      <= r4) &
20    call abort()
21  ! 0++ > 0+
22  if (nearest(nearest(r4, 1.0), 1.0) &
23      <= nearest(r4, 1.0)) &
24    call abort()
25  ! 0+++ > 0++
26  if (nearest(nearest(nearest(r4, 1.0), 1.0), 1.0) &
27      <= nearest(nearest(r4, 1.0), 1.0)) &
28    call abort()
29  ! 0+- = 0
30  if (nearest(nearest(r4, 1.0), -1.0) &
31      /= r4) &
32    call abort()
33  ! 0++- = 0+
34  if (nearest(nearest(nearest(r4, 1.0), 1.0), -1.0) &
35      /= nearest(r4, 1.0)) &
36    call abort()
37  ! 0++-- = 0
38  if (nearest(nearest(nearest(nearest(r4, 1.0), 1.0), -1.0), -1.0) &
39      /= r4) &
40    call abort()
41
42  ! 0- < 0
43  if (nearest(r4, -1.0) &
44      >= r4) &
45    call abort()
46  ! 0-- < 0+
47  if (nearest(nearest(r4, -1.0), -1.0) &
48      >= nearest(r4, -1.0)) &
49    call abort()
50  ! 0--- < 0--
51  if (nearest(nearest(nearest(r4, -1.0), -1.0), -1.0) &
52      >= nearest(nearest(r4, -1.0), -1.0)) &
53    call abort()
54  ! 0-+ = 0
55  if (nearest(nearest(r4, -1.0), 1.0) &
56      /= r4) &
57    call abort()
58  ! 0--+ = 0-
59  if (nearest(nearest(nearest(r4, -1.0), -1.0), 1.0) &
60      /= nearest(r4, -1.0)) &
61    call abort()
62  ! 0--++ = 0
63  if (nearest(nearest(nearest(nearest(r4, -1.0), -1.0), 1.0), 1.0) &
64      /= r4) &
65    call abort()
66
67  r4 = 42.0_4
68  ! 42++ > 42+
69  if (nearest(nearest(r4, 1.0), 1.0) &
70      <= nearest(r4, 1.0)) &
71    call abort()
72  ! 42-- < 42-
73  if (nearest(nearest(r4, -1.0), -1.0) &
74      >= nearest(r4, -1.0)) &
75    call abort()
76  ! 42-+ = 42
77  if (nearest(nearest(r4, -1.0), 1.0) &
78      /= r4) &
79    call abort()
80  ! 42+- = 42
81  if (nearest(nearest(r4, 1.0), -1.0) &
82      /= r4) &
83    call abort()
84
85  r4 = 0.0
86  ! INF+ = INF
87  if (nearest(1.0/r4, 1.0) /= 1.0/r4) call abort()
88  ! -INF- = -INF
89  if (nearest(-1.0/r4, -1.0) /= -1.0/r4) call abort()
90  ! NAN- = NAN
91  if (.not.isnan(nearest(0.0/r4,  1.0))) call abort()
92  ! NAN+ = NAN
93  if (.not.isnan(nearest(0.0/r4, -1.0))) call abort()
94
95! Double precision with single-precision sign
96
97  r8 = 0.0_8
98  ! 0+ > 0
99  if (nearest(r8, 1.0) &
100      <= r8) &
101    call abort()
102  ! 0++ > 0+
103  if (nearest(nearest(r8, 1.0), 1.0) &
104      <= nearest(r8, 1.0)) &
105    call abort()
106  ! 0+++ > 0++
107  if (nearest(nearest(nearest(r8, 1.0), 1.0), 1.0) &
108      <= nearest(nearest(r8, 1.0), 1.0)) &
109    call abort()
110  ! 0+- = 0
111  if (nearest(nearest(r8, 1.0), -1.0) &
112      /= r8) &
113    call abort()
114  ! 0++- = 0+
115  if (nearest(nearest(nearest(r8, 1.0), 1.0), -1.0) &
116      /= nearest(r8, 1.0)) &
117    call abort()
118  ! 0++-- = 0
119  if (nearest(nearest(nearest(nearest(r8, 1.0), 1.0), -1.0), -1.0) &
120      /= r8) &
121    call abort()
122
123  ! 0- < 0
124  if (nearest(r8, -1.0) &
125      >= r8) &
126    call abort()
127  ! 0-- < 0+
128  if (nearest(nearest(r8, -1.0), -1.0) &
129      >= nearest(r8, -1.0)) &
130    call abort()
131  ! 0--- < 0--
132  if (nearest(nearest(nearest(r8, -1.0), -1.0), -1.0) &
133      >= nearest(nearest(r8, -1.0), -1.0)) &
134    call abort()
135  ! 0-+ = 0
136  if (nearest(nearest(r8, -1.0), 1.0) &
137      /= r8) &
138    call abort()
139  ! 0--+ = 0-
140  if (nearest(nearest(nearest(r8, -1.0), -1.0), 1.0) &
141      /= nearest(r8, -1.0)) &
142    call abort()
143  ! 0--++ = 0
144  if (nearest(nearest(nearest(nearest(r8, -1.0), -1.0), 1.0), 1.0) &
145      /= r8) &
146    call abort()
147
148  r8 = 42.0_8
149  ! 42++ > 42+
150  if (nearest(nearest(r8, 1.0), 1.0) &
151      <= nearest(r8, 1.0)) &
152    call abort()
153  ! 42-- < 42-
154  if (nearest(nearest(r8, -1.0), -1.0) &
155      >= nearest(r8, -1.0)) &
156    call abort()
157  ! 42-+ = 42
158  if (nearest(nearest(r8, -1.0), 1.0) &
159      /= r8) &
160    call abort()
161  ! 42+- = 42
162  if (nearest(nearest(r8, 1.0), -1.0) &
163      /= r8) &
164    call abort()
165
166  r4 = 0.0
167  ! INF+ = INF
168  if (nearest(1.0/r4, 1.0) /= 1.0/r4) call abort()
169  ! -INF- = -INF
170  if (nearest(-1.0/r4, -1.0) /= -1.0/r4) call abort()
171  ! NAN- = NAN
172  if (.not.isnan(nearest(0.0/r4,  1.0))) call abort()
173  ! NAN+ = NAN
174  if (.not.isnan(nearest(0.0/r4, -1.0))) call abort()
175
176
177! Single precision with double-precision sign
178
179  r4 = 0.0_4
180  ! 0+ > 0
181  if (nearest(r4, 1.0d0) &
182      <= r4) &
183    call abort()
184  ! 0++ > 0+
185  if (nearest(nearest(r4, 1.0d0), 1.0d0) &
186      <= nearest(r4, 1.0d0)) &
187    call abort()
188  ! 0+++ > 0++
189  if (nearest(nearest(nearest(r4, 1.0d0), 1.0d0), 1.0d0) &
190      <= nearest(nearest(r4, 1.0d0), 1.0d0)) &
191    call abort()
192  ! 0+- = 0
193  if (nearest(nearest(r4, 1.0d0), -1.0d0) &
194      /= r4) &
195    call abort()
196  ! 0++- = 0+
197  if (nearest(nearest(nearest(r4, 1.0d0), 1.0d0), -1.0d0) &
198      /= nearest(r4, 1.0d0)) &
199    call abort()
200  ! 0++-- = 0
201  if (nearest(nearest(nearest(nearest(r4, 1.0d0), 1.0d0), -1.0d0), -1.0d0) &
202      /= r4) &
203    call abort()
204
205  ! 0- < 0
206  if (nearest(r4, -1.0d0) &
207      >= r4) &
208    call abort()
209  ! 0-- < 0+
210  if (nearest(nearest(r4, -1.0d0), -1.0d0) &
211      >= nearest(r4, -1.0d0)) &
212    call abort()
213  ! 0--- < 0--
214  if (nearest(nearest(nearest(r4, -1.0d0), -1.0d0), -1.0d0) &
215      >= nearest(nearest(r4, -1.0d0), -1.0d0)) &
216    call abort()
217  ! 0-+ = 0
218  if (nearest(nearest(r4, -1.0d0), 1.0d0) &
219      /= r4) &
220    call abort()
221  ! 0--+ = 0-
222  if (nearest(nearest(nearest(r4, -1.0d0), -1.0d0), 1.0d0) &
223      /= nearest(r4, -1.0d0)) &
224    call abort()
225  ! 0--++ = 0
226  if (nearest(nearest(nearest(nearest(r4, -1.0d0), -1.0d0), 1.0d0), 1.0d0) &
227      /= r4) &
228    call abort()
229
230  r4 = 42.0_4
231  ! 42++ > 42+
232  if (nearest(nearest(r4, 1.0d0), 1.0d0) &
233      <= nearest(r4, 1.0d0)) &
234    call abort()
235  ! 42-- < 42-
236  if (nearest(nearest(r4, -1.0d0), -1.0d0) &
237      >= nearest(r4, -1.0d0)) &
238    call abort()
239  ! 42-+ = 42
240  if (nearest(nearest(r4, -1.0d0), 1.0d0) &
241      /= r4) &
242    call abort()
243  ! 42+- = 42
244  if (nearest(nearest(r4, 1.0d0), -1.0d0) &
245      /= r4) &
246    call abort()
247
248  r4 = 0.0
249  ! INF+ = INF
250  if (nearest(1.0d0/r4, 1.0d0) /= 1.0d0/r4) call abort()
251  ! -INF- = -INF
252  if (nearest(-1.0d0/r4, -1.0d0) /= -1.0d0/r4) call abort()
253  ! NAN- = NAN
254  if (.not.isnan(nearest(0.0/r4,  1.0d0))) call abort()
255  ! NAN+ = NAN
256  if (.not.isnan(nearest(0.0/r4, -1.0d0))) call abort()
257
258! Double precision with double-precision sign
259
260  r8 = 0.0_8
261  ! 0+ > 0
262  if (nearest(r8, 1.0d0) &
263      <= r8) &
264    call abort()
265  ! 0++ > 0+
266  if (nearest(nearest(r8, 1.0d0), 1.0d0) &
267      <= nearest(r8, 1.0d0)) &
268    call abort()
269  ! 0+++ > 0++
270  if (nearest(nearest(nearest(r8, 1.0d0), 1.0d0), 1.0d0) &
271      <= nearest(nearest(r8, 1.0d0), 1.0d0)) &
272    call abort()
273  ! 0+- = 0
274  if (nearest(nearest(r8, 1.0d0), -1.0d0) &
275      /= r8) &
276    call abort()
277  ! 0++- = 0+
278  if (nearest(nearest(nearest(r8, 1.0d0), 1.0d0), -1.0d0) &
279      /= nearest(r8, 1.0d0)) &
280    call abort()
281  ! 0++-- = 0
282  if (nearest(nearest(nearest(nearest(r8, 1.0d0), 1.0d0), -1.0d0), -1.0d0) &
283      /= r8) &
284    call abort()
285
286  ! 0- < 0
287  if (nearest(r8, -1.0d0) &
288      >= r8) &
289    call abort()
290  ! 0-- < 0+
291  if (nearest(nearest(r8, -1.0d0), -1.0d0) &
292      >= nearest(r8, -1.0d0)) &
293    call abort()
294  ! 0--- < 0--
295  if (nearest(nearest(nearest(r8, -1.0d0), -1.0d0), -1.0d0) &
296      >= nearest(nearest(r8, -1.0d0), -1.0d0)) &
297    call abort()
298  ! 0-+ = 0
299  if (nearest(nearest(r8, -1.0d0), 1.0d0) &
300      /= r8) &
301    call abort()
302  ! 0--+ = 0-
303  if (nearest(nearest(nearest(r8, -1.0d0), -1.0d0), 1.0d0) &
304      /= nearest(r8, -1.0d0)) &
305    call abort()
306  ! 0--++ = 0
307  if (nearest(nearest(nearest(nearest(r8, -1.0d0), -1.0d0), 1.0d0), 1.0d0) &
308      /= r8) &
309    call abort()
310
311  r8 = 42.0_8
312  ! 42++ > 42+
313  if (nearest(nearest(r8, 1.0d0), 1.0d0) &
314      <= nearest(r8, 1.0d0)) &
315    call abort()
316  ! 42-- < 42-
317  if (nearest(nearest(r8, -1.0d0), -1.0d0) &
318      >= nearest(r8, -1.0d0)) &
319    call abort()
320  ! 42-+ = 42
321  if (nearest(nearest(r8, -1.0d0), 1.0d0) &
322      /= r8) &
323    call abort()
324  ! 42+- = 42
325  if (nearest(nearest(r8, 1.0d0), -1.0d0) &
326      /= r8) &
327    call abort()
328
329  r4 = 0.0
330  ! INF+ = INF
331  if (nearest(1.0d0/r4, 1.0d0) /= 1.0d0/r4) call abort()
332  ! -INF- = -INF
333  if (nearest(-1.0d0/r4, -1.0d0) /= -1.0d0/r4) call abort()
334  ! NAN- = NAN
335  if (.not.isnan(nearest(0.0/r4,  1.0d0))) call abort()
336  ! NAN+ = NAN
337  if (.not.isnan(nearest(0.0/r4, -1.0d0))) call abort()
338
339end program test
340