URL
https://opencores.org/ocsvn/openrisc/openrisc/trunk
Subversion Repositories openrisc
[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.fortran-torture/] [execute/] [entry_4.f90] - Rev 695
Compare with Previous | Blame | View Log
! Test alternate entry points for functions when the result types! of all entry points don't matchinteger function f1 (a)integer a, bdouble precision e1f1 = 15 + areturnentry e1 (b)e1 = 42 + bend functioncomplex function f2 (a)integer alogical e2entry e2 (a)if (a .gt. 0) thene2 = a .lt. 46elsef2 = 45endifend functionfunction f3 (a) result (r)integer a, breal rlogical scomplex cr = 15 + areturnentry e3 (b) result (s)s = b .eq. 42returnentry g3 (b) result (c)c = b + 11end functionfunction f4 (a) result (r)logical rinteger a, sdouble precision tentry e4 (a) result (s)entry g4 (a) result (t)r = a .lt. 0if (a .eq. 0) s = 16 + aif (a .gt. 0) t = 17 + aend functionprogram entrytestinteger f1, e4real f3double precision e1, g4logical e2, e3, f4complex f2, g3if (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
