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/] [entry_4.f90] - Blame information for rev 303

Details | Compare with Previous | View Log


! Test alternate entry points for functions when the result types
! of all entry points don't match
 
        integer function f1 (a)
        integer a, b
        double precision e1
        f1 = 15 + a
        return
        entry e1 (b)
        e1 = 42 + b
        end function
        complex function f2 (a)
        integer a
        logical e2
        entry e2 (a)
        if (a .gt. 0) then
          e2 = a .lt. 46
        else
          f2 = 45
        endif
        end function
        function f3 (a) result (r)
        integer a, b
        real r
        logical s
        complex c
        r = 15 + a
        return
        entry e3 (b) result (s)
        s = b .eq. 42
        return
        entry g3 (b) result (c)
        c = b + 11
        end function
        function f4 (a) result (r)
        logical r
        integer a, s
        double precision t
        entry e4 (a) result (s)
        entry g4 (a) result (t)
        r = a .lt. 0
        if (a .eq. 0) s = 16 + a
        if (a .gt. 0) t = 17 + a
        end function
 
        program entrytest
        integer f1, e4
        real f3
        double precision e1, g4
        logical e2, e3, f4
        complex f2, g3
        if (f1 (6) .ne. 21) call abort ()
        if (e1 (7) .ne. 49) call abort ()
        if (f2 (0) .ne. 45) call abort ()
        if (.not. e2 (45)) call abort ()
        if (e2 (46)) call abort ()
        if (f3 (17) .ne. 32) call abort ()
        if (.not. e3 (42)) call abort ()
        if (e3 (41)) call abort ()
        if (g3 (12) .ne. 23) call abort ()
        if (.not. f4 (-5)) call abort ()
        if (e4 (0) .ne. 16) call abort ()
        if (g4 (2) .ne. 19) call abort ()
        end

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

Browse

Tools

Subversion Repositories openrisc_me

[/] [openrisc/] [trunk/] [gnu-src/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [entry_4.f90] - Blame information for rev 303