gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_nearest.f90

   1 !Program to test NEAREST intrinsic function.
   2
   3 program test_nearest
   4   real s, r, x, y, inf, max, min
   5   integer i, infi, maxi, mini
   6   equivalence (s,i)
   7   equivalence (inf,infi)
   8   equivalence (max,maxi)
   9   equivalence (min,mini)
  10
  11   r = 2.0
  12   s = 3.0
  13   call test_n (s, r)
  14
  15   i = z'00800000'
  16   call test_n (s, r)
  17
  18   i = z'007fffff'
  19   call test_n (s, r)
  20
  21   i = z'00800100'
  22   call test_n (s, r)
  23
  24   s = 0
  25   x = nearest(s, r)
  26   y = nearest(s, -r)
  27   if (.not. (x .gt. s .and. y .lt. s )) call abort()
  28
  29   infi = z'7f800000'
  30   maxi = z'7f7fffff'
  31   mini = 1
  32
  33   call test_up(max, inf)
  34   call test_up(-inf, -max)
  35   call test_up(0, min)
  36   call test_up(-min, 0)
  37
  38   call test_down(inf, max)
  39   call test_down(-max, -inf)
  40   call test_down(0, -min)
  41   call test_down(min, 0)
  42 end
  43
  44 subroutine test_up(s, e)
  45   real s, e, x
  46
  47   x = nearest(s, 1.0)
  48   if (x .ne. e) call abort()
  49 end
  50
  51 subroutine test_down(s, e)
  52   real s, e, x
  53
  54   x = nearest(s, -1.0)
  55   if (x .ne. e) call abort()
  56 end
  57
  58 subroutine test_n(s1, r)
  59   real r, s1, x
  60
  61   x = nearest(s1, r)
  62   if (nearest(x, -r) .ne. s1) call abort()
  63   x = nearest(s1, -r)
  64   if (nearest(x, r) .ne. s1) call abort()
  65
  66   s1 = -s1
  67   x = nearest(s1, r)
  68   if (nearest(x, -r) .ne. s1) call abort()
  69   x = nearest(s1, -r)
  70   if (nearest(x, r) .ne. s1) call abort()
  71 end