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

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@183915 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index db369ab0feb701146b71925b01c8ff357a9ba711..e1e81b7f4dcda6f8229538f7001eaf92ee6b7817 100644 (file)
--- 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 d3c81a82ab8381ab02143267d02606e1a7bd0b4c..edcde5c4c0cb4bec3713b947681e849ec1a81963 100644 (file)
--- 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 7a6f8b2b419a8b17667a567e7b8d92fa97532204..7d094b0311eeb55b260c372637c74ed6c74bd2dd 100644 (file)
--- 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 50143e4d6fd35541f17a3deafecc978ab3e9a0ff..4c9c499c60536898a5bb76746d5cdbbc967b0ea4 100644 (file)
--- 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 c1bab8ef0d59dd8d099a1c08df8777f5bb334c99..37ee8626c351c5fcd961c230a7edb0817623a34b 100644 (file)
--- 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,16 +71,35 @@ 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 ()
 
   if ((one%a(1)%x /= 4)) call abort ()
   if ((one%a(2)%x /= 6)) call abort ()
 
+  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 ()
@@ -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
+