OpenCores
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_6.f90] - Blame information for rev 303

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, dimension (2, 2) :: a, b, f1, e1
6
        f1 (:, :) = 15 + a (1, 1)
7
        return
8
        entry e1 (b)
9
        e1 (:, :) = 42 + b (1, 1)
10
        end function
11
        function f2 ()
12
        real, dimension (2, 2) :: f2, e2
13
        entry e2 ()
14
        e2 (:, :) = 45
15
        end function
16
        function f3 ()
17
        double precision, dimension (2, 2) :: a, b, f3, e3
18
        entry e3 ()
19
        f3 (:, :) = 47
20
        end function
21
        function f4 (a) result (r)
22
        double precision, dimension (2, 2) :: a, b, r, s
23
        r (:, :) = 15 + a (1, 1)
24
        return
25
        entry e4 (b) result (s)
26
        s (:, :) = 42 + b (1, 1)
27
        end function
28
        function f5 () result (r)
29
        integer, dimension (2, 2) :: r, s
30
        entry e5 () result (s)
31
        r (:, :) = 45
32
        end function
33
        function f6 () result (r)
34
        real, dimension (2, 2) :: r, s
35
        entry e6 () result (s)
36
        s (:, :) = 47
37
        end function
38
 
39
        program entrytest
40
        interface
41
        function f1 (a)
42
        integer, dimension (2, 2) :: a, f1
43
        end function
44
        function e1 (b)
45
        integer, dimension (2, 2) :: b, e1
46
        end function
47
        function f2 ()
48
        real, dimension (2, 2) :: f2
49
        end function
50
        function e2 ()
51
        real, dimension (2, 2) :: e2
52
        end function
53
        function f3 ()
54
        double precision, dimension (2, 2) :: f3
55
        end function
56
        function e3 ()
57
        double precision, dimension (2, 2) :: e3
58
        end function
59
        function f4 (a)
60
        double precision, dimension (2, 2) :: a, f4
61
        end function
62
        function e4 (b)
63
        double precision, dimension (2, 2) :: b, e4
64
        end function
65
        function f5 ()
66
        integer, dimension (2, 2) :: f5
67
        end function
68
        function e5 ()
69
        integer, dimension (2, 2) :: e5
70
        end function
71
        function f6 ()
72
        real, dimension (2, 2) :: f6
73
        end function
74
        function e6 ()
75
        real, dimension (2, 2) :: e6
76
        end function
77
        end interface
78
        integer, dimension (2, 2) :: i, j
79
        real, dimension (2, 2) :: r
80
        double precision, dimension (2, 2) :: d, e
81
        i (:, :) = 6
82
        j = f1 (i)
83
        if (any (j .ne. 21)) call abort ()
84
        i (:, :) = 7
85
        j = e1 (i)
86
        j (:, :) = 49
87
        if (any (j .ne. 49)) call abort ()
88
        r = f2 ()
89
        if (any (r .ne. 45)) call abort ()
90
        r = e2 ()
91
        if (any (r .ne. 45)) call abort ()
92
        e = f3 ()
93
        if (any (e .ne. 47)) call abort ()
94
        e = e3 ()
95
        if (any (e .ne. 47)) call abort ()
96
        d (:, :) = 17
97
        e = f4 (d)
98
        if (any (e .ne. 32)) call abort ()
99
        e = e4 (d)
100
        if (any (e .ne. 59)) call abort ()
101
        j = f5 ()
102
        if (any (j .ne. 45)) call abort ()
103
        j = e5 ()
104
        if (any (j .ne. 45)) call abort ()
105
        r = f6 ()
106
        if (any (r .ne. 47)) call abort ()
107
        r = e6 ()
108
        if (any (r .ne. 47)) call abort ()
109
        end

powered by: WebSVN 2.1.0

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