re PR fortran/54784 ([OOP] wrong code in polymorphic allocation with SOURCE)

2012-10-11  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/54784
	* trans-stmt.c (gfc_trans_allocate): Correctly determine the reference
	to the _data component for polymorphic allocation with SOURCE.

2012-10-11  Janus Weil  <janus@gcc.gnu.org>

	PR fortran/54784
	* gfortran.dg/class_allocate_13.f90: New.

From-SVN: r192374

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 7a3092a420c64bed97ed040356fbe38ccbfe2eb7..a3d282b15a88a3c84d157206917ea6503795c2f5 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2012-10-11  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/54784
+       * trans-stmt.c (gfc_trans_allocate): Correctly determine the reference
+       to the _data component for polymorphic allocation with SOURCE.
+
 2012-10-06  Janus Weil  <janus@gcc.gnu.org>
 
        PR fortran/54832

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index 204f069cc537864c955c22bfd58414308cf05d95..bfcb6869baa2d8f303bec858e5ef8f98629fe05c 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5130,7 +5130,7 @@ gfc_trans_allocate (gfc_code * code)
              gfc_actual_arglist *actual;
              gfc_expr *ppc;
              gfc_code *ppc_code;
-             gfc_ref *dataref;
+             gfc_ref *ref, *dataref;
 
              /* Do a polymorphic deep copy.  */
              actual = gfc_get_actual_arglist ();
@@ -5142,13 +5142,15 @@ gfc_trans_allocate (gfc_code * code)
              actual->next->expr->ts.type = BT_CLASS;
              gfc_add_data_component (actual->next->expr);
 
-             dataref = actual->next->expr->ref;
+             dataref = NULL;
              /* 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;
+             for (ref = actual->next->expr->ref; ref; ref = ref->next)
+               if (ref->type == REF_COMPONENT
+                   && strcmp (ref->u.c.component->name, "_data") == 0)
+                 dataref = ref;
 
-             if (dataref->u.c.component->as)
+             if (dataref && dataref->u.c.component->as)
                {
                  int dim;
                  gfc_expr *temp;

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index f61808510855708d30d18cccbea59a6c1831effb..ff44d480c9815be0ae25ca1939b48754d6e4fd9e 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-10-11  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/54784
+       * gfortran.dg/class_allocate_13.f90: New.
+
 2012-10-11  Jason Merrill  <jason@redhat.com>
 
        * g++.dg/ext/visibility/pragma-override1.C: Fix target markup.

diff --git a/gcc/testsuite/gfortran.dg/class_allocate_13.f90 b/gcc/testsuite/gfortran.dg/class_allocate_13.f90
new file mode 100644 (file)
index 0000000..64f37dc
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/class_allocate_13.f90
@@ -0,0 +1,31 @@
+! { dg-do run }
+!
+! PR 54784: [4.7/4.8 Regression] [OOP] wrong code in polymorphic allocation with SOURCE
+!
+! Contributed by Jeremy Kozdon <jkozdon@gmail.com>
+
+program bug
+  implicit none
+
+  type :: block
+    real, allocatable :: fields
+  end type
+
+  type :: list
+    class(block),allocatable :: B
+  end type
+
+  type :: domain
+    type(list),dimension(2) :: L
+  end type
+
+  type(domain) :: d
+  type(block) :: b1
+
+  allocate(b1%fields,source=5.)
+  
+  allocate(d%L(2)%B,source=b1)           ! wrong code
+  
+  if (d%L(2)%B%fields/=5.) call abort()
+
+end program