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

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