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_2.f90] - Rev 303
Compare with Previous | Blame | View Log
! Test alternate entry points for functions when the result types! of all entry points matchcharacter*(*) function f1 (str, i, j)character str*(*), e1*(*), e2*(*)integer i, jf1 = str (i:j)returnentry e1 (str, i, j)i = i + 1entry e2 (str, i, j)j = j - 1e2 = str (i:j)end functioncharacter*5 function f3 ()character e3*(*), e4*(*)integer if3 = 'ABCDE'returnentry e3 (i)entry e4 (i)if (i .gt. 0) thene3 = 'abcde'elsee4 = 'UVWXY'endifend functionprogram entrytestcharacter f1*16, e1*16, e2*16, str*16, ret*16character f3*5, e3*5, e4*5integer i, jstr = 'ABCDEFGHIJ'i = 2j = 6ret = f1 (str, i, j)if ((i .ne. 2) .or. (j .ne. 6)) call abort ()if (ret .ne. 'BCDEF') call abort ()ret = e1 (str, i, j)if ((i .ne. 3) .or. (j .ne. 5)) call abort ()if (ret .ne. 'CDE') call abort ()ret = e2 (str, i, j)if ((i .ne. 3) .or. (j .ne. 4)) call abort ()if (ret .ne. 'CD') call abort ()if (f3 () .ne. 'ABCDE') call abort ()if (e3 (1) .ne. 'abcde') call abort ()if (e4 (1) .ne. 'abcde') call abort ()if (e3 (0) .ne. 'UVWXY') call abort ()if (e4 (0) .ne. 'UVWXY') call abort ()end program
