URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [default_format_1.inc] - Blame information for rev 694

Details | Compare with Previous | View Log


module test_default_format
  interface test
    module procedure test_r4
    module procedure test_r8
  end interface test
 
  integer, parameter :: count = 200
 
contains
  function test_r4 (start, towards) result (res)
    integer, parameter :: k = 4
    integer, intent(in) :: towards
    real(k), intent(in) :: start
 
    integer :: res, i
    real(k) :: x, y
    character(len=100) :: s
 
    res = 0
 
    if (towards >= 0) then
      x = start
      do i = 0, count
        write (s,*) x
        read (s,*) y
        if (y /= x) res = res + 1
        x = nearest(x,huge(x))
      end do
    end if
 
    if (towards <= 0) then
      x = start
      do i = 0, count
        write (s,*) x
        read (s,*) y
        if (y /= x) res = res + 1
        x = nearest(x,-huge(x))
      end do
    end if
  end function test_r4
 
  function test_r8 (start, towards) result (res)
    integer, parameter :: k = 8
    integer, intent(in) :: towards
    real(k), intent(in) :: start
 
    integer :: res, i
    real(k) :: x, y
    character(len=100) :: s
 
    res = 0
 
    if (towards >= 0) then
      x = start
      do i = 0, count
        write (s,*) x
        read (s,*) y
        if (y /= x) res = res + 1
        x = nearest(x,huge(x))
      end do
    end if
 
    if (towards <= 0) then
      x = start
      do i = 0, count
        write (s,*) x
        read (s,*) y
        if (y /= x) res = res + 1
        x = nearest(x,-huge(x))
      end do
    end if
  end function test_r8
 
end module test_default_format

Line No.	Rev	Author	Line
1	694	jeremybenn	`module test_default_format`
2			`interface test`
3			`module procedure test_r4`
4			`module procedure test_r8`
5			`end interface test`
6
7			`integer, parameter :: count = 200`
8
9			`contains`
10			`function test_r4 (start, towards) result (res)`
11			`integer, parameter :: k = 4`
12			`integer, intent(in) :: towards`
13			`real(k), intent(in) :: start`
14
15			`integer :: res, i`
16			`real(k) :: x, y`
17			`character(len=100) :: s`
18
19			`res = 0`
20
21			`if (towards >= 0) then`
22			`x = start`
23			`do i = 0, count`
24			`write (s,*) x`
25			`read (s,*) y`
26			`if (y /= x) res = res + 1`
27			`x = nearest(x,huge(x))`
28			`end do`
29			`end if`
30
31			`if (towards <= 0) then`
32			`x = start`
33			`do i = 0, count`
34			`write (s,*) x`
35			`read (s,*) y`
36			`if (y /= x) res = res + 1`
37			`x = nearest(x,-huge(x))`
38			`end do`
39			`end if`
40			`end function test_r4`
41
42			`function test_r8 (start, towards) result (res)`
43			`integer, parameter :: k = 8`
44			`integer, intent(in) :: towards`
45			`real(k), intent(in) :: start`
46
47			`integer :: res, i`
48			`real(k) :: x, y`
49			`character(len=100) :: s`
50
51			`res = 0`
52
53			`if (towards >= 0) then`
54			`x = start`
55			`do i = 0, count`
56			`write (s,*) x`
57			`read (s,*) y`
58			`if (y /= x) res = res + 1`
59			`x = nearest(x,huge(x))`
60			`end do`
61			`end if`
62
63			`if (towards <= 0) then`
64			`x = start`
65			`do i = 0, count`
66			`write (s,*) x`
67			`read (s,*) y`
68			`if (y /= x) res = res + 1`
69			`x = nearest(x,-huge(x))`
70			`end do`
71			`end if`
72			`end function test_r8`
73
74			`end module test_default_format`

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [default_format_1.inc] - Blame information for rev 694