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
This commit is contained in:
Janus Weil 2012-10-11 19:52:36 +02:00
parent a1dc74f2bf
commit e87924ab48
4 changed files with 49 additions and 5 deletions

View File

@ -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

View File

@ -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;

View File

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

View File

@ -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