Fortran: Fix segfault in allocation of unlimited poly array [PR85869]

2024-11-24  Paul Thomas  <pault@gcc.gnu.org>

gcc/fortran/ChangeLog

	PR fortran/85869
	* trans-expr.cc (trans_class_vptr_len_assignment): To access
	the '_len' field, re must be unlimited polymorphic.

gcc/testsuite/
	PR fortran/85869
	* gfortran.dg/pr85869.f90: Comment out test of component refs.

diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 7013dd3a4119dec3f13952eb2a5c7599e39cc857..bc1d5a87307dc0a85076baf20237d496fc3c6d52 100644 (file)
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -21,6 +21,7 @@ along with GCC; see the file COPYING3.  If not see
 
 /* trans-expr.cc-- generate GENERIC trees for gfc_expr.  */
 
+#define INCLUDE_MEMORY
 #include "config.h"
 #include "system.h"
 #include "coretypes.h"
@@ -10421,7 +10422,7 @@ trans_class_vptr_len_assignment (stmtblock_t *block, gfc_expr * le,
              vptr_expr = NULL;
              se.expr = gfc_class_vptr_get (GFC_DECL_SAVED_DESCRIPTOR (
                                             re->symtree->n.sym->backend_decl));
-             if (to_len)
+             if (to_len && UNLIMITED_POLY (re))
                from_len = gfc_class_len_get (GFC_DECL_SAVED_DESCRIPTOR (
                                             re->symtree->n.sym->backend_decl));
            }

diff --git a/gcc/testsuite/gfortran.dg/pr85869.f90 b/gcc/testsuite/gfortran.dg/pr85869.f90
new file mode 100644 (file)
index 0000000..24caeb4
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/pr85869.f90
@@ -0,0 +1,25 @@
+! { dg-do compile }
+!
+! Test the fix for PR85869, where line 19 segfaulted.
+!
+! Contributed by Gerhard Steinmetz  <gscfq@t-online.de>
+!
+program p
+   type t
+     integer :: i
+   end type
+   call s
+contains
+   function f()
+      class(t), allocatable :: f(:)
+      f = [(t(i), i = 1, 10)]
+   end
+   subroutine s
+      class(*), allocatable :: z(:)
+      allocate (z, source = f ()) ! Segfault in gfc_class_len_get.
+      select type (z)
+        type is (t)
+          if (any (z%i /= [(i, i = 1,10)])) stop 1
+      end select
+   end
+end