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

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index 13e35812bad59f59c95d0d7c0a9b858f5b0115a6..9ad52ca3c01e9250af411c4e3443d7b01cbdc073 100644 (file)
--- 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 ea4cf8cd1b8acd57ed250b1672658cab471d4abb..47fec131c781668c9e15b33020cc51c8c3cdf6d2 100644 (file)
--- 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 4929e368f417e201ff600b07628b5e29d018fe8d..c2a3bd1971e14a6251255070ea03b1c3840e4bd1 100644 (file)
--- 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 (file)
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