re PR fortran/28885 (ICE passing components of array of derived type)

2006-08-30  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/28885
	REGRESSION FIX
	* trans-expr.c (gfc_conv_aliased_arg): Ensure that the temp
	declaration is retained for INTENT(OUT) arguments.

	PR fortran/28873
	REGRESSION FIX
	PR fortran/20067
	* resolve.c (resolve_generic_f): Make error message more
	comprehensible.
	(resolve_generic_s): Restructure search for specific procedures
	to be similar to resolve_generic_f and change to similar error
	message.  Ensure that symbol reference is refreshed, in case
	the search produces a NULL.
	(resolve_specific_s): Restructure search, as above and as
	resolve_specific_f. Ensure that symbol reference is refreshed,
	in case the search produces a NULL.

	PR fortran/25077
	PR fortran/25102
	* interface.c (check_operator_interface): Throw error if the
	interface assignment tries to change intrinsic type assigments
	or has less than two arguments.  Also, it is an error if an
	interface operator contains an alternate return.

	PR fortran/24866
	* parse.c (gfc_fixup_sibling_symbols): Do not modify the symbol
	if it is a dummy in the contained namespace.


2006-08-30  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/28885
	* gfortran.dg/aliasing_dummy_2.f90: New test.

	PR fortran/20067
	* gfortran.dg/generic_5.f90: Change error message.

	PR fortran/28873
	* gfortran.dg/generic_6.f90: New test.

	PR fortran/25077
	* gfortran.dg/redefined_intrinsic_assignment.f90: New test.

	PR fortran/25102
	* gfortran.dg/invalid_interface_assignment.f90: New test.

	PR fortran/24866
	* gfortran.dg/module_proc_external_dummy.f90: New test.

From-SVN: r116578

5 files changed, 92 insertions, 30 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index aeb3cb9..ce38af8 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,34 @@
+2006-08-30  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/28885
+	REGRESSION FIX
+	* trans-expr.c (gfc_conv_aliased_arg): Ensure that the temp
+	declaration is retained for INTENT(OUT) arguments.
+
+	PR fortran/28873
+	REGRESSION FIX
+	PR fortran/20067
+	* resolve.c (resolve_generic_f): Make error message more
+	comprehensible.
+	(resolve_generic_s): Restructure search for specific procedures
+	to be similar to resolve_generic_f and change to similar error
+	message.  Ensure that symbol reference is refreshed, in case
+	the search produces a NULL.
+	(resolve_specific_s): Restructure search, as above and as
+	resolve_specific_f. Ensure that symbol reference is refreshed,
+	in case the search produces a NULL.
+
+	PR fortran/25077
+	PR fortran/25102
+	* interface.c (check_operator_interface): Throw error if the
+	interface assignment tries to change intrinsic type assigments
+	or has less than two arguments.  Also, it is an error if an
+	interface operator contains an alternate return.
+
+	PR fortran/24866
+	* parse.c (gfc_fixup_sibling_symbols): Do not modify the symbol
+	if it is a dummy in the contained namespace.
+
 2006-08-29  Steven G. Kargl  <kargls@comcast.net>
 
 	PR fortran/28866
diff --git a/gcc/fortran/interface.c b/gcc/fortran/interface.c
index f1d968d..47fc79b 100644
--- a/gcc/fortran/interface.c
+++ b/gcc/fortran/interface.c
@@ -503,7 +503,12 @@ check_operator_interface (gfc_interface * intr, gfc_intrinsic_op operator)
   for (formal = intr->sym->formal; formal; formal = formal->next)
     {
       sym = formal->sym;
-
+      if (sym == NULL)
+	{
+	  gfc_error ("Alternate return cannot appear in operator "
+		     "interface at %L", &intr->where);
+	  return;
+	}
       if (args == 0)
 	{
 	  t1 = sym->ts.type;
@@ -531,6 +536,24 @@ check_operator_interface (gfc_interface * intr, gfc_intrinsic_op operator)
 	     &intr->where);
 	  return;
 	}
+      if (args != 2)
+	{
+	  gfc_error
+	    ("Assignment operator interface at %L must have two arguments",
+	     &intr->where);
+	  return;
+	}
+      if (sym->formal->sym->ts.type != BT_DERIVED
+	    && sym->formal->next->sym->ts.type != BT_DERIVED
+	    && (sym->formal->sym->ts.type == sym->formal->next->sym->ts.type
+		  || (gfc_numeric_ts (&sym->formal->sym->ts)
+			&& gfc_numeric_ts (&sym->formal->next->sym->ts))))
+	{
+	  gfc_error
+	    ("Assignment operator interface at %L must not redefine "
+	     "an INTRINSIC type assignment", &intr->where);
+	  return;
+	}
     }
   else
     {
diff --git a/gcc/fortran/parse.c b/gcc/fortran/parse.c
index 0416d28..9ac7e45 100644
--- a/gcc/fortran/parse.c
+++ b/gcc/fortran/parse.c
@@ -2706,8 +2706,9 @@ gfc_fixup_sibling_symbols (gfc_symbol * sym, gfc_namespace * siblings)
   for (ns = siblings; ns; ns = ns->sibling)
     {
       gfc_find_sym_tree (sym->name, ns, 0, &st);
-      if (!st)
-        continue;
+
+      if (!st || (st->n.sym->attr.dummy && ns == st->n.sym->ns))
+	continue;
 
       old_sym = st->n.sym;
       if ((old_sym->attr.flavor == FL_PROCEDURE
diff --git a/gcc/fortran/resolve.c b/gcc/fortran/resolve.c
index 3924dc6..f1606b1 100644
--- a/gcc/fortran/resolve.c
+++ b/gcc/fortran/resolve.c
@@ -1181,7 +1181,7 @@ generic:
 
   if (!gfc_generic_intrinsic (expr->symtree->n.sym->name))
     {
-      gfc_error ("Generic function '%s' at %L is not an intrinsic function",
+      gfc_error ("There is no specific function for the generic '%s' at %L",
 		 expr->symtree->n.sym->name, &expr->where);
       return FAILURE;
     }
@@ -1614,31 +1614,31 @@ resolve_generic_s (gfc_code * c)
 
   sym = c->symtree->n.sym;
 
-  m = resolve_generic_s0 (c, sym);
-  if (m == MATCH_YES)
-    return SUCCESS;
-  if (m == MATCH_ERROR)
-    return FAILURE;
-
-  if (sym->ns->parent != NULL && !sym->attr.use_assoc)
+  for (;;)
     {
+      m = resolve_generic_s0 (c, sym);
+      if (m == MATCH_YES)
+	return SUCCESS;
+      else if (m == MATCH_ERROR)
+	return FAILURE;
+
+generic:
+      if (sym->ns->parent == NULL)
+	break;
       gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
-      if (sym != NULL)
-	{
-	  m = resolve_generic_s0 (c, sym);
-	  if (m == MATCH_YES)
-	    return SUCCESS;
-	  if (m == MATCH_ERROR)
-	    return FAILURE;
-	}
+
+      if (sym == NULL)
+	break;
+      if (!generic_sym (sym))
+	goto generic;
     }
 
   /* Last ditch attempt.  */
-
+  sym = c->symtree->n.sym;
   if (!gfc_generic_intrinsic (sym->name))
     {
       gfc_error
-	("Generic subroutine '%s' at %L is not an intrinsic subroutine",
+	("There is no specific subroutine for the generic '%s' at %L",
 	 sym->name, &c->loc);
       return FAILURE;
     }
@@ -1708,23 +1708,24 @@ resolve_specific_s (gfc_code * c)
 
   sym = c->symtree->n.sym;
 
-  m = resolve_specific_s0 (c, sym);
-  if (m == MATCH_YES)
-    return SUCCESS;
-  if (m == MATCH_ERROR)
-    return FAILURE;
-
-  gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
-
-  if (sym != NULL)
+  for (;;)
     {
       m = resolve_specific_s0 (c, sym);
       if (m == MATCH_YES)
 	return SUCCESS;
       if (m == MATCH_ERROR)
 	return FAILURE;
+
+      if (sym->ns->parent == NULL)
+	break;
+
+      gfc_find_symbol (sym->name, sym->ns->parent, 1, &sym);
+
+      if (sym == NULL)
+	break;
     }
 
+  sym = c->symtree->n.sym;
   gfc_error ("Unable to resolve the specific subroutine '%s' at %L",
 	     sym->name, &c->loc);
 
diff --git a/gcc/fortran/trans-expr.c b/gcc/fortran/trans-expr.c
index b1bd217..37bf782 100644
--- a/gcc/fortran/trans-expr.c
+++ b/gcc/fortran/trans-expr.c
@@ -1707,6 +1707,12 @@ gfc_conv_aliased_arg (gfc_se * parmse, gfc_expr * expr,
       gcc_assert (rse.ss == gfc_ss_terminator);
       gfc_trans_scalarizing_loops (&loop, &body);
     }
+  else
+    {
+      /* Make sure that the temporary declaration survives.  */
+      tmp = gfc_finish_block (&body);
+      gfc_add_expr_to_block (&loop.pre, tmp);
+    }
 
   /* Add the post block after the second loop, so that any
      freeing of allocated memory is done at the right time.  */