re PR fortran/26107 (ICE after error message on invalid code)

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.

From-SVN: r111793

14 files changed, 303 insertions, 65 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index ddb49cc..dcc3c59 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,8 +1,29 @@
+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-05  Steven G. Kargl  <kargls@comcast.net>
 
 	* simplify.c (gfc_simplify_verify):  Fix return when SET=''.
 
-2005-03-05  Erik Edelmann  <eedelman@gcc.gnu.org>
+2006-03-05  Erik Edelmann  <eedelman@gcc.gnu.org>
 
 	PR fortran/16136
 	* symbol.c (conf_std): New macro.
@@ -180,7 +201,7 @@
 	* intrinsic.c (gfc_convert_type_warn): Call
 	gfc_intrinsic_symbol() on the newly created symbol.
 
-2005-02-19  Paul Thomas  <pault@gcc.gnu.org>
+2006-02-19  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/25054
 	* resolve.c (is_non_constant_shape_array): New function.
@@ -232,7 +253,7 @@
 	* openmp.c (resolve_omp_clauses): Add a dummy case label to workaround
 	PR middle-end/26316.
 
-2005-02-16  Paul Thomas  <pault@gcc.gnu.org>
+2006-02-16  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/24557
 	* trans-expr.c (gfc_add_interface_mapping): Use the actual argument
@@ -767,7 +788,7 @@
 	* trans-decl.c (gfc_generate_function_code): Add new argument,
 	pedantic, to set_std call.
 
-2005-02-06  Thomas Koenig  <Thomas.Koenig@online.de>
+2006-02-06  Thomas Koenig  <Thomas.Koenig@online.de>
 
 	PR libfortran/23815
 	* gfortran.texi: Document the GFORTRAN_CONVERT_UNIT environment
@@ -929,7 +950,7 @@
 	for checking arguments array and mask.
 	(check_reduction):  Likewise.
 
-2005-01-30  Erik Edelmann  <eedelman@gcc.gnu.org>
+2006-01-30  Erik Edelmann  <eedelman@gcc.gnu.org>
 
 	PR fortran/24266
 	* trans-io.c (set_internal_unit): Check the rank of the
@@ -958,7 +979,7 @@
 	* gfortran.h: Add prototype for gfc_dep_compare_expr.
 	* dependency.h: Remove prototype for gfc_dep_compare_expr.
 
-2005-01-27  Paul Thomas  <pault@gcc.gnu.org>
+2006-01-27  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/25964
 	* resolve.c (resolve_function): Add GFC_ISYM_LOC to the list of
@@ -986,12 +1007,12 @@
 	* lang-specs.h: Pass -fpreprocessed to f951 if preprocessing
 	sources.
 
-2005-01-27  Erik Edelmann  <eedelman@gcc.gnu.org>
+2006-01-27  Erik Edelmann  <eedelman@gcc.gnu.org>
 
 	* symbol.c (free_old_symbol): Fix confusing comment, and add code
 	  to free old_symbol->formal.
 
-2005-01-26  Paul Thomas  <pault@gcc.gnu.org>
+2006-01-26  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/25964
 	* resolve.c (resolve_function): Exclude statement functions from
@@ -1023,7 +1044,7 @@
 	temporary from "parm" to "ifm" to avoid clash with temp coming from
 	trans-array.c.
 
-2005-01-25  Erik Edelmann  <eedelman@gcc.gnu.org>
+2006-01-25  Erik Edelmann  <eedelman@gcc.gnu.org>
 
 	PR fortran/25716
 	* symbol.c (free_old_symbol): New function.
@@ -1038,7 +1059,7 @@
 	* resolve.c (gfc_resolve_index): Make sure typespec is
 	properly initialized.
 
-2005-01-23  Paul Thomas  <pault@gcc.gnu.org>
+2006-01-23  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/25901
 	* decl.c (get_proc_name): Replace subroutine and function attributes
@@ -1057,7 +1078,7 @@
 	* gfortranspec.c (lang_specific_driver): Update copyright notice
 	date.
 
-2005-01-21  Paul Thomas  <pault@gcc.gnu.org>
+2006-01-21  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/25124
 	PR fortran/25625
@@ -1210,7 +1231,7 @@
 	* scanner.c (load_line): use maxlen to determine the line-length used
 	for padding lines in fixed form.
 
-2005-01-11  Paul Thomas  <pault@gcc.gnu.org>
+2006-01-11  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/25730
 	* trans-types.c (copy_dt_decls_ifequal): Copy backend decl for
@@ -1248,13 +1269,13 @@
 	(gfc_simplify_ichar): Get the result from unsinged char and in the
 	range 0 to UCHAR_MAX instead of CHAR_MIN to CHAR_MAX.
 
-2005-01-08  Erik Edelmann  <eedelman@gcc.gnu.org>
+2006-01-08  Erik Edelmann  <eedelman@gcc.gnu.org>
 
 	PR fortran/25093
 	* resolve.c (resolve_fntype): Check that PUBLIC functions
 	aren't of PRIVATE type.
 
-2005-01-07  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
+2006-01-07  Tobias Schl"uter  <tobias.schlueter@physik.uni-muenchen.de>
 
 	* decl.c (gfc_match_function_decl): Correctly error out in case of
 	omitted function argument list.
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 4bf394a..3e7eb9d 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1357,7 +1357,7 @@ resolve_function (gfc_expr * expr)
 
   need_full_assumed_size = temp;
 
-  if (!pure_function (expr, &name))
+  if (!pure_function (expr, &name) && name)
     {
       if (forall_flag)
 	{
diff --git a/gcc/fortran/trans-decl.c b/gcc/fortran/trans-decl.c
index 41f5abe..daa452e 100644
--- a/gcc/fortran/trans-decl.c
+++ b/gcc/fortran/trans-decl.c
@@ -50,6 +50,7 @@ Software Foundation, 51 Franklin Street, Fifth Floor, Boston, MA
 /* Holds the result of the function if no result variable specified.  */
 
 static GTY(()) tree current_fake_result_decl;
+static GTY(()) tree parent_fake_result_decl;
 
 static GTY(()) tree current_function_return_label;
 
@@ -1733,28 +1734,49 @@ gfc_create_function_decl (gfc_namespace * ns)
   create_function_arglist (ns->proc_name);
 }
 
-/* Return the decl used to hold the function return value.  */
+/* Return the decl used to hold the function return value.  If
+   parent_flag is set, the context is the parent_scope*/
 
 tree
-gfc_get_fake_result_decl (gfc_symbol * sym)
+gfc_get_fake_result_decl (gfc_symbol * sym, int parent_flag)
 {
-  tree decl, length;
+  tree decl;
+  tree length;
+  tree this_fake_result_decl;
+  tree this_function_decl;
 
   char name[GFC_MAX_SYMBOL_LEN + 10];
 
+  if (parent_flag)
+    {
+      this_fake_result_decl = parent_fake_result_decl;
+      this_function_decl = DECL_CONTEXT (current_function_decl);
+    }
+  else
+    {
+      this_fake_result_decl = current_fake_result_decl;
+      this_function_decl = current_function_decl;
+    }
+
   if (sym
-      && sym->ns->proc_name->backend_decl == current_function_decl
+      && sym->ns->proc_name->backend_decl == this_function_decl
       && sym->ns->proc_name->attr.entry_master
       && sym != sym->ns->proc_name)
     {
       tree t = NULL, var;
-      if (current_fake_result_decl != NULL)
-	for (t = TREE_CHAIN (current_fake_result_decl); t; t = TREE_CHAIN (t))
+      if (this_fake_result_decl != NULL)
+	for (t = TREE_CHAIN (this_fake_result_decl); t; t = TREE_CHAIN (t))
 	  if (strcmp (IDENTIFIER_POINTER (TREE_PURPOSE (t)), sym->name) == 0)
 	    break;
       if (t)
 	return TREE_VALUE (t);
-      decl = gfc_get_fake_result_decl (sym->ns->proc_name);
+      decl = gfc_get_fake_result_decl (sym->ns->proc_name, parent_flag);
+
+      if (parent_flag)
+	this_fake_result_decl = parent_fake_result_decl;
+      else
+	this_fake_result_decl = current_fake_result_decl;
+
       if (decl && sym->ns->proc_name->attr.mixed_entry_master)
 	{
 	  tree field;
@@ -1769,18 +1791,24 @@ gfc_get_fake_result_decl (gfc_symbol * sym)
 	  decl = build3 (COMPONENT_REF, TREE_TYPE (field), decl, field,
 			 NULL_TREE);
 	}
-      var = gfc_create_var (TREE_TYPE (decl), sym->name);
-      GFC_DECL_RESULT (var) = 1;
+
+      var = create_tmp_var_raw (TREE_TYPE (decl), sym->name);
+      if (parent_flag)
+	gfc_add_decl_to_parent_function (var);
+      else
+	gfc_add_decl_to_function (var);
+
       SET_DECL_VALUE_EXPR (var, decl);
       DECL_HAS_VALUE_EXPR_P (var) = 1;
-      TREE_CHAIN (current_fake_result_decl)
-	= tree_cons (get_identifier (sym->name), var,
-		     TREE_CHAIN (current_fake_result_decl));
+
+      TREE_CHAIN (this_fake_result_decl)
+	  = tree_cons (get_identifier (sym->name), var,
+		       TREE_CHAIN (this_fake_result_decl));
       return var;
     }
 
-  if (current_fake_result_decl != NULL_TREE)
-    return TREE_VALUE (current_fake_result_decl);
+  if (this_fake_result_decl != NULL_TREE)
+    return TREE_VALUE (this_fake_result_decl);
 
   /* Only when gfc_get_fake_result_decl is called by gfc_trans_return,
      sym is NULL.  */
@@ -1800,9 +1828,9 @@ gfc_get_fake_result_decl (gfc_symbol * sym)
 
   if (gfc_return_by_reference (sym))
     {
-      decl = DECL_ARGUMENTS (current_function_decl);
+      decl = DECL_ARGUMENTS (this_function_decl);
 
-      if (sym->ns->proc_name->backend_decl == current_function_decl
+      if (sym->ns->proc_name->backend_decl == this_function_decl
 	  && sym->ns->proc_name->attr.entry_master)
 	decl = TREE_CHAIN (decl);
 
@@ -1813,10 +1841,10 @@ gfc_get_fake_result_decl (gfc_symbol * sym)
   else
     {
       sprintf (name, "__result_%.20s",
-	       IDENTIFIER_POINTER (DECL_NAME (current_function_decl)));
+	       IDENTIFIER_POINTER (DECL_NAME (this_function_decl)));
 
       decl = build_decl (VAR_DECL, get_identifier (name),
-			 TREE_TYPE (TREE_TYPE (current_function_decl)));
+			 TREE_TYPE (TREE_TYPE (this_function_decl)));
 
       DECL_ARTIFICIAL (decl) = 1;
       DECL_EXTERNAL (decl) = 0;
@@ -1826,10 +1854,16 @@ gfc_get_fake_result_decl (gfc_symbol * sym)
 
       layout_decl (decl, 0);
 
-      gfc_add_decl_to_function (decl);
+      if (parent_flag)
+	gfc_add_decl_to_parent_function (decl);
+      else
+	gfc_add_decl_to_function (decl);
     }
 
-  current_fake_result_decl = build_tree_list (NULL, decl);
+  if (parent_flag)
+    parent_fake_result_decl = build_tree_list (NULL, decl);
+  else
+    current_fake_result_decl = build_tree_list (NULL, decl);
 
   return decl;
 }
@@ -2834,12 +2868,24 @@ gfc_generate_function_code (gfc_namespace * ns)
   /* Translate COMMON blocks.  */
   gfc_trans_common (ns);
 
+  /* Null the parent fake result declaration if this namespace is
+     a module function or an external procedures.  */
+  if ((ns->parent && ns->parent->proc_name->attr.flavor == FL_MODULE)
+	|| ns->parent == NULL)
+    parent_fake_result_decl = NULL_TREE;
+
   gfc_generate_contained_functions (ns);
 
   generate_local_vars (ns);
   
-  /* Will be created as needed.  */
-  current_fake_result_decl = NULL_TREE;
+  /* Keep the parent fake result declaration in module functions
+     or external procedures.  */
+  if ((ns->parent && ns->parent->proc_name->attr.flavor == FL_MODULE)
+	|| ns->parent == NULL)
+    current_fake_result_decl = parent_fake_result_decl;
+  else
+    current_fake_result_decl = NULL_TREE;
+
   current_function_return_label = NULL;
 
   /* Now generate the code for the body of this function.  */
@@ -2901,7 +2947,7 @@ gfc_generate_function_code (gfc_namespace * ns)
       && sym->attr.subroutine)
     {
       tree alternate_return;
-      alternate_return = gfc_get_fake_result_decl (sym);
+      alternate_return = gfc_get_fake_result_decl (sym, 0);
       gfc_add_modify_expr (&body, alternate_return, integer_zero_node);
     }
 
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index 1fc7f06..4be5459 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -296,6 +296,11 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
 {
   gfc_ref *ref;
   gfc_symbol *sym;
+  tree parent_decl;
+  int parent_flag;
+  bool return_value;
+  bool alternate_entry;
+  bool entry_master;
 
   sym = expr->symtree->n.sym;
   if (se->ss != NULL)
@@ -317,32 +322,51 @@ gfc_conv_variable (gfc_se * se, gfc_expr * expr)
 
       se->expr = gfc_get_symbol_decl (sym);
 
+      /* Deal with references to a parent results or entries by storing
+	 the current_function_decl and moving to the parent_decl.  */
+      parent_flag = 0;
+
+      return_value = sym->attr.function && sym->result == sym;
+      alternate_entry = sym->attr.function && sym->attr.entry
+			  && sym->result == sym;
+      entry_master = sym->attr.result
+			&& sym->ns->proc_name->attr.entry_master
+			&& !gfc_return_by_reference (sym->ns->proc_name);
+      parent_decl = DECL_CONTEXT (current_function_decl);
+
+      if ((se->expr == parent_decl && return_value)
+	    || (sym->ns  && sym->ns->proc_name
+		  && sym->ns->proc_name->backend_decl == parent_decl
+		  && (alternate_entry || entry_master)))
+	parent_flag = 1;
+      else
+	parent_flag = 0;
+
       /* Special case for assigning the return value of a function.
 	 Self recursive functions must have an explicit return value.  */
-      if (se->expr == current_function_decl && sym->attr.function
-	  && (sym->result == sym))
-	se_expr = gfc_get_fake_result_decl (sym);
+      if (sym->attr.function && sym->result == sym
+	    && (se->expr == current_function_decl || parent_flag))
+	se_expr = gfc_get_fake_result_decl (sym, parent_flag);
 
       /* Similarly for alternate entry points.  */
-      else if (sym->attr.function && sym->attr.entry
-	       && (sym->result == sym)
-	       && sym->ns->proc_name->backend_decl == current_function_decl)
+      else if (alternate_entry 
+		 && (sym->ns->proc_name->backend_decl == current_function_decl
+		        || parent_flag))
 	{
 	  gfc_entry_list *el = NULL;
 
 	  for (el = sym->ns->entries; el; el = el->next)
 	    if (sym == el->sym)
 	      {
-		se_expr = gfc_get_fake_result_decl (sym);
+		se_expr = gfc_get_fake_result_decl (sym, parent_flag);
 		break;
 	      }
 	}
 
-      else if (sym->attr.result
-	       && sym->ns->proc_name->backend_decl == current_function_decl
-	       && sym->ns->proc_name->attr.entry_master
-	       && !gfc_return_by_reference (sym->ns->proc_name))
-	se_expr = gfc_get_fake_result_decl (sym);
+      else if (entry_master
+		 && (sym->ns->proc_name->backend_decl == current_function_decl
+			|| parent_flag))
+	se_expr = gfc_get_fake_result_decl (sym, parent_flag);
 
       if (se_expr)
 	se->expr = se_expr;
diff --git a/gcc/fortran/trans-intrinsic.c b/gcc/fortran/trans-intrinsic.c
index 39ac939..6ec0a51 100644
--- a/gcc/fortran/trans-intrinsic.c
+++ b/gcc/fortran/trans-intrinsic.c
@@ -2269,7 +2269,7 @@ gfc_conv_intrinsic_len (gfc_se * se, gfc_expr * expr)
 	    decl = gfc_get_symbol_decl (sym);
 	    if (decl == current_function_decl && sym->attr.function
 		&& (sym->result == sym))
-	      decl = gfc_get_fake_result_decl (sym);
+	      decl = gfc_get_fake_result_decl (sym, 0);
 
 	    len = sym->ts.cl->backend_decl;
 	    gcc_assert (len);
diff --git a/gcc/fortran/trans-openmp.c b/gcc/fortran/trans-openmp.c
index 44be1b7..df8723b 100644
--- a/gcc/fortran/trans-openmp.c
+++ b/gcc/fortran/trans-openmp.c
@@ -182,6 +182,9 @@ gfc_trans_add_clause (tree node, tree tail)
   return node;
 }
 
+/* TODO make references to parent function results, as done in
+   gfc_conv_variable.  */
+
 static tree
 gfc_trans_omp_variable (gfc_symbol *sym)
 {
@@ -191,7 +194,7 @@ gfc_trans_omp_variable (gfc_symbol *sym)
      Self recursive functions must have an explicit return value.  */
   if (t == current_function_decl && sym->attr.function
       && (sym->result == sym))
-    t = gfc_get_fake_result_decl (sym);
+    t = gfc_get_fake_result_decl (sym, 0);
 
   /* Similarly for alternate entry points.  */
   else if (sym->attr.function && sym->attr.entry
@@ -203,7 +206,7 @@ gfc_trans_omp_variable (gfc_symbol *sym)
       for (el = sym->ns->entries; el; el = el->next)
 	if (sym == el->sym)
 	  {
-	    t = gfc_get_fake_result_decl (sym);
+	    t = gfc_get_fake_result_decl (sym, 0);
 	    break;
 	  }
     }
@@ -212,7 +215,7 @@ gfc_trans_omp_variable (gfc_symbol *sym)
 	   && sym->ns->proc_name->backend_decl == current_function_decl
 	   && sym->ns->proc_name->attr.entry_master
 	   && !gfc_return_by_reference (sym->ns->proc_name))
-    t = gfc_get_fake_result_decl (sym);
+    t = gfc_get_fake_result_decl (sym, 0);
 
   return t;
 }
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 2ec8ba7..b3141ca 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -309,7 +309,7 @@ gfc_trans_return (gfc_code * code ATTRIBUTE_UNUSED)
          in a subroutine and current_fake_result_decl has already
 	 been generated.  */
 
-      result = gfc_get_fake_result_decl (NULL);
+      result = gfc_get_fake_result_decl (NULL, 0);
       if (!result)
         {
           gfc_warning ("An alternate return at %L without a * dummy argument",
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 89f4058..e571df9 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -361,7 +361,7 @@ tree gfc_build_label_decl (tree);
 
 /* Return the decl used to hold the function return value.
    Do not use if the function has an explicit result variable.  */
-tree gfc_get_fake_result_decl (gfc_symbol *);
+tree gfc_get_fake_result_decl (gfc_symbol *, int);
 
 /* Get the return label for the current function.  */
 tree gfc_get_return_label (void);
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 8329ae4..b1d03cf 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,14 @@
+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.
+
 2006-03-06  Steven G. Kargl  <kargls@comcast.net>
 
 	* gfortran.dg/verify_2.f90: New test.
@@ -29,7 +40,7 @@
 	PR c++/15759
 	* g++.dg/other/default4.C: New test.
 
-2005-03-05  Erik Edelmann  <eedelman@gcc.gnu.org>
+2006-03-05  Erik Edelmann  <eedelman@gcc.gnu.org>
 
 	PR fortran/16136
 	* allocatable_dummy_1.f90: New.
@@ -300,7 +311,7 @@
 	PR fortran/26201
 	* gfortran.dg/convert_1.f90: New.
 
-2005-02-19  Paul Thomas  <pault@gcc.gnu.org>
+2006-02-19  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/25054
 	* gfortran.dg/namelist_5.f90: New test.
@@ -396,7 +407,7 @@
 	vect-reduc-pattern-1a.c, vect-reduc-pattern-1b.c and
 	vect-reduc-pattern-1c.c
 
-2005-02-16  Paul Thomas  <pault@gcc.gnu.org>
+2006-02-16  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/24557
         * gfortran.dg/assumed_charlen_needed_1.f90: New test.
@@ -710,7 +721,7 @@
 	* g++.old-deja/g++.pt/ttp26.C: Likewise.
 	* g++.old-deja/g++.pt/ttp36.C: Likewise.
 
-2005-02-06  Thomas Koenig  <Thomas.Koenig@online.de>
+2006-02-06  Thomas Koenig  <Thomas.Koenig@online.de>
 
 	PR libfortran/23815
 	* unf_io_convert_4.f90:  New test.
@@ -876,7 +887,7 @@
 	* gcc.target/i386/sselibm-4.c: Likewise.
 	* gcc.target/i386/sselibm-5.c: Likewise.
 
-2005-01-30  Erik Edelmann  <eedelman@gcc.gnu.org>
+2006-01-30  Erik Edelmann  <eedelman@gcc.gnu.org>
 
 	PR fortran/24266
 	* gfortran.dg/arrayio_derived_2.f90: New.
@@ -971,7 +982,7 @@
 
 	* gcc.dg/pragma-re-4.c: New test.
 
-2005-01-27  Paul Thomas  <pault@gcc.gnu.org>
+2006-01-27  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/25964
 	* gfortran.dg/assumed_size_refs_3.f90: New test.
@@ -989,7 +1000,7 @@
 	* ada/acats/tests/c9/c97305c.ada: Likewise.
 	* ada/acats/tests/c9/c99004a.ada: Likewise.
 
-2005-01-26  Paul Thomas  <pault@gcc.gnu.org>
+2006-01-26  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/25964
 	* gfortran.dg/global_references_2.f90: New test.
@@ -1112,7 +1123,7 @@
 	* gcc.dg/torture/pr25654.c: New testcase.
 	* gcc.target/i386/pr25654.c: Likewise.
 
-2005-01-23  Paul Thomas  <pault@gcc.gnu.org>
+2006-01-23  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/25901
 	* gfortran.dg/internal references_2.f90: New test.
@@ -1142,7 +1153,7 @@
 	PR c++/25858
 	* g++.dg/template/crash44.C: New test.
 
-2005-01-21  Paul Thomas  <pault@gcc.gnu.org>
+2006-01-21  Paul Thomas  <pault@gcc.gnu.org>
 
 	PR fortran/25124
 	PR fortran/25625
diff --git a/gcc/testsuite/gfortran.dg/parent_result_ref_1.f90 b/gcc/testsuite/gfortran.dg/parent_result_ref_1.f90
new file mode 100644
index 0000000..c1c7c3d
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parent_result_ref_1.f90
@@ -0,0 +1,19 @@
+! { dg-do run }

+! Tests the fix for PR19546 in which an ICE would result from

+! setting the parent result in a contained procedure. 

+! From the testcase of Francois-Xavier Coudert/Tobias Schlueter

+! 

+function f()

+  integer :: f

+  f = 42

+  call sub ()

+  if (f.eq.1) f = f + 1

+contains

+  subroutine sub

+    if (f.eq.42) f = f - 41

+  end subroutine sub

+end function f

+

+  integer, external :: f

+  if (f ().ne.2) call abort ()

+end

diff --git a/gcc/testsuite/gfortran.dg/parent_result_ref_2.f90 b/gcc/testsuite/gfortran.dg/parent_result_ref_2.f90
new file mode 100644
index 0000000..2409cb4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parent_result_ref_2.f90
@@ -0,0 +1,35 @@
+! { dg-do run }

+! Tests the fix for PR19546 in which an ICE would result from

+! setting the parent result in a contained procedure. 

+! This case tests character results.

+! 

+function f()
+  character(4) :: f
+  f = "efgh"
+  call sub ()
+  if (f.eq."iklm") f = "abcd"
+  call sub ()
+contains
+  subroutine sub
+    f = "wxyz"
+    if (f.eq."efgh") f = "iklm"
+  end subroutine sub
+end function f
+
+function g()              ! { dg-warning "is obsolescent in fortran 95" }
+  character(*) :: g
+  g = "efgh"
+  call sub ()
+  if (g.eq."iklm") g = "ABCD"
+  call sub ()
+contains
+  subroutine sub
+    g = "WXYZ"
+    if (g.eq."efgh") g = "iklm"
+  end subroutine sub
+end function g
+
+  character(4), external :: f, g

+  if (f ().ne."wxyz") call abort ()
+  if (g ().ne."WXYZ") call abort ()
+end

diff --git a/gcc/testsuite/gfortran.dg/parent_result_ref_3.f90 b/gcc/testsuite/gfortran.dg/parent_result_ref_3.f90
new file mode 100755
index 0000000..f8e93ff
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parent_result_ref_3.f90
@@ -0,0 +1,28 @@
+! { dg-do run }

+! Tests the fix for PR19546 in which an ICE would result from

+! setting the parent result in a contained procedure. 

+! Check that parent alternate entry results can be referenced.

+! 

+function f()

+  integer :: f, g

+  f = 42

+  call sub1 ()

+  if (f.eq.1) f = 2

+  return

+entry g()

+  g = 99

+  call sub2 ()
+  if (g.eq.77) g = 33

+contains

+  subroutine sub1

+    if (f.eq.42) f = 1

+  end subroutine sub1

+  subroutine sub2

+    if (g.eq.99) g = g - 22

+  end subroutine sub2

+end function f

+

+  integer, external :: f, g

+  if (f ().ne.2) call abort ()
+  if (g ().ne.33) call abort ()

+end

diff --git a/gcc/testsuite/gfortran.dg/parent_result_ref_4.f90 b/gcc/testsuite/gfortran.dg/parent_result_ref_4.f90
new file mode 100644
index 0000000..d8c84e7
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/parent_result_ref_4.f90
@@ -0,0 +1,22 @@
+! { dg-do run }

+! Tests the fix for PR19546 in which an ICE would result from

+! setting the parent result in a contained procedure. 

+! Check that parent function results can be referenced in modules.

+!
+module m
+contains

+  function f()

+    integer :: f

+    f = 42

+    call sub ()

+    if (f.eq.1) f = f + 1

+  contains

+    subroutine sub

+     if (f.eq.42) f = f - 41

+    end subroutine sub

+  end function f
+end module m

+

+  use m

+  if (f ().ne.2) call abort ()

+end

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 0000000..4b0b8ae
--- /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