2012-10-14 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-14  Janus Weil  <janus@gcc.gnu.org>

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

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/branches/gcc-4_7-branch@192442 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fc827cb..688f572 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2012-10-14  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-09-20  Release Manager
 
        * GCC 4.7.2 released.

diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c
index bb3a890..630816e 100644 (file)
--- a/gcc/fortran/trans-stmt.c
+++ b/gcc/fortran/trans-stmt.c
@@ -5087,7 +5087,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 ();
@@ -5099,13 +5099,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 01975dc..bf01061 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2012-10-14  Janus Weil  <janus@gcc.gnu.org>
+
+       PR fortran/54784
+       * gfortran.dg/class_allocate_13.f90: New.
+
 2012-10-08  Terry Guo  <terry.guo@arm.com>
 
        Backported from mainline

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