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_7.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 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.