gcc/testsuite/gfortran.dg/nearest_3.f90

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