gcc/testsuite/gfortran.dg/nearest_3.f90

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