re PR fortran/52102 ([OOP] Wrong result with ALLOCATE of CLASS components with array constructor SOURCE-expr)

2012-02-05  Paul Thomas  <pault@gcc.gnu.org>

	* trans-array.c (gfc_array_allocate): Zero memory for all class
	array allocations.
	* trans-stmt.c (gfc_trans_allocate): Ditto for class scalars.

	PR fortran/52102
	* trans-stmt.c (gfc_trans_allocate): Before correcting a class
	array reference, ensure that 'dataref' points to the _data
	component that is followed by the array reference..

2012-02-05  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/52102
	* gfortran.dg/class_48.f90 : Add test of allocate class array
	component with source in subroutine test3.  Remove commenting
	out in subroutine test4, since branching on unitialized variable
	is now fixed (no PR for this last.).

From-SVN: r183915

5 files changed, 80 insertions, 38 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index db369ab..e1e81b7 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,14 @@
+2012-02-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	* trans-array.c (gfc_array_allocate): Zero memory for all class
+	array allocations.
+	* trans-stmt.c (gfc_trans_allocate): Ditto for class scalars.
+
+	PR fortran/52102
+	* trans-stmt.c (gfc_trans_allocate): Before correcting a class
+	array reference, ensure that 'dataref' points to the _data
+	component that is followed by the array reference..
+
 2012-02-02  Mikael Morin  <mikael@gcc.gnu.org>
 
 	PR fortran/41587
diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c
index d3c81a8..edcde5c 100644
--- a/gcc/fortran/trans-array.c
+++ b/gcc/fortran/trans-array.c
@@ -5111,8 +5111,7 @@ gfc_array_allocate (gfc_se * se, gfc_expr * expr, tree status, tree errmsg,
 
   gfc_add_expr_to_block (&se->pre, tmp);
 
-  if (expr->ts.type == BT_CLASS
-	&& (expr3_elem_size != NULL_TREE || expr3))
+  if (expr->ts.type == BT_CLASS)
     {
       tmp = build_int_cst (unsigned_char_type_node, 0);
       /* With class objects, it is best to play safe and null the 
diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 7a6f8b2..7d094b0 100644
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -4957,7 +4957,7 @@ gfc_trans_allocate (gfc_code * code)
 	      tmp = gfc_nullify_alloc_comp (expr->ts.u.derived, tmp, 0);
 	      gfc_add_expr_to_block (&se.pre, tmp);
 	    }
-	  else if (al->expr->ts.type == BT_CLASS && code->expr3)
+	  else if (al->expr->ts.type == BT_CLASS)
 	    {
 	      /* With class objects, it is best to play safe and null the 
 		 memory because we cannot know if dynamic types have allocatable
@@ -5076,7 +5076,13 @@ gfc_trans_allocate (gfc_code * code)
 	      actual->next->expr = gfc_copy_expr (al->expr);
 	      actual->next->expr->ts.type = BT_CLASS;
 	      gfc_add_data_component (actual->next->expr);
+
 	      dataref = actual->next->expr->ref;
+	      /* Make sure we go up through the reference chain to
+		 the _data reference, where the arrayspec is found.  */
+	      while (dataref->next && dataref->next->type != REF_ARRAY)
+		dataref = dataref->next;
+
 	      if (dataref->u.c.component->as)
 		{
 		  int dim;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 50143e4..4c9c499 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,11 @@
+2012-02-05  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/52102
+	* gfortran.dg/class_48.f90 : Add test of allocate class array
+	component with source in subroutine test3.  Remove commenting
+	out in subroutine test4, since branching on unitialized variable
+	is now fixed (no PR for this last.).
+
 2012-02-05  Richard Sandiford  <rdsandiford@googlemail.com>
 
 	* gcc.dg/tree-prof/stringop-2.c (main): Add a nomips16 attribute
diff --git a/gcc/testsuite/gfortran.dg/class_48.f90 b/gcc/testsuite/gfortran.dg/class_48.f90
index c1bab8e..37ee862 100644
--- a/gcc/testsuite/gfortran.dg/class_48.f90
+++ b/gcc/testsuite/gfortran.dg/class_48.f90
@@ -1,6 +1,7 @@
 ! { dg-do run }
 !
 ! PR fortran/51972
+! Also tests fixes for PR52102
 !
 ! Check whether DT assignment with polymorphic components works.
 !
@@ -70,10 +71,11 @@ subroutine test3 ()
 
   type(t2) :: one, two
 
-  allocate (two%a(2))
-  two%a(1)%x = 4
-  two%a(2)%x = 6
+! Test allocate with array source - PR52102
+  allocate (two%a(2), source = [t(4), t(6)])
+
   if (allocated (one%a)) call abort ()
+
   one = two
   if (.not.allocated (one%a)) call abort ()
 
@@ -82,6 +84,24 @@ subroutine test3 ()
 
   deallocate (two%a)
   one = two
+
+  if (allocated (one%a)) call abort ()
+
+! Test allocate with no source followed by assignments.
+  allocate (two%a(2))
+  two%a(1)%x = 5
+  two%a(2)%x = 7
+
+  if (allocated (one%a)) call abort ()
+
+  one = two
+  if (.not.allocated (one%a)) call abort ()
+
+  if ((one%a(1)%x /= 5)) call abort ()
+  if ((one%a(2)%x /= 7)) call abort ()
+
+  deallocate (two%a)
+  one = two
   if (allocated (one%a)) call abort ()
 end subroutine test3
 
@@ -98,38 +118,35 @@ subroutine test4 ()
 
   if (allocated (one%a)) call abort ()
   if (allocated (two%a)) call abort ()
-!
-! FIXME: Fails due to PR 51754
-!
-! NOTE: Might be only visible with MALLOC_PERTURB_ or with valgrind
-!
-!  allocate (two%a(2))
-!  if (allocated (two%a(1)%x)) call abort ()
-!  if (allocated (two%a(2)%x)) call abort ()
-!  allocate (two%a(1)%x(3), source=[1,2,3])
-!  allocate (two%a(2)%x(5), source=[5,6,7,8,9])
-!  one = two
-!  if (.not. allocated (one%a)) call abort ()
-!  if (.not. allocated (one%a(1)%x)) call abort ()
-!  if (.not. allocated (one%a(2)%x)) call abort ()
-!
-!  if (size(one%a) /= 2) call abort()
-!  if (size(one%a(1)%x) /= 3) call abort()
-!  if (size(one%a(2)%x) /= 5) call abort()
-!  if (any (one%a(1)%x /= [1,2,3])) call abort ()
-!  if (any (one%a(2)%x /= [5,6,7,8,9])) call abort ()
-!
-!  deallocate (two%a(1)%x)
-!  one = two
-!  if (.not. allocated (one%a)) call abort ()
-!  if (allocated (one%a(1)%x)) call abort ()
-!  if (.not. allocated (one%a(2)%x)) call abort ()
-!
-!  if (size(one%a) /= 2) call abort()
-!  if (size(one%a(2)%x) /= 5) call abort()
-!  if (any (one%a(2)%x /= [5,6,7,8,9])) call abort ()
-!
-!  deallocate (two%a)
+
+  allocate (two%a(2))
+
+  if (allocated (two%a(1)%x)) call abort ()
+  if (allocated (two%a(2)%x)) call abort ()
+  allocate (two%a(1)%x(3), source=[1,2,3])
+  allocate (two%a(2)%x(5), source=[5,6,7,8,9])
+  one = two
+  if (.not. allocated (one%a)) call abort ()
+  if (.not. allocated (one%a(1)%x)) call abort ()
+  if (.not. allocated (one%a(2)%x)) call abort ()
+
+  if (size(one%a) /= 2) call abort()
+  if (size(one%a(1)%x) /= 3) call abort()
+  if (size(one%a(2)%x) /= 5) call abort()
+  if (any (one%a(1)%x /= [1,2,3])) call abort ()
+  if (any (one%a(2)%x /= [5,6,7,8,9])) call abort ()
+
+  deallocate (two%a(1)%x)
+  one = two
+  if (.not. allocated (one%a)) call abort ()
+  if (allocated (one%a(1)%x)) call abort ()
+  if (.not. allocated (one%a(2)%x)) call abort ()
+
+  if (size(one%a) /= 2) call abort()
+  if (size(one%a(2)%x) /= 5) call abort()
+  if (any (one%a(2)%x /= [5,6,7,8,9])) call abort ()
+
+  deallocate (two%a)
   one = two
   if (allocated (one%a)) call abort ()
   if (allocated (two%a)) call abort ()
@@ -141,3 +158,4 @@ call test2 ()
 call test3 ()
 call test4 ()
 end
+