diff options
| author | Paul Thomas <pault@gcc.gnu.org> | 2024-11-24 12:01:32 +0000 |
|---|---|---|
| committer | Paul Thomas <pault@gcc.gnu.org> | 2024-11-24 12:01:32 +0000 |
| commit | 470ebd31843db58fc503ccef38b82d0da93c65e4 (patch) | |
| tree | 493b330ff36e52eabab3607d99c2ea9fc3f2f290 | |
| parent | dd6dbbb5111fba960ad0ee7999a225783e0ae80e (diff) | |
| download | gcc-470ebd31843db58fc503ccef38b82d0da93c65e4.zip gcc-470ebd31843db58fc503ccef38b82d0da93c65e4.tar.gz gcc-470ebd31843db58fc503ccef38b82d0da93c65e4.tar.bz2 | |
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.
| -rw-r--r-- | gcc/fortran/trans-expr.cc | 3 | ||||
| -rw-r--r-- | gcc/testsuite/gfortran.dg/pr85869.f90 | 25 |
2 files changed, 27 insertions, 1 deletions
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 7013dd3..bc1d5a8 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 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 |