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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [entry_4.f90] - Blame information for rev 695

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 695 jeremybenn
! Test alternate entry points for functions when the result types
2
! of all entry points don't match
3
 
4
        integer function f1 (a)
5
        integer a, b
6
        double precision e1
7
        f1 = 15 + a
8
        return
9
        entry e1 (b)
10
        e1 = 42 + b
11
        end function
12
        complex function f2 (a)
13
        integer a
14
        logical e2
15
        entry e2 (a)
16
        if (a .gt. 0) then
17
          e2 = a .lt. 46
18
        else
19
          f2 = 45
20
        endif
21
        end function
22
        function f3 (a) result (r)
23
        integer a, b
24
        real r
25
        logical s
26
        complex c
27
        r = 15 + a
28
        return
29
        entry e3 (b) result (s)
30
        s = b .eq. 42
31
        return
32
        entry g3 (b) result (c)
33
        c = b + 11
34
        end function
35
        function f4 (a) result (r)
36
        logical r
37
        integer a, s
38
        double precision t
39
        entry e4 (a) result (s)
40
        entry g4 (a) result (t)
41
        r = a .lt. 0
42
        if (a .eq. 0) s = 16 + a
43
        if (a .gt. 0) t = 17 + a
44
        end function
45
 
46
        program entrytest
47
        integer f1, e4
48
        real f3
49
        double precision e1, g4
50
        logical e2, e3, f4
51
        complex f2, g3
52
        if (f1 (6) .ne. 21) call abort ()
53
        if (e1 (7) .ne. 49) call abort ()
54
        if (f2 (0) .ne. 45) call abort ()
55
        if (.not. e2 (45)) call abort ()
56
        if (e2 (46)) call abort ()
57
        if (f3 (17) .ne. 32) call abort ()
58
        if (.not. e3 (42)) call abort ()
59
        if (e3 (41)) call abort ()
60
        if (g3 (12) .ne. 23) call abort ()
61
        if (.not. f4 (-5)) call abort ()
62
        if (e4 (0) .ne. 16) call abort ()
63
        if (g4 (2) .ne. 19) call abort ()
64
        end

powered by: WebSVN 2.1.0

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