This is the mail archive of the fortran@gcc.gnu.org mailing list for the GNU Fortran project.


Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]
Other format: [Raw text]

[Patch, Fortran] PR87625 - fix reallocate on assign with polymophic arrays


for some reasons, the two calls to gfc_is_reallocatable_lhs(expr1) differ, the first
one is a simple "var" + full-array reference while the second one is
"var->_data" + full-array reference.

Neither was handled and, hence, using
  var = [ t(11), t(12) ]
didn't do any memory allocation; the program then simply segfaulted on assignment.

Build and regtested on x86-64-gnu-linux.
OK for the trunk?

Tobias
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/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

Index Nav: [Date Index] [Subject Index] [Author Index] [Thread Index]
Message Nav: [Date Prev] [Date Next] [Thread Prev] [Thread Next]