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_4.f90] - Rev 154

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

! Test alternate entry points for functions when the result types
! of all entry points don't match

        integer function f1 (a)
        integer a, b
        double precision e1
        f1 = 15 + a
        return
        entry e1 (b)
        e1 = 42 + b
        end function
        complex function f2 (a)
        integer a
        logical e2
        entry e2 (a)
        if (a .gt. 0) then
          e2 = a .lt. 46
        else
          f2 = 45
        endif
        end function
        function f3 (a) result (r)
        integer a, b
        real r
        logical s
        complex c
        r = 15 + a
        return
        entry e3 (b) result (s)
        s = b .eq. 42
        return
        entry g3 (b) result (c)
        c = b + 11
        end function
        function f4 (a) result (r)
        logical r
        integer a, s
        double precision t
        entry e4 (a) result (s)
        entry g4 (a) result (t)
        r = a .lt. 0
        if (a .eq. 0) s = 16 + a
        if (a .gt. 0) t = 17 + a
        end function

        program entrytest
        integer f1, e4
        real f3
        double precision e1, g4
        logical e2, e3, f4
        complex f2, g3
        if (f1 (6) .ne. 21) call abort ()
        if (e1 (7) .ne. 49) call abort ()
        if (f2 (0) .ne. 45) call abort ()
        if (.not. e2 (45)) call abort ()
        if (e2 (46)) call abort ()
        if (f3 (17) .ne. 32) call abort ()
        if (.not. e3 (42)) call abort ()
        if (e3 (41)) call abort ()
        if (g3 (12) .ne. 23) call abort ()
        if (.not. f4 (-5)) call abort ()
        if (e4 (0) .ne. 16) call abort ()
        if (g4 (2) .ne. 19) call abort ()
        end

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

powered by: WebSVN 2.1.0

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