From e87924ab48d86b6bf33ae6f33a6e4a0941fca970 Mon Sep 17 00:00:00 2001 From: Janus Weil Date: Thu, 11 Oct 2012 19:52:36 +0200 Subject: [PATCH] re PR fortran/54784 ([OOP] wrong code in polymorphic allocation with SOURCE) 2012-10-11 Janus Weil 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 PR fortran/54784 * gfortran.dg/class_allocate_13.f90: New. From-SVN: r192374 --- gcc/fortran/ChangeLog | 6 ++++ gcc/fortran/trans-stmt.c | 12 ++++--- gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/class_allocate_13.f90 | 31 +++++++++++++++++++ 4 files changed, 49 insertions(+), 5 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/class_allocate_13.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 7a3092a420c..a3d282b15a8 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2012-10-11 Janus Weil + + 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 PR fortran/54832 diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 204f069cc53..bfcb6869baa 100644 --- 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 f6180851085..ff44d480c98 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2012-10-11 Janus Weil + + PR fortran/54784 + * gfortran.dg/class_allocate_13.f90: New. + 2012-10-11 Jason Merrill * 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 index 00000000000..64f37dc59b5 --- /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 + +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 -- 2.30.2