2006-03-06 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/26107
	* resolve.c (resolve_function): Add name after test for pureness.

	PR fortran/19546
	* trans-expr.c (gfc_conv_variable): Detect reference to parent result,
	store current_function_decl, replace with parent, whilst calls are
	made to gfc_get_fake_result_decl, and restore afterwards. Signal this
	to gfc_get_fake_result_decl with a new argument, parent_flag.
	* trans-stmt.c (gfc_trans_return): gfc_get_fake_result_decl 2nd arg
	is set to zero.
	* trans.h: Add parent_flag to gfc_get_fake_result_decl prototype.
	* trans-decl.c (gfc_get_fake_result_decl): On parent_flag, being set,
	add decl to parent function. Replace refs to current_fake_result_decl
	with refs to this_result_decl.
	(gfc_generate_function_code): Null parent_fake_result_decl before the
	translation of code for contained procedures. Set parent_flag to zero
	in call to gfc_get_fake_result_decl.
	* trans-intrinsic.c (gfc_conv_intrinsic_len): The same.

2006-03-06  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/26107
	* pure_dummy_length_1.f90: New test.

	PR fortran/19546
	* gfortran.dg/parent_result_ref_1.f90: New test.
	* gfortran.dg/parent_result_ref_2.f90: New test.
	* gfortran.dg/parent_result_ref_3.f90: New test.
	* gfortran.dg/parent_result_ref_4.f90: New test.


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

1 files changed, 29 insertions, 0 deletions

diff --git a/gcc/testsuite/gfortran.dg/pure_dummy_length_1.f90 b/gcc/testsuite/gfortran.dg/pure_dummy_length_1.f90
new file mode 100644
index 00000000000..4b0b8ae7e17
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pure_dummy_length_1.f90
@@ -0,0 +1,29 @@
+! { dg-do compile }

+! Tests fix for PR26107 in which an ICE would occur after the second

+! error message below.  This resulted from a spurious attempt to

+! produce the third error message, without the name of the function.

+!

+! This is an expanded version of the testcase in the PR.

+!

+   pure function equals(self, &     ! { dg-error "must be INTENT" }

+                        string, ignore_case) result(same)

+         character(*), intent(in) :: string

+         integer(4), intent(in) :: ignore_case

+         integer(4) :: same

+         if (len (self) < 1) return ! { dg-error "Type of argument" }

+         same = 1

+   end function

+

+   function impure(self) result(ival)

+         character(*), intent(in) :: self

+         ival = 1

+   end function

+

+   pure function purity(self, string, ignore_case) result(same)

+         character(*), intent(in) :: self

+         character(*), intent(in) :: string

+         integer(4), intent(in) :: ignore_case

+         integer i

+         if (end > impure (self)) & ! { dg-error "non-PURE procedure" }

+           return

+   end function