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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-stable/] [gcc-4.5.1/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [entry_7.f90] - Blame information for rev 826

Details | Compare with Previous | View Log

Line No. Rev Author Line
1 303 jeremybenn
! Test alternate entry points for functions when the result types
2
! of all entry points match
3
 
4
        function f1 (a)
5
        integer a, b
6
        integer, pointer :: f1, e1
7
        allocate (f1)
8
        f1 = 15 + a
9
        return
10
        entry e1 (b)
11
        allocate (e1)
12
        e1 = 42 + b
13
        end function
14
        function f2 ()
15
        real, pointer :: f2, e2
16
        entry e2 ()
17
        allocate (e2)
18
        e2 = 45
19
        end function
20
        function f3 ()
21
        double precision, pointer :: f3, e3
22
        entry e3 ()
23
        allocate (f3)
24
        f3 = 47
25
        end function
26
        function f4 (a) result (r)
27
        double precision a, b
28
        double precision, pointer :: r, s
29
        allocate (r)
30
        r = 15 + a
31
        return
32
        entry e4 (b) result (s)
33
        allocate (s)
34
        s = 42 + b
35
        end function
36
        function f5 () result (r)
37
        integer, pointer :: r, s
38
        entry e5 () result (s)
39
        allocate (r)
40
        r = 45
41
        end function
42
        function f6 () result (r)
43
        real, pointer :: r, s
44
        entry e6 () result (s)
45
        allocate (s)
46
        s = 47
47
        end function
48
 
49
        program entrytest
50
        interface
51
        function f1 (a)
52
        integer a
53
        integer, pointer :: f1
54
        end function
55
        function e1 (b)
56
        integer b
57
        integer, pointer :: e1
58
        end function
59
        function f2 ()
60
        real, pointer :: f2
61
        end function
62
        function e2 ()
63
        real, pointer :: e2
64
        end function
65
        function f3 ()
66
        double precision, pointer :: f3
67
        end function
68
        function e3 ()
69
        double precision, pointer :: e3
70
        end function
71
        function f4 (a)
72
        double precision a
73
        double precision, pointer :: f4
74
        end function
75
        function e4 (b)
76
        double precision b
77
        double precision, pointer :: e4
78
        end function
79
        function f5 ()
80
        integer, pointer :: f5
81
        end function
82
        function e5 ()
83
        integer, pointer :: e5
84
        end function
85
        function f6 ()
86
        real, pointer :: f6
87
        end function
88
        function e6 ()
89
        real, pointer :: e6
90
        end function
91
        end interface
92
        double precision d
93
        if (f1 (6) .ne. 21) call abort ()
94
        if (e1 (7) .ne. 49) call abort ()
95
        if (f2 () .ne. 45) call abort ()
96
        if (e2 () .ne. 45) call abort ()
97
        if (f3 () .ne. 47) call abort ()
98
        if (e3 () .ne. 47) call abort ()
99
        d = 17
100
        if (f4 (d) .ne. 32) call abort ()
101
        if (e4 (d) .ne. 59) call abort ()
102
        if (f5 () .ne. 45) call abort ()
103
        if (e5 () .ne. 45) call abort ()
104
        if (f6 () .ne. 47) call abort ()
105
        if (e6 () .ne. 47) call abort ()
106
        end

powered by: WebSVN 2.1.0

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