entry_6.f90

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

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

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

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