OpenCores
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_aint_anint.f90] - Blame information for rev 303

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 303 jeremybenn
! Program to test AINT and ANINT intrinsics
2
 
3
subroutine real4test (op, res1, res2)
4
   implicit none
5
   real(kind=4) :: op
6
   real(kind=4) :: res1, res2
7
 
8
   if (diff(aint(op), res1) .or. &
9
       diff(anint(op), res2)) call abort
10
contains
11
function diff(a, b)
12
  real(kind=4) :: a, b
13
  logical diff
14
 
15
  diff = (abs (a - b) .gt. abs(a * 1e-6))
16
end function
17
end subroutine
18
 
19
subroutine real8test (op, res1, res2)
20
   implicit none
21
   real(kind=8) :: op
22
   real(kind=8) :: res1, res2
23
 
24
   if (diff(aint(op), res1) .or. &
25
       diff(anint(op), res2)) call abort
26
contains
27
function diff(a, b)
28
  real(kind=8) :: a, b
29
  logical diff
30
 
31
  diff = (abs(a - b) .gt. abs(a * 1e-6))
32
end function
33
end subroutine
34
 
35
program aint_aninttest
36
   implicit none
37
 
38
   call real4test (3.456, 3.0, 3.0)
39
   call real4test (-2.798, -2.0, -3.0)
40
   call real4test (3.678, 3.0, 4.0)
41
   call real4test (-1.375, -1.0, -1.0)
42
   call real4test (-0.5, 0.0,-1.0)
43
   call real4test (0.4, 0.0,0.0)
44
 
45
   call real8test (3.456_8, 3.0_8, 3.0_8)
46
   call real8test (-2.798_8, -2.0_8, -3.0_8)
47
   call real8test (3.678_8, 3.0_8, 4.0_8)
48
   call real8test (-1.375_8, -1.0_8, -1.0_8)
49
   call real8test (-0.5_8, 0.0_8,-1.0_8)
50
   call real8test (0.4_8, 0.0_8,0.0_8)
51
 
52
   ! Check large numbers
53
   call real4test (2e34, 2e34, 2e34)
54
   call real4test (-2e34, -2e34, -2e34)
55
end program

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.