gomp-20050608-branch/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_rrspacing.f90

   1 !Program to test RRSPACING intrinsic function.
   2
   3 program test_rrspacing
   4   call test_real4(3.0)
   5   call test_real4(33.0)
   6   call test_real4(-3.0)
   7   call test_real8(3.0_8)
   8   call test_real8(33.0_8)
   9   call test_real8(-33.0_8)
  10 end
  11 subroutine test_real4(orig)
  12   real x,y,orig
  13   integer p
  14   x = orig
  15   p = 24
  16   y = abs (x * 2.0 ** (- exponent (x))) * (2.0 ** p)
  17   x = rrspacing(x)
  18   if (abs (x - y) .gt. abs(x * 1e-6)) call abort
  19 end
  20
  21 subroutine test_real8(orig)
  22   real*8 x,y,t,orig
  23   integer p
  24   x = orig
  25   p = 53
  26   y = abs (x * 2.0 ** (- exponent (x))) * (2.0 ** p)
  27   x = rrspacing(x)
  28   if (abs (x - y) .gt. abs(x * 1e-6)) call abort
  29 end