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