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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-old/] [gcc-4.2.2/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [entry_5.f90] - Blame information for rev 867

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

Line No. Rev Author Line
1 149 jeremybenn
! Test alternate entry points for functions when the result types
2
! of all entry points match
3
 
4
        function f1 (str, i, j) result (r)
5
        character str*(*), r1*(*), r2*(*), r*(*)
6
        integer i, j
7
        r = str (i:j)
8
        return
9
        entry e1 (str, i, j) result (r1)
10
        i = i + 1
11
        entry e2 (str, i, j) result (r2)
12
        j = j - 1
13
        r2 = str (i:j)
14
        end function
15
 
16
        function f3 () result (r)
17
        character r3*5, r4*5, r*5
18
        integer i
19
        r = 'ABCDE'
20
        return
21
        entry e3 (i) result (r3)
22
        entry e4 (i) result (r4)
23
        if (i .gt. 0) then
24
          r3 = 'abcde'
25
        else
26
          r4 = 'UVWXY'
27
        endif
28
        end function
29
 
30
        program entrytest
31
        character f1*16, e1*16, e2*16, str*16, ret*16
32
        character f3*5, e3*5, e4*5
33
        integer i, j
34
        str = 'ABCDEFGHIJ'
35
        i = 2
36
        j = 6
37
        ret = f1 (str, i, j)
38
        if ((i .ne. 2) .or. (j .ne. 6)) call abort ()
39
        if (ret .ne. 'BCDEF') call abort ()
40
        ret = e1 (str, i, j)
41
        if ((i .ne. 3) .or. (j .ne. 5)) call abort ()
42
        if (ret .ne. 'CDE') call abort ()
43
        ret = e2 (str, i, j)
44
        if ((i .ne. 3) .or. (j .ne. 4)) call abort ()
45
        if (ret .ne. 'CD') call abort ()
46
        if (f3 () .ne. 'ABCDE') call abort ()
47
        if (e3 (1) .ne. 'abcde') call abort ()
48
        if (e4 (1) .ne. 'abcde') call abort ()
49
        if (e3 (0) .ne. 'UVWXY') call abort ()
50
        if (e4 (0) .ne. 'UVWXY') call abort ()
51
        end program

powered by: WebSVN 2.1.0

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