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

Go to most recent revision | 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.