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