re PR fortran/31630 (ICE on nasty derived types code)

2007-04-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31630
	* resolve.c (resolve_symbol): Allow resolution of formal
	namespaces nested within formal namespaces coming from modules.

	PR fortran/31620
	* trans-expr.c (gfc_trans_assignment): Make the call to
	gfc_trans_zero_assign conditional on the lhs array ref being
	the only reference.

2007-04-23  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/31630
	* gfortran.dg/used_types_17.f90: New test.

	PR fortran/31620
	* gfortran.dg/zero_array_components_1.f90: New test.

From-SVN: r124069

gcc/fortran/ChangeLog

@@ -1,3 +1,14 @@
+2007-04-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31630
+	* resolve.c (resolve_symbol): Allow resolution of formal
+	namespaces nested within formal namespaces coming from modules.
+
+	PR fortran/31620
+	* trans-expr.c (gfc_trans_assignment): Make the call to
+	gfc_trans_zero_assign conditional on the lhs array ref being
+	the only reference.
+
 2007-04-23  Tobias Burnus  <burnus@net-b.de>
 
 	* primary.c (match_integer_constant): Mention -fno-range-check

gcc/fortran/resolve.c

@@ -6339,12 +6339,15 @@ resolve_symbol (gfc_symbol *sym)
 
   formal_arg_flag = 0;
 
-  /* Resolve formal namespaces.  */
-
+  /* Resolve formal namespaces.  The symbols in formal namespaces that
+     themselves are from procedures in formal namespaces will not stand
+     resolution, except when they are use associated.
+     TODO: Fix the symbols in formal namespaces so that resolution can
+     be done unconditionally.  */
   if (formal_ns_flag && sym != NULL && sym->formal_ns != NULL)
     {
       formal_ns_save = formal_ns_flag;
-      formal_ns_flag = 0;
+      formal_ns_flag = sym->attr.use_assoc ? 1 : 0;
       gfc_resolve (sym->formal_ns);
       formal_ns_flag = formal_ns_save;
     }

gcc/fortran/trans-expr.c

@@ -3943,6 +3943,7 @@ gfc_trans_assignment (gfc_expr * expr1, gfc_expr * expr2, bool init_flag)
   if (expr1->expr_type == EXPR_VARIABLE
       && expr1->rank > 0
       && expr1->ref
+      && expr1->ref->next == NULL
       && gfc_full_array_ref_p (expr1->ref)
       && is_zero_initializer_p (expr2))
     {

gcc/testsuite/ChangeLog

@@ -1,3 +1,11 @@
+2007-04-23  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/31630
+	* gfortran.dg/used_types_17.f90: New test.
+
+	PR fortran/31620
+	* gfortran.dg/zero_array_components_1.f90: New test.
+
 2007-04-23  Kaveh R. Ghazi  <ghazi@caip.rutgers.edu>
 
 	PR fortran/31616

gcc/testsuite/gfortran.dg/used_types_17.f90

@@ -0,0 +1,50 @@
+! { dg do-compile }
+! Tests the fix for PR31630, in which the association of the argument
+! of 'cmp' did not work.
+!
+! Contributed by Francois-Xavier Coudert <fxcoudert@gcc.gnu.org>
+!
+module box_module
+  type box
+    integer :: m = 0
+  end type box
+end module box_module
+
+module sort_box_module
+contains
+
+  subroutine heapsort_box(cmp)
+    interface
+       subroutine cmp(a)
+         use box_module
+         type(box) :: a
+       end subroutine cmp
+    end interface
+    optional :: cmp
+  end subroutine heapsort_box
+
+end module sort_box_module
+
+
+module boxarray_module
+  use box_module
+  implicit none
+
+  type boxarray
+    type(box), allocatable :: bxs(:)
+  end type boxarray
+contains
+
+  subroutine boxarray_build_l(ba)
+    type(boxarray) :: ba
+    allocate(ba%bxs(1))
+  end subroutine boxarray_build_l
+
+  subroutine boxarray_sort()
+    use sort_box_module
+    call heapsort_box
+  end subroutine boxarray_sort
+
+end module boxarray_module
+
+! { dg-final { cleanup-modules "box_module sort_box_module boxarray_module" } }

gcc/testsuite/gfortran.dg/zero_array_components_1.f90

@@ -0,0 +1,17 @@
+! { dg do-run }
+! Tests the fix for PR31620, in which zeroing the component a for the array,
+! would zero all the components of the array.
+!
+! David Ham <David@ham.dropbear.id.au>
+!
+program test_assign
+  type my_type
+     integer :: a
+     integer :: b
+  end type my_type
+  type(my_type), dimension(1) :: mine        ! note that MINE is an array
+  mine%b=4
+  mine%a=1
+  mine%a=0
+  if (any (mine%b .ne. 4)) call abort ()
+end program test_assign