2005-04-29 Jakub Jelinek <jakub@redhat.com>

	PR fortran/13082
	PR fortran/18824
	* trans-expr.c (gfc_conv_variable): Handle return values in functions
	with alternate entry points.
	* resolve.c (resolve_entries): Remove unnecessary string termination
	after snprintf.  Set result of entry master.
	If all entries have the same type, set entry master's type
	to that common type, otherwise set mixed_entry_master attribute.
	* trans-types.c (gfc_get_mixed_entry_union): New function.
	(gfc_get_function_type): Use it for mixed_entry_master functions.
	* gfortran.h (symbol_attribute): Add mixed_entry_master bit.
	* decl.c (gfc_match_entry): Set entry->result properly for
	function ENTRY.
	* trans-decl.c (gfc_get_symbol_decl): For entry_master, skip over
	__entry argument.
	(build_entry_thunks): Handle return values in entry thunks.
	Clear BT_CHARACTER's ts.cl->backend_decl, so that it is not
	shared between multiple contexts.
	(gfc_get_fake_result_decl): Use DECL_ARGUMENTS from
	current_function_decl instead of sym->backend_decl.  Skip over
	entry master's entry id argument.  For mixed_entry_master entries or
	their results, return a COMPONENT_REF of the fake result.
	(gfc_trans_deferred_vars): Don't warn about missing return value if
	at least one entry point uses RESULT.
	(gfc_generate_function_code): For entry master returning
	CHARACTER, copy ts.cl->backend_decl to all entry result syms.
	* trans-array.c (gfc_trans_dummy_array_bias): Don't consider return
	values optional just because they are in entry master.

	* gfortran.dg/entry_4.f90: New test.
	* gfortran.fortran-torture/execute/entry_1.f90: New test.
	* gfortran.fortran-torture/execute/entry_2.f90: New test.
	* gfortran.fortran-torture/execute/entry_3.f90: New test.
	* gfortran.fortran-torture/execute/entry_4.f90: New test.
	* gfortran.fortran-torture/execute/entry_5.f90: New test.
	* gfortran.fortran-torture/execute/entry_6.f90: New test.
	* gfortran.fortran-torture/execute/entry_7.f90: New test.

2005-04-29  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>

	* gfortran.fortran-torture/execute/entry_8.f90: New test.


git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@98993 138bc75d-0d04-0410-961f-82ee72b054a4

10 files changed, 564 insertions, 0 deletions

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index eddf8c94100..fda64209646 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,20 @@
+2005-04-29  Jakub Jelinek  <jakub@redhat.com>
+
+	PR fortran/13082
+	PR fortran/18824
+	* gfortran.dg/entry_4.f90: New test.
+	* gfortran.fortran-torture/execute/entry_1.f90: New test.
+	* gfortran.fortran-torture/execute/entry_2.f90: New test.
+	* gfortran.fortran-torture/execute/entry_3.f90: New test.
+	* gfortran.fortran-torture/execute/entry_4.f90: New test.
+	* gfortran.fortran-torture/execute/entry_5.f90: New test.
+	* gfortran.fortran-torture/execute/entry_6.f90: New test.
+	* gfortran.fortran-torture/execute/entry_7.f90: New test.
+
+2005-04-29  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+
+	* gfortran.fortran-torture/execute/entry_8.f90: New test.
+
 2005-04-29  Paul Brook   <paul@codesourcery.com>
 
 	* gfortran.dg/entry_3.f90: New test.
diff --git a/gcc/testsuite/gfortran.dg/entry_4.f90 b/gcc/testsuite/gfortran.dg/entry_4.f90
new file mode 100644
index 00000000000..edc07fbefd3
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/entry_4.f90
@@ -0,0 +1,28 @@
+! { dg-do compile { target i?86-*-* x86_64-*-* } }
+function f1 () result (r)		! { dg-error "can't be a POINTER" }
+integer, pointer :: r
+real e1
+allocate (r)
+r = 6
+return
+entry e1 ()
+e1 = 12
+entry e1a ()
+e1a = 13
+end function
+function f2 ()
+integer, dimension (2, 7, 6) :: e2	! { dg-error "can't be an array" }
+f2 = 6
+return
+entry e2 ()
+e2 (:, :, :) = 2
+end function
+integer*8 function f3 ()		! { dg-error "can't be of type" }
+complex*16 e3				! { dg-error "can't be of type" }
+f3 = 1
+return
+entry e3 ()
+e3 = 2
+entry e3a ()
+e3a = 3
+end function
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/entry_1.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/entry_1.f90
new file mode 100644
index 00000000000..bef8a98dfd9
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/entry_1.f90
@@ -0,0 +1,74 @@
+! Test alternate entry points for functions when the result types
+! of all entry points match
+
+	function f1 (a)
+	integer a, b, f1, e1
+	f1 = 15 + a
+	return
+	entry e1 (b)
+	e1 = 42 + b
+	end function
+	function f2 ()
+	real f2, e2
+	entry e2 ()
+	e2 = 45
+	end function
+	function f3 ()
+	double precision a, b, f3, e3
+	entry e3 ()
+	f3 = 47
+	end function
+	function f4 (a) result (r)
+	double precision a, b, r, s
+	r = 15 + a
+	return
+	entry e4 (b) result (s)
+	s = 42 + b
+	end function
+	function f5 () result (r)
+	integer r, s
+	entry e5 () result (s)
+	r = 45
+	end function
+	function f6 () result (r)
+	real r, s
+	entry e6 () result (s)
+	s = 47
+	end function
+	function f7 ()
+	entry e7 ()
+	e7 = 163
+	end function
+	function f8 () result (r)
+	entry e8 ()
+	e8 = 115
+	end function
+	function f9 ()
+	entry e9 () result (r)
+	r = 119
+	end function
+
+	program entrytest
+	integer f1, e1, f5, e5
+	real f2, e2, f6, e6, f7, e7, f8, e8, f9, e9
+	double precision f3, e3, f4, e4, 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 ()
+	if (f7 () .ne. 163) call abort ()
+	if (e7 () .ne. 163) call abort ()
+	if (f8 () .ne. 115) call abort ()
+	if (e8 () .ne. 115) call abort ()
+	if (f9 () .ne. 119) call abort ()
+	if (e9 () .ne. 119) call abort ()
+	end
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/entry_2.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/entry_2.f90
new file mode 100644
index 00000000000..5db39db6a9d
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/entry_2.f90
@@ -0,0 +1,51 @@
+! Test alternate entry points for functions when the result types
+! of all entry points match
+
+	character*(*) function f1 (str, i, j)
+	character str*(*), e1*(*), e2*(*)
+	integer i, j
+	f1 = str (i:j)
+	return
+	entry e1 (str, i, j)
+	i = i + 1
+	entry e2 (str, i, j)
+	j = j - 1
+	e2 = str (i:j)
+	end function
+
+	character*5 function f3 ()
+	character e3*(*), e4*(*)
+	integer i
+	f3 = 'ABCDE'
+	return
+	entry e3 (i)
+	entry e4 (i)
+	if (i .gt. 0) then
+	  e3 = 'abcde'
+	else
+	  e4 = '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
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/entry_3.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/entry_3.f90
new file mode 100644
index 00000000000..7174fa878ca
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/entry_3.f90
@@ -0,0 +1,40 @@
+	subroutine f1 (n, *, i)
+	integer n, i
+	if (i .ne. 42) call abort ()
+	entry e1 (n, *)
+	if (n .eq. 1) return 1
+	if (n .eq. 2) return
+	return
+	entry e2 (n, i, *, *, *)
+	if (i .ne. 46) call abort ()
+	if (n .ge. 4) return
+	return n
+	entry e3 (n, i)
+	if ((i .ne. 48) .or. (n .ne. 61)) call abort ()
+	end subroutine
+
+	program alt_return
+	implicit none
+
+	call f1 (1, *10, 42)
+20	continue
+	call abort ()
+10	continue
+	call f1 (2, *20, 42)
+	call f1 (3, *20, 42)
+	call e1 (2, *20)
+	call e1 (1, *30)
+	call abort ()
+30	continue
+	call e2 (1, 46, *40, *20, *20)
+	call abort ()
+40	continue
+	call e2 (2, 46, *20, *50, *20)
+	call abort ()
+50	continue
+	call e2 (3, 46, *20, *20, *60)
+	call abort ()
+60	continue
+	call e2 (4, 46, *20, *20, *20)
+	call e3 (61, 48)
+	end program
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/entry_4.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/entry_4.f90
new file mode 100644
index 00000000000..f74440c13a7
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/entry_4.f90
@@ -0,0 +1,64 @@
+! Test alternate entry points for functions when the result types
+! of all entry points don't match
+
+	integer function f1 (a)
+	integer a, b
+	double precision e1
+	f1 = 15 + a
+	return
+	entry e1 (b)
+	e1 = 42 + b
+	end function
+	complex function f2 (a)
+	integer a
+	logical e2
+	entry e2 (a)
+	if (a .gt. 0) then
+	  e2 = a .lt. 46
+	else
+	  f2 = 45
+	endif
+	end function
+	function f3 (a) result (r)
+	integer a, b
+	real r
+	logical s
+	complex c
+	r = 15 + a
+	return
+	entry e3 (b) result (s)
+	s = b .eq. 42
+	return
+	entry g3 (b) result (c)
+	c = b + 11
+	end function
+	function f4 (a) result (r)
+	logical r
+	integer a, s
+	double precision t
+	entry e4 (a) result (s)
+	entry g4 (a) result (t)
+	r = a .lt. 0
+	if (a .eq. 0) s = 16 + a
+	if (a .gt. 0) t = 17 + a
+	end function
+
+	program entrytest
+	integer f1, e4
+	real f3
+	double precision e1, g4
+	logical e2, e3, f4
+	complex f2, g3
+	if (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
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/entry_5.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/entry_5.f90
new file mode 100644
index 00000000000..2fd927f4eb3
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/entry_5.f90
@@ -0,0 +1,51 @@
+! 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
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/entry_6.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/entry_6.f90
new file mode 100644
index 00000000000..a75c513a1c0
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/entry_6.f90
@@ -0,0 +1,109 @@
+! 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
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/entry_7.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/entry_7.f90
new file mode 100644
index 00000000000..28a8a3f7838
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/entry_7.f90
@@ -0,0 +1,106 @@
+! 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
diff --git a/gcc/testsuite/gfortran.fortran-torture/execute/entry_8.f90 b/gcc/testsuite/gfortran.fortran-torture/execute/entry_8.f90
new file mode 100644
index 00000000000..c68d75af768
--- /dev/null
+++ b/gcc/testsuite/gfortran.fortran-torture/execute/entry_8.f90
@@ -0,0 +1,24 @@
+module entry_8_m
+type t
+  integer i
+  real x (5)
+end type t
+end module entry_8_m
+
+function f (i)
+  use entry_8_m
+  type (t) :: f,g
+  f % i = i
+  return
+  entry g (x)
+  g%x = x
+end function f
+
+use entry_8_m
+type (t) :: f, g, res
+
+res = f (42)
+if (res%i /= 42) call abort ()
+res = g (1.)
+if (any (res%x /= 1.)) call abort ()
+end