entry_5.f90

来自「Mac OS X 10.4.9 for x86 Source Code gcc」· F90 代码 · 共 52 行

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

	function f1 (str, i, j) result (r)
	character str*(*), r1*(*), r2*(*), r*(*)
	integer i, j
	r = str (i:j)
	return
	entry e1 (str, i, j) result (r1)
	i = i + 1
	entry e2 (str, i, j) result (r2)
	j = j - 1
	r2 = str (i:j)
	end function

	function f3 () result (r)
	character r3*5, r4*5, r*5
	integer i
	r = 'ABCDE'
	return
	entry e3 (i) result (r3)
	entry e4 (i) result (r4)
	if (i .gt. 0) then
	  r3 = 'abcde'
	else
	  r4 = 'UVWXY'
	endif
	end function

	program entrytest
	character f1*16, e1*16, e2*16, str*16, ret*16
	character f3*5, e3*5, e4*5
	integer i, j
	str = 'ABCDEFGHIJ'
	i = 2
	j = 6
	ret = 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