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

Subversion Repositories openrisc

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

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 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.