entry_7.f90

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

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

	function f1 (a)
	integer a, b
	integer, pointer :: f1, e1
	allocate (f1)
	f1 = 15 + a
	return
	entry e1 (b)
	allocate (e1)
	e1 = 42 + b
	end function
	function f2 ()
	real, pointer :: f2, e2
	entry e2 ()
	allocate (e2)
	e2 = 45
	end function
	function f3 ()
	double precision, pointer :: f3, e3
	entry e3 ()
	allocate (f3)
	f3 = 47
	end function
	function f4 (a) result (r)
	double precision a, b
	double precision, pointer :: r, s
	allocate (r)
	r = 15 + a
	return
	entry e4 (b) result (s)
	allocate (s)
	s = 42 + b
	end function
	function f5 () result (r)
	integer, pointer :: r, s
	entry e5 () result (s)
	allocate (r)
	r = 45
	end function
	function f6 () result (r)
	real, pointer :: r, s
	entry e6 () result (s)
	allocate (s)
	s = 47
	end function

	program entrytest
	interface
	function f1 (a)
	integer a
	integer, pointer :: f1
	end function
	function e1 (b)
	integer b
	integer, pointer :: e1
	end function
	function f2 ()
	real, pointer :: f2
	end function
	function e2 ()
	real, pointer :: e2
	end function
	function f3 ()
	double precision, pointer :: f3
	end function
	function e3 ()
	double precision, pointer :: e3
	end function
	function f4 (a)
	double precision a
	double precision, pointer :: f4
	end function
	function e4 (b)
	double precision b
	double precision, pointer :: e4
	end function
	function f5 ()
	integer, pointer :: f5
	end function
	function e5 ()
	integer, pointer :: e5
	end function
	function f6 ()
	real, pointer :: f6
	end function
	function e6 ()
	real, pointer :: e6
	end function
	end interface
	double precision d
	if (f1 (6) .ne. 21) call abort ()
	if (e1 (7) .ne. 49) call abort ()
	if (f2 () .ne. 45) call abort ()
	if (e2 () .ne. 45) call abort ()
	if (f3 () .ne. 47) call abort ()
	if (e3 () .ne. 47) call abort ()
	d = 17
	if (f4 (d) .ne. 32) call abort ()
	if (e4 (d) .ne. 59) call abort ()
	if (f5 () .ne. 45) call abort ()
	if (e5 () .ne. 45) call abort ()
	if (f6 () .ne. 47) call abort ()
	if (e6 () .ne. 47) call abort ()
	end