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

gcc/fortran/ChangeLog

+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

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;

gcc/testsuite/ChangeLog

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

gcc/testsuite/gfortran.dg/class_allocate_13.f90

+! { 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