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(x)
  12   real x,y
  13   integer p
  14   p = 24
  15   y = abs (x * 2.0 ** (- exponent (x))) * (2.0 ** p)
  16   x = rrspacing(x)
  17   if (abs (x - y) .gt. abs(x * 1e-6)) call abort
  18 end
  19
  20 subroutine test_real8(x)
  21   real*8 x,y,t
  22   integer p
  23   p = 53
  24   y = abs (x * 2.0 ** (- exponent (x))) * (2.0 ** p)
  25   x = rrspacing(x)
  26   if (abs (x - y) .gt. abs(x * 1e-6)) call abort
  27 end