gcc/testsuite/gfortran.dg/nearest_2.f90

   1 ! { dg-do run }
   2 ! { dg-options "-fno-range-check" }
   3 ! { dg-add-options ieee }
   4 !
   5 ! PR fortran/34192
   6 !
   7 ! Test compile-time implementation of NEAREST
   8 !
   9 program test
  10   implicit none
  11
  12 ! Single precision
  13
  14   ! 0+ > 0
  15   if (nearest(0.0, 1.0) &
  16       <= 0.0) &
  17     call abort()
  18   ! 0++ > 0+
  19   if (nearest(nearest(0.0, 1.0), 1.0) &
  20       <= nearest(0.0, 1.0)) &
  21     call abort()
  22   ! 0+++ > 0++
  23   if (nearest(nearest(nearest(0.0, 1.0), 1.0), 1.0) &
  24       <= nearest(nearest(0.0, 1.0), 1.0)) &
  25     call abort()
  26   ! 0+- = 0
  27   if (nearest(nearest(0.0, 1.0), -1.0) &
  28       /= 0.0) &
  29     call abort()
  30   ! 0++- = 0+
  31   if (nearest(nearest(nearest(0.0, 1.0), 1.0), -1.0) &
  32       /= nearest(0.0, 1.0)) &
  33     call abort()
  34   ! 0++-- = 0
  35   if (nearest(nearest(nearest(nearest(0.0, 1.0), 1.0), -1.0), -1.0) &
  36       /= 0.0) &
  37     call abort()
  38
  39   ! 0- < 0
  40   if (nearest(0.0, -1.0) &
  41       >= 0.0) &
  42     call abort()
  43   ! 0-- < 0+
  44   if (nearest(nearest(0.0, -1.0), -1.0) &
  45       >= nearest(0.0, -1.0)) &
  46     call abort()
  47   ! 0--- < 0--
  48   if (nearest(nearest(nearest(0.0, -1.0), -1.0), -1.0) &
  49       >= nearest(nearest(0.0, -1.0), -1.0)) &
  50     call abort()
  51   ! 0-+ = 0
  52   if (nearest(nearest(0.0, -1.0), 1.0) &
  53       /= 0.0) &
  54     call abort()
  55   ! 0--+ = 0-
  56   if (nearest(nearest(nearest(0.0, -1.0), -1.0), 1.0) &
  57       /= nearest(0.0, -1.0)) &
  58     call abort()
  59   ! 0--++ = 0
  60   if (nearest(nearest(nearest(nearest(0.0, -1.0), -1.0), 1.0), 1.0) &
  61       /= 0.0) &
  62     call abort()
  63
  64   ! 42++ > 42+
  65   if (nearest(nearest(42.0, 1.0), 1.0) &
  66       <= nearest(42.0, 1.0)) &
  67     call abort()
  68   ! 42-- < 42-
  69   if (nearest(nearest(42.0, -1.0), -1.0) &
  70       >= nearest(42.0, -1.0)) &
  71     call abort()
  72   ! 42-+ = 42
  73   if (nearest(nearest(42.0, -1.0), 1.0) &
  74       /= 42.0) &
  75     call abort()
  76   ! 42+- = 42
  77   if (nearest(nearest(42.0, 1.0), -1.0) &
  78       /= 42.0) &
  79     call abort()
  80
  81   ! INF+ = INF
  82   if (nearest(1.0/0.0, 1.0) /= 1.0/0.0) call abort()
  83   ! -INF- = -INF
  84   if (nearest(-1.0/0.0, -1.0) /= -1.0/0.0) call abort()
  85   ! NAN- = NAN
  86   if (.not.isnan(nearest(0.0d0/0.0,  1.0))) call abort()
  87   ! NAN+ = NAN
  88   if (.not.isnan(nearest(0.0d0/0.0, -1.0))) call abort()
  89
  90 ! Double precision
  91
  92   ! 0+ > 0
  93   if (nearest(0.0d0, 1.0) &
  94       <= 0.0d0) &
  95     call abort()
  96   ! 0++ > 0+
  97   if (nearest(nearest(0.0d0, 1.0), 1.0) &
  98       <= nearest(0.0d0, 1.0)) &
  99     call abort()
 100   ! 0+++ > 0++
 101   if (nearest(nearest(nearest(0.0d0, 1.0), 1.0), 1.0) &
 102       <= nearest(nearest(0.0d0, 1.0), 1.0)) &
 103     call abort()
 104   ! 0+- = 0
 105   if (nearest(nearest(0.0d0, 1.0), -1.0) &
 106       /= 0.0d0) &
 107     call abort()
 108   ! 0++- = 0+
 109   if (nearest(nearest(nearest(0.0d0, 1.0), 1.0), -1.0) &
 110       /= nearest(0.0d0, 1.0)) &
 111     call abort()
 112   ! 0++-- = 0
 113   if (nearest(nearest(nearest(nearest(0.0d0, 1.0), 1.0), -1.0), -1.0) &
 114       /= 0.0d0) &
 115     call abort()
 116
 117   ! 0- < 0
 118   if (nearest(0.0d0, -1.0) &
 119       >= 0.0d0) &
 120     call abort()
 121   ! 0-- < 0+
 122   if (nearest(nearest(0.0d0, -1.0), -1.0) &
 123       >= nearest(0.0d0, -1.0)) &
 124     call abort()
 125   ! 0--- < 0--
 126   if (nearest(nearest(nearest(0.0d0, -1.0), -1.0), -1.0) &
 127       >= nearest(nearest(0.0d0, -1.0), -1.0)) &
 128     call abort()
 129   ! 0-+ = 0
 130   if (nearest(nearest(0.0d0, -1.0), 1.0) &
 131       /= 0.0d0) &
 132     call abort()
 133   ! 0--+ = 0-
 134   if (nearest(nearest(nearest(0.0d0, -1.0), -1.0), 1.0) &
 135       /= nearest(0.0d0, -1.0)) &
 136     call abort()
 137   ! 0--++ = 0
 138   if (nearest(nearest(nearest(nearest(0.0d0, -1.0), -1.0), 1.0), 1.0) &
 139       /= 0.0d0) &
 140     call abort()
 141
 142   ! 42++ > 42+
 143   if (nearest(nearest(42.0d0, 1.0), 1.0) &
 144       <= nearest(42.0d0, 1.0)) &
 145     call abort()
 146   ! 42-- < 42-
 147   if (nearest(nearest(42.0d0, -1.0), -1.0) &
 148       >= nearest(42.0d0, -1.0)) &
 149     call abort()
 150   ! 42-+ = 42
 151   if (nearest(nearest(42.0d0, -1.0), 1.0) &
 152       /= 42.0d0) &
 153     call abort()
 154   ! 42+- = 42
 155   if (nearest(nearest(42.0d0, 1.0), -1.0) &
 156       /= 42.0d0) &
 157     call abort()
 158
 159   ! INF+ = INF
 160   if (nearest(1.0d0/0.0d0, 1.0) /= 1.0d0/0.0d0) call abort()
 161   ! -INF- = -INF
 162   if (nearest(-1.0d0/0.0d0, -1.0) /= -1.0d0/0.0d0) call abort()
 163   ! NAN- = NAN
 164   if (.not.isnan(nearest(0.0d0/0.0,  1.0))) call abort()
 165   ! NAN+ = NAN
 166   if (.not.isnan(nearest(0.0d0/0.0, -1.0))) call abort()
 167 end program test