From d0477233215e37dea91b1a98e58074257d7fbb5b Mon Sep 17 00:00:00 2001 From: Tobias Burnus Date: Thu, 18 Oct 2018 21:35:34 +0200 Subject: [PATCH] Fix (re)alloc of polymorphic arrays PR fortran/87625 * trans-array.c (gfc_is_reallocatable_lhs): Detect allocatable polymorphic arrays. PR fortran/87625 * gfortran.dg/realloc_on_assign_31.f90: New file. From-SVN: r265283 --- gcc/fortran/ChangeLog | 6 ++++ gcc/fortran/trans-array.c | 12 +++++-- gcc/testsuite/ChangeLog | 5 +++ .../gfortran.dg/realloc_on_assign_31.f90 | 31 +++++++++++++++++++ 4 files changed, 51 insertions(+), 3 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/realloc_on_assign_31.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 13e35812bad..9ad52ca3c01 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2018-10-18 Tobias Burnus + + PR fortran/87625 + * trans-array.c (gfc_is_reallocatable_lhs): Detect allocatable + polymorphic arrays. + 2018-10-18 Paul Thomas PR fortran/58618 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index ea4cf8cd1b8..47fec131c78 100644 --- a/gcc/fortran/trans-array.c +++ b/gcc/fortran/trans-array.c @@ -9616,9 +9616,15 @@ gfc_is_reallocatable_lhs (gfc_expr *expr) if (sym->ts.type == BT_CLASS && !sym->attr.associate_var && CLASS_DATA (sym)->attr.allocatable - && expr->ref && expr->ref->type == REF_COMPONENT - && strcmp (expr->ref->u.c.component->name, "_data") == 0 - && expr->ref->next == NULL) + && expr->ref + && ((expr->ref->type == REF_ARRAY && expr->ref->u.ar.type == AR_FULL + && expr->ref->next == NULL) + || (expr->ref->type == REF_COMPONENT + && strcmp (expr->ref->u.c.component->name, "_data") == 0 + && (expr->ref->next == NULL + || (expr->ref->next->type == REF_ARRAY + && expr->ref->next->u.ar.type == AR_FULL + && expr->ref->next->next == NULL))))) return true; /* An allocatable variable. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 4929e368f41..c2a3bd1971e 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-10-18 Tobias Burnus + + PR fortran/87625 + * gfortran.dg/realloc_on_assign_31.f90: New file. + 2018-10-18 David Malcolm PR tree-optimization/87562 diff --git a/gcc/testsuite/gfortran.dg/realloc_on_assign_31.f90 b/gcc/testsuite/gfortran.dg/realloc_on_assign_31.f90 new file mode 100644 index 00000000000..55096d179ba --- /dev/null +++ b/gcc/testsuite/gfortran.dg/realloc_on_assign_31.f90 @@ -0,0 +1,31 @@ +! { dg-do run } +! +! PR fortran/87625 +! +! Ensure that "var" gets allocated. +! +! Contributed by Tobias Burnus +! +program test + implicit none + type t + integer :: i + end type t + class(t), allocatable :: var(:) + call poly_init() + print *, var(:)%i + if (lbound(var, 1) /= 1 .and. ubound(var, 1) /= 2) call abort() + if (var(1)%i /= 11 .or. var(2)%i /= 12) call abort() + call poly_init2() + !print *, var(:)%i + if (lbound(var, 1) /= 1 .and. ubound(var, 1) /= 3) call abort() + if (var(1)%i /= 11 .or. var(2)%i /= 12 .or. var(3)%i /= 13) call abort() +contains + subroutine poly_init() + !allocate(var(2)) + var = [t :: t(11), t(12)] + end subroutine poly_init + subroutine poly_init2() + var = [t :: t(11), t(12), t(13)] + end subroutine poly_init2 + end program test -- 2.30.2