summaryrefslogtreecommitdiff
path: root/gcc/testsuite/gfortran.fortran-torture/execute/intrinsic_nearest.f90
blob: 364a3ac345ee094ce7f24d75284e63c440dee181 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
!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