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

Subversion Repositories openrisc

[/] [openrisc/] [tags/] [gnu-src/] [gcc-4.5.1/] [gcc-4.5.1-or32-1.0rc2/] [gcc/] [testsuite/] [gfortran.dg/] [default_format_2.inc] - Blame information for rev 384

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 302 jeremybenn 
module test_default_format
2 
  interface test
3 
    module procedure test_rl
4 
  end interface test
5 
 
6 
  integer, parameter :: kl = selected_real_kind (precision (0.0_8) + 1)
7 
  integer, parameter :: count = 200
8 
 
9 
contains
10 
 
11 
  function test_rl (start, towards) result (res)
12 
    integer, parameter :: k = kl
13 
    integer, intent(in) :: towards
14 
    real(k), intent(in) :: start
15 
 
16 
    integer :: res, i
17 
    real(k) :: x, y
18 
    character(len=100) :: s
19 
 
20 
    res = 0
21 
 
22 
    if (towards >= 0) then
23 
      x = start
24 
      do i = 0, count
25 
        write (s,*) x
26 
        read (s,*) y
27 
        if (y /= x) res = res + 1
28 
        x = nearest(x,huge(x))
29 
      end do
30 
    end if
31 
 
32 
    if (towards <= 0) then
33 
      x = start
34 
      do i = 0, count
35 
        write (s,*) x
36 
        read (s,*) y
37 
        if (y /= x) res = res + 1
38 
        x = nearest(x,-huge(x))
39 
      end do
40 
    end if
41 
  end function test_rl
42 
 
43 
end module test_default_format

powered by: WebSVN 2.1.0

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