diff options
| author | Tobias Burnus <burnus@net-b.de> | 2018-10-18 21:35:34 +0200 |
|---|---|---|
| committer | Tobias Burnus <burnus@gcc.gnu.org> | 2018-10-18 21:35:34 +0200 |
| commit | d0477233215e37dea91b1a98e58074257d7fbb5b (patch) | |
| tree | be3c7d345234f820644bfca1ce75a9c27156a169 /gcc | |
| parent | a9a2fddbf2a93b8427478954d4efe9e02080454f (diff) | |
| download | gcc-d0477233215e37dea91b1a98e58074257d7fbb5b.zip gcc-d0477233215e37dea91b1a98e58074257d7fbb5b.tar.gz gcc-d0477233215e37dea91b1a98e58074257d7fbb5b.tar.bz2 | |
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
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/fortran/ChangeLog | 6 | ||||
| -rw-r--r-- | gcc/fortran/trans-array.c | 12 | ||||
| -rw-r--r-- | gcc/testsuite/ChangeLog | 5 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/realloc_on_assign_31.f90 | 31 |
4 files changed, 51 insertions, 3 deletions
diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 13e3581..9ad52ca 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2018-10-18 Tobias Burnus <burnus@net-b.de> + + PR fortran/87625 + * trans-array.c (gfc_is_reallocatable_lhs): Detect allocatable + polymorphic arrays. + 2018-10-18 Paul Thomas <pault@gcc.gnu.org> PR fortran/58618 diff --git a/gcc/fortran/trans-array.c b/gcc/fortran/trans-array.c index ea4cf8c..47fec13 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 4929e36..c2a3bd1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2018-10-18 Tobias Burnus <burnus@net-b.de> + + PR fortran/87625 + * gfortran.dg/realloc_on_assign_31.f90: New file. + 2018-10-18 David Malcolm <dmalcolm@redhat.com> 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 0000000..55096d1 --- /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 |