From 85596a5e1ffa3e0f86da15cefa422ae8946db736 Mon Sep 17 00:00:00 2001 From: pault Date: Tue, 28 Jan 2014 20:10:22 +0000 Subject: [PATCH] 2014-01-28 Paul Thomas PR fortran/59414 * trans-stmt.c (gfc_trans_allocate): Before the pointer assignment to transfer the source _vptr to a class allocate expression, the final class reference should be exposed. The tail that includes the _data and array references is stored. This reduced expression is transferred to 'lhs' and the _vptr added. Then the tail is restored to the allocate expression. 2014-01-28 Paul Thomas PR fortran/59414 * gfortran.dg/allocate_class_3.f90 : New test git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@207204 138bc75d-0d04-0410-961f-82ee72b054a4 --- gcc/fortran/ChangeLog | 10 ++ gcc/fortran/trans-stmt.c | 39 ++++++++ gcc/testsuite/ChangeLog | 7 +- gcc/testsuite/gfortran.dg/allocate_class_3.f90 | 107 +++++++++++++++++++++ gcc/testsuite/gfortran.dg/elemental_by_value_1.f90 | 0 5 files changed, 160 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/allocate_class_3.f90 create mode 100644 gcc/testsuite/gfortran.dg/elemental_by_value_1.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index aacf31b3c6b..577d7784d2c 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,13 @@ +2014-01-28 Paul Thomas + + PR fortran/59414 + * trans-stmt.c (gfc_trans_allocate): Before the pointer + assignment to transfer the source _vptr to a class allocate + expression, the final class reference should be exposed. The + tail that includes the _data and array references is stored. + This reduced expression is transferred to 'lhs' and the _vptr + added. Then the tail is restored to the allocate expression. + 2014-01-26 Mikael Morin PR fortran/58007 diff --git a/gcc/fortran/trans-stmt.c b/gcc/fortran/trans-stmt.c index 5dd7bafe452..50e9a1a2abf 100644 --- a/gcc/fortran/trans-stmt.c +++ b/gcc/fortran/trans-stmt.c @@ -5102,10 +5102,49 @@ gfc_trans_allocate (gfc_code * code) { gfc_expr *lhs, *rhs; gfc_se lse; + gfc_ref *ref, *class_ref, *tail; + + /* Find the last class reference. */ + class_ref = NULL; + for (ref = e->ref; ref; ref = ref->next) + { + if (ref->type == REF_COMPONENT + && ref->u.c.component->ts.type == BT_CLASS) + class_ref = ref; + + if (ref->next == NULL) + break; + } + + /* Remove and store all subsequent references after the + CLASS reference. */ + if (class_ref) + { + tail = class_ref->next; + class_ref->next = NULL; + } + else + { + tail = e->ref; + e->ref = NULL; + } lhs = gfc_expr_to_initialize (e); gfc_add_vptr_component (lhs); + /* Remove the _vptr component and restore the original tail + references. */ + if (class_ref) + { + gfc_free_ref_list (class_ref->next); + class_ref->next = tail; + } + else + { + gfc_free_ref_list (e->ref); + e->ref = tail; + } + if (class_expr != NULL_TREE) { /* Polymorphic SOURCE: VPTR must be determined at run time. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 1e88ecb618d..049da583447 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,6 +1,7 @@ -2014-01-28 Kazu Hirata +2014-01-28 Paul Thomas - * gcc.target/arm/thumb-cbranchqi.c: Accept bls also. + PR fortran/59414 + * gfortran.dg/allocate_class_3.f90 : New test 2014-01-28 Dodji Seketeli @@ -707,7 +708,7 @@ PR ipa/58252 PR ipa/59226 - * g++.dg/ipa/devirt-20.C: New testcase. + * g++.dg/ipa/devirt-20.C: New testcase. * g++.dg/torture/pr58252.C: Likewise. * g++.dg/torture/pr59226.C: Likewise. diff --git a/gcc/testsuite/gfortran.dg/allocate_class_3.f90 b/gcc/testsuite/gfortran.dg/allocate_class_3.f90 new file mode 100644 index 00000000000..ddc7e23283f --- /dev/null +++ b/gcc/testsuite/gfortran.dg/allocate_class_3.f90 @@ -0,0 +1,107 @@ +! { dg-do run } +! Tests the fix for PR59414, comment #3, in which the allocate +! expressions were not correctly being stripped to provide the +! vpointer as an lhs to the pointer assignment of the vptr from +! the SOURCE expression. +! +! Contributed by Antony Lewis +! +module ObjectLists + implicit none + + type :: t + integer :: i + end type + + type Object_array_pointer + class(t), pointer :: p(:) + end type + +contains + + subroutine AddArray1 (P, Pt) + class(t) :: P(:) + class(Object_array_pointer) :: Pt + + select type (Pt) + class is (Object_array_pointer) + if (associated (Pt%P)) deallocate (Pt%P) + allocate(Pt%P(1:SIZE(P)), source=P) + end select + end subroutine + + subroutine AddArray2 (P, Pt) + class(t) :: P(:) + class(Object_array_pointer) :: Pt + + select type (Pt) + type is (Object_array_pointer) + if (associated (Pt%P)) deallocate (Pt%P) + allocate(Pt%P(1:SIZE(P)), source=P) + end select + end subroutine + + subroutine AddArray3 (P, Pt) + class(t) :: P + class(Object_array_pointer) :: Pt + + select type (Pt) + class is (Object_array_pointer) + if (associated (Pt%P)) deallocate (Pt%P) + allocate(Pt%P(1:4), source=P) + end select + end subroutine + + subroutine AddArray4 (P, Pt) + type(t) :: P(:) + class(Object_array_pointer) :: Pt + + select type (Pt) + class is (Object_array_pointer) + if (associated (Pt%P)) deallocate (Pt%P) + allocate(Pt%P(1:SIZE(P)), source=P) + end select + end subroutine +end module + + use ObjectLists + type(Object_array_pointer), pointer :: Pt + class(t), pointer :: P(:) + + allocate (P(2), source = [t(1),t(2)]) + allocate (Pt, source = Object_array_pointer(NULL())) + call AddArray1 (P, Pt) + select type (x => Pt%p) + type is (t) + if (any (x%i .ne. [1,2])) call abort + end select + deallocate (P) + deallocate (pt) + + allocate (P(3), source = [t(3),t(4),t(5)]) + allocate (Pt, source = Object_array_pointer(NULL())) + call AddArray2 (P, Pt) + select type (x => Pt%p) + type is (t) + if (any (x%i .ne. [3,4,5])) call abort + end select + deallocate (P) + deallocate (pt) + + allocate (Pt, source = Object_array_pointer(NULL())) + call AddArray3 (t(6), Pt) + select type (x => Pt%p) + type is (t) + if (any (x%i .ne. [6,6,6,6])) call abort + end select + deallocate (pt) + + allocate (Pt, source = Object_array_pointer(NULL())) + call AddArray4 ([t(7), t(8)], Pt) + select type (x => Pt%p) + type is (t) + if (any (x%i .ne. [7,8])) call abort + end select + deallocate (pt) + end + diff --git a/gcc/testsuite/gfortran.dg/elemental_by_value_1.f90 b/gcc/testsuite/gfortran.dg/elemental_by_value_1.f90 new file mode 100644 index 00000000000..e69de29bb2d -- 2.11.4.GIT