Subversion Repositories openrisc

!Program to test NEAREST intrinsic function.

program test_nearest

  real s, r, x, y, inf, max

  integer i, infi, maxi

  equivalence (s,i)

  equivalence (inf,infi)

  equivalence (max,maxi)

  r = 2.0

  s = 3.0

  call test_n (s, r)

  i = z'00800000'

  call test_n (s, r)

  i = z'007fffff'

  call test_n (s, r)

  i = z'00800100'

  call test_n (s, r)

  s = 0

  x = nearest(s, r)

  y = nearest(s, -r)

  if (.not. (x .gt. s .and. y .lt. s )) call abort()

! ??? This is pretty sketchy, but passes on most targets.

  infi = z'7f800000'

  maxi = z'7f7fffff'

  call test_up(max, inf)

  call test_up(-inf, -max)

  call test_down(inf, max)

  call test_down(-max, -inf)

! ??? Here we require the F2003 IEEE_ARITHMETIC module to

! determine if denormals are supported.  If they are, then

! nearest(0,1) is the minimum denormal.  If they are not,

! then it's the minimum normalized number, TINY.  This fails

! much more often than the infinity test above, so it's

! disabled for now.

! call test_up(0, min)

! call test_up(-min, 0)

! call test_down(0, -min)

! call test_down(min, 0)

end

subroutine test_up(s, e)

  real s, e, x

  x = nearest(s, 1.0)

  if (x .ne. e) call abort()

end

subroutine test_down(s, e)

  real s, e, x

  x = nearest(s, -1.0)

  if (x .ne. e) call abort()

end

subroutine test_n(s1, r)

  real r, s1, x

  x = nearest(s1, r)

  if (nearest(x, -r) .ne. s1) call abort()

  x = nearest(s1, -r)

  if (nearest(x, r) .ne. s1) call abort()

  s1 = -s1

  x = nearest(s1, r)

  if (nearest(x, -r) .ne. s1) call abort()

  x = nearest(s1, -r)

  if (nearest(x, r) .ne. s1) call abort()

end