https://gcc.gnu.org/g:470ebd31843db58fc503ccef38b82d0da93c65e4
commit r15-5629-g470ebd31843db58fc503ccef38b82d0da93c65e4 Author: Paul Thomas <[email protected]> Date: Sun Nov 24 12:01:32 2024 +0000 Fortran: Fix segfault in allocation of unlimited poly array [PR85869] 2024-11-24 Paul Thomas <[email protected]> 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: --- gcc/fortran/trans-expr.cc | 3 ++- gcc/testsuite/gfortran.dg/pr85869.f90 | 25 +++++++++++++++++++++++++ 2 files changed, 27 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 7013dd3a4119..bc1d5a87307d 100644 --- 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 index 000000000000..24caeb486f23 --- /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 <[email protected]> +! +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
