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

gcc/fortran/ChangeLog

+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

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
     {

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

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);
 

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.  */

gcc/testsuite/ChangeLog

+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.
+
 2006-08-29  Andrew Pinski  <pinskia@physics.uc.edu>
 
 	PR c++/28349

gcc/testsuite/gfortran.dg/aliasing_dummy_2.f90

+! { dg-do compile }
+! This tests the fix for PR28885, in which multiple calls to a procedure
+! with different components of an array of derived types for an INTENT(OUT)
+! argument caused an ICE internal compiler error.  This came about because
+! the compiler would lose the temporary declaration with each subsequent
+! call of the procedure.
+!
+! Reduced from the contribution by Drew McCormack  <drewmccormack@mac.com>
+!
+program test
+  type t
+    integer :: i
+    integer :: j
+  end type
+  type (t) :: a(5) 
+  call sub('one',a%j)
+  call sub('two',a%i)
+contains
+  subroutine sub(key,a)
+    integer, intent(out)    :: a(:) 
+    character(*),intent(in) :: key
+    a = 1   
+  end subroutine
+end program 

gcc/testsuite/gfortran.dg/generic_5.f90

@@ -23,7 +23,7 @@ MODULE provoke_ice
 CONTAINS
   SUBROUTINE provoke
     USE ice_gfortran
-    CALL ice(23.0)   ! { dg-error "is not an intrinsic subroutine" }
+    CALL ice(23.0)   ! { dg-error "no specific subroutine" }
   END SUBROUTINE
 END MODULE
-
+! { dg-final { cleanup-modules "ice_gfortran provoke_ice" } }

gcc/testsuite/gfortran.dg/generic_6.f90

+! { dg-do compile }
+! Tests the patch for PR28873, in which the call create () would cause an
+! error because resolve.c(resolve_generic_s) was failing to look in the
+! parent namespace for a matching specific subroutine. This, in fact, was
+! a regression due to the fix for PR28201.
+!
+! Contributed by Drew McCormack  <drewmccormack@mac.com> 
+!
+module A
+  private 
+  interface create
+    module procedure create1 
+  end interface
+  public :: create
+contains
+  subroutine create1
+    print *, "module A"
+  end subroutine
+end module
+
+module B
+  private 
+  interface create
+    module procedure create1 
+  end interface
+  public :: create
+contains
+  subroutine create1(a)
+    integer a
+    print *, "module B"
+  end subroutine
+end module
+
+module C
+  use A
+  private
+  public useCreate
+contains
+  subroutine useCreate
+    use B
+    call create()
+    call create(1)
+  end subroutine
+end module
+
+  use c
+  call useCreate
+end
+! { dg-final { cleanup-modules "A B C" } }

gcc/testsuite/gfortran.dg/invalid_interface_assignment.f90

+! { dg-do compile }
+! Tests the fix for PR25102, which did not diagnose the aberrant interface
+! assignement below.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+MODULE TT
+ TYPE data_type
+   INTEGER :: I
+ END TYPE data_type
+ INTERFACE ASSIGNMENT (=)
+   MODULE PROCEDURE set   ! { dg-error "Alternate return cannot appear" }
+ END INTERFACE
+CONTAINS
+  PURE SUBROUTINE set(x1,*)
+    TYPE(data_type), INTENT(OUT) :: x1
+    x1%i=0
+  END SUBROUTINE set
+END MODULE

gcc/testsuite/gfortran.dg/module_proc_external_dummy.f90

+! { dg-do compile }
+! This tests the fix for PR24866 in which the reference to the external str, in
+! sub_module, would get mixed up with the module procedure, str, thus
+! causing an ICE.  This is a completed version of the reporter's testcase; ie
+! it adds a main program and working subroutines to allow a check for
+! correct functioning.
+!
+! Contributed by Uttam Pawar  <uttamp@us.ibm.com>
+!
+   subroutine sub()
+     print *, "external sub"
+   end subroutine sub
+
+module test_module
+ contains
+   subroutine sub_module(str)
+     external :: str
+     call str ()
+   end subroutine sub_module
+   subroutine str()
+     print *, "module str"
+   end subroutine str
+end module test_module
+
+   use test_module
+   external sub
+   call sub_module (sub)
+   call sub_module (str)
+end

gcc/testsuite/gfortran.dg/redefined_intrinsic_assignment.f90

+! { dg-do compile }
+! Tests the fix for PR25077 in which no diagnostic was produced
+! for the redefinition of an intrinsic type assignment.
+!
+! Contributed by Joost VandeVondele  <jv244@cam.ac.uk>
+!
+MODULE M1
+ IMPLICIT NONE
+ INTERFACE ASSIGNMENT(=)
+  MODULE PROCEDURE T1 ! { dg-error "redefine an INTRINSIC type assignment" }
+ END INTERFACE
+CONTAINS
+ SUBROUTINE T1(I,J)
+   INTEGER, INTENT(OUT)  :: I
+   INTEGER, INTENT(IN)  :: J
+   I=-J
+ END SUBROUTINE T1
+END MODULE M1