gcc/testsuite/gfortran.dg/nearest_3.f90

   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 !
   9 program 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
 339 end program test