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)
   8   call test_real8(0)
   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(x)
  14   real x,y,t
  15   integer p
  16   p = 24
  17   y = 2.0 ** (exponent (x) - p)
  18   t = tiny(x)
  19   x = spacing(x)
  20   if ((abs (x - y) .gt. abs(x * 1e-6)) &
  21     .and. (abs (x - t) .gt. abs(x * 1e-6)))call abort
  22 end
  23
  24 subroutine test_real8(x)
  25   real*8 x,y,t
  26   integer p
  27   p = 53
  28   y = 2.0 ** (exponent (x) - p)
  29   t = tiny (x)
  30   x = spacing(x)
  31   if ((abs (x - y) .gt. abs(x * 1e-6)) &
  32     .and. (abs (x - t) .gt. abs(x * 1e-6)))call abort
  33 end