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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [entry_6.f90] - Blame information for rev 801

Go to most recent revision | Details | Compare with Previous | View Log


! Test alternate entry points for functions when the result types
! of all entry points match
 
        function f1 (a)
        integer, dimension (2, 2) :: a, b, f1, e1
        f1 (:, :) = 15 + a (1, 1)
        return
        entry e1 (b)
        e1 (:, :) = 42 + b (1, 1)
        end function
        function f2 ()
        real, dimension (2, 2) :: f2, e2
        entry e2 ()
        e2 (:, :) = 45
        end function
        function f3 ()
        double precision, dimension (2, 2) :: a, b, f3, e3
        entry e3 ()
        f3 (:, :) = 47
        end function
        function f4 (a) result (r)
        double precision, dimension (2, 2) :: a, b, r, s
        r (:, :) = 15 + a (1, 1)
        return
        entry e4 (b) result (s)
        s (:, :) = 42 + b (1, 1)
        end function
        function f5 () result (r)
        integer, dimension (2, 2) :: r, s
        entry e5 () result (s)
        r (:, :) = 45
        end function
        function f6 () result (r)
        real, dimension (2, 2) :: r, s
        entry e6 () result (s)
        s (:, :) = 47
        end function
 
        program entrytest
        interface
        function f1 (a)
        integer, dimension (2, 2) :: a, f1
        end function
        function e1 (b)
        integer, dimension (2, 2) :: b, e1
        end function
        function f2 ()
        real, dimension (2, 2) :: f2
        end function
        function e2 ()
        real, dimension (2, 2) :: e2
        end function
        function f3 ()
        double precision, dimension (2, 2) :: f3
        end function
        function e3 ()
        double precision, dimension (2, 2) :: e3
        end function
        function f4 (a)
        double precision, dimension (2, 2) :: a, f4
        end function
        function e4 (b)
        double precision, dimension (2, 2) :: b, e4
        end function
        function f5 ()
        integer, dimension (2, 2) :: f5
        end function
        function e5 ()
        integer, dimension (2, 2) :: e5
        end function
        function f6 ()
        real, dimension (2, 2) :: f6
        end function
        function e6 ()
        real, dimension (2, 2) :: e6
        end function
        end interface
        integer, dimension (2, 2) :: i, j
        real, dimension (2, 2) :: r
        double precision, dimension (2, 2) :: d, e
        i (:, :) = 6
        j = f1 (i)
        if (any (j .ne. 21)) call abort ()
        i (:, :) = 7
        j = e1 (i)
        j (:, :) = 49
        if (any (j .ne. 49)) call abort ()
        r = f2 ()
        if (any (r .ne. 45)) call abort ()
        r = e2 ()
        if (any (r .ne. 45)) call abort ()
        e = f3 ()
        if (any (e .ne. 47)) call abort ()
        e = e3 ()
        if (any (e .ne. 47)) call abort ()
        d (:, :) = 17
        e = f4 (d)
        if (any (e .ne. 32)) call abort ()
        e = e4 (d)
        if (any (e .ne. 59)) call abort ()
        j = f5 ()
        if (any (j .ne. 45)) call abort ()
        j = e5 ()
        if (any (j .ne. 45)) call abort ()
        r = f6 ()
        if (any (r .ne. 47)) call abort ()
        r = e6 ()
        if (any (r .ne. 47)) call abort ()
        end

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, 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`

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [entry_6.f90] - Blame information for rev 801