URL
https://opencores.org/ocsvn/openrisc_me/openrisc_me/trunk
Subversion Repositories openrisc_me
[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [intrinsic_spacing.f90] - Rev 303
Compare with Previous | Blame | View Log
!Program to test SPACING intrinsic function.
program test_spacing
call test_real4(3.0)
call test_real4(33.0)
call test_real4(-3.)
call test_real4(0.0)
call test_real8(0.0_8)
call test_real8(3.0_8)
call test_real8(33.0_8)
call test_real8(-33._8)
end
subroutine test_real4(orig)
real x,y,t,orig
integer p
x = orig
p = 24
y = 2.0 ** (exponent (x) - p)
t = tiny(x)
x = spacing(x)
if ((abs (x - y) .gt. abs(x * 1e-6)) &
.and. (abs (x - t) .gt. abs(x * 1e-6)))call abort
end
subroutine test_real8(orig)
real*8 x,y,t,orig
integer p
x = orig
p = 53
y = 2.0 ** (exponent (x) - p)
t = tiny (x)
x = spacing(x)
if ((abs (x - y) .gt. abs(x * 1e-6)) &
.and. (abs (x - t) .gt. abs(x * 1e-6)))call abort
end