https://gcc.gnu.org/g:06abfce015976234a25e24a72d858b94414a7c87
commit r17-5108-g06abfce015976234a25e24a72d858b94414a7c87 Author: Paul Thomas <[email protected]> Date: Tue Oct 13 15:21:21 2026 +0100 Fortran: [PDT] (2/16) Parameterized derived type errors [PR82173] 2026-10-13 Paul Thomas <[email protected]> gcc/fortran PR fortran/82173 * trans-decl.cc (gfc_trans_deferred_vars): Small formatting adjustment followed by a guarding of the pdt component dealloc for allocatable scalar and codimensioned variables. * trans-stmt.cc (gfc_trans_deallocate): Likewise for all PDTs. gcc/testsuite/ PR fortran/82173 * gfortran.dg/pdt_bug4.f90: New test. Diff: --- gcc/fortran/trans-decl.cc | 19 +++++++++++++++++++ gcc/fortran/trans-stmt.cc | 15 +++++++++++++++ gcc/testsuite/gfortran.dg/pdt_bug4.f90 | 23 +++++++++++++++++++++++ 3 files changed, 57 insertions(+) diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index b5b51cbaaab8..e45d6643ea24 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -5180,6 +5180,25 @@ gfc_trans_deferred_vars (gfc_symbol * proc_sym, gfc_wrapped_block * block) else tmp = NULL_TREE; + if (tmp && sym->attr.allocatable && !sym->attr.result + && (!GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (sym->backend_decl)) + || sym->attr.codimension)) + { + /* Only deallocate the PDT comonents if the variable has not + been deallocated. Arrays are guarded elsewhere. */ + tree null_cond, zero; + null_cond = sym->backend_decl; + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (sym->backend_decl))) + null_cond = gfc_conv_descriptor_data_get (null_cond); + zero = build_int_cst (TREE_TYPE (null_cond), 0); + null_cond = fold_build2_loc (input_location, NE_EXPR, + logical_type_node, + null_cond, zero); + tmp = build3_loc (input_location, COND_EXPR, void_type_node, + null_cond, tmp, + build_empty_stmt (input_location)); + } + gfc_add_init_cleanup (block, gfc_finish_block (&tmpblock), tmp); } else if (sym->attr.dummy) diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc index 19817180acdb..1fc996d7739d 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -7968,6 +7968,21 @@ gfc_trans_deallocate (gfc_code *code) se.expr, pdt_rank); } + if (tmp) + { + tree null_cond, zero; + null_cond = se.expr; + if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (se.expr))) + null_cond = gfc_conv_descriptor_data_get (null_cond); + zero = build_int_cst (TREE_TYPE (null_cond), 0); + null_cond = fold_build2_loc (input_location, NE_EXPR, + logical_type_node, + null_cond, zero); + tmp = build3_loc (input_location, COND_EXPR, void_type_node, + null_cond, tmp, + build_empty_stmt (input_location)); + } + if (tmp) gfc_add_expr_to_block (&se.pre, tmp); diff --git a/gcc/testsuite/gfortran.dg/pdt_bug4.f90 b/gcc/testsuite/gfortran.dg/pdt_bug4.f90 new file mode 100644 index 000000000000..8295be0ec1bf --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_bug4.f90 @@ -0,0 +1,23 @@ +! { dg-do run } +! { dg-options "-fcoarray=single" } +! Used to seg fault on exit due to attempted double free of pdt_array components. +! See attachment to PR82173 comment 10 - reproducers/bug4-dealloc-scope-exit.f90 +program n1 + type :: t(n) + integer, len :: n = 1 + integer :: v(n) + end type + type(t(4)), allocatable :: a[:] ! Allocatable coarray + type(t(3)), allocatable :: b ! NON-deferred len, allocatable + type(t(3)), allocatable :: c ! ditto + integer :: istat + allocate (a[*]) + allocate (b) + allocate (c) + a%v = 1 + b%v = 2 + c%v = 3 + deallocate (a, b, c) + deallocate (c, stat = istat) ! Deallocating already allocated caused segfault. + print *, 'reached end', istat +end program ! Segmentation fault - invalid memory reference
