https://gcc.gnu.org/g:70b03019b50a0a7c6219ce89e71e616f5400c339
commit r16-4387-g70b03019b50a0a7c6219ce89e71e616f5400c339 Author: Paul Thomas <[email protected]> Date: Mon Oct 13 07:55:18 2025 +0100 Fortran: Fix ICE in deallocating PDTs [PR121191] 2025-10-13 Paul Thomas <[email protected]> gcc/fortran PR fortran/121191 * trans-array.cc (has_parameterized_comps): New function which checks if a derived type has parameterized components. ( gfc_deallocate_pdt_comp): Use it to prevent deallocation of PDTs if there are no parameterized components. gcc/testsuite/ PR fortran/121191 * gfortran.dg/pdt_59.f03: New test. Diff: --- gcc/fortran/trans-array.cc | 18 ++++++++++++++ gcc/testsuite/gfortran.dg/pdt_59.f03 | 47 ++++++++++++++++++++++++++++++++++++ 2 files changed, 65 insertions(+) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index b11ef57f9814..e2b17a725be8 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -11385,9 +11385,27 @@ gfc_allocate_pdt_comp (gfc_symbol * der_type, tree decl, int rank, /* Recursively traverse an object of parameterized derived type, generating code to deallocate parameterized components. */ +static bool +has_parameterized_comps (gfc_symbol * der_type) +{ + /* A type without parameterized components causes gimplifier problems. */ + bool parameterized_comps = false; + for (gfc_component *c = der_type->components; c; c = c->next) + if (c->attr.pdt_array || c->attr.pdt_string) + parameterized_comps = true; + else if (c->ts.type == BT_DERIVED + && c->ts.u.derived->attr.pdt_type + && strcmp (der_type->name, c->ts.u.derived->name)) + parameterized_comps = has_parameterized_comps (c->ts.u.derived); + return parameterized_comps; +} + tree gfc_deallocate_pdt_comp (gfc_symbol * der_type, tree decl, int rank) { + if (!has_parameterized_comps (der_type)) + return NULL_TREE; + return structure_alloc_comps (der_type, decl, NULL_TREE, rank, DEALLOCATE_PDT_COMP, 0, NULL); } diff --git a/gcc/testsuite/gfortran.dg/pdt_59.f03 b/gcc/testsuite/gfortran.dg/pdt_59.f03 new file mode 100644 index 000000000000..7367897c8e72 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_59.f03 @@ -0,0 +1,47 @@ +! { dg-do compile } +! +! Test the fix for PR122191, which used to ICE in compilation. +! +! Contributed by Damian Rouson <[email protected]> +! +module input_output_pair_m + implicit none + + type input_output_pair_t(k) + integer, kind :: k + integer :: a, b + end type + + type mini_batch_t(k) + integer, kind :: k = kind(1.) + type(input_output_pair_t(k)), allocatable :: input_output_pairs_(:) + end type + + interface + + module function default_real_construct() + implicit none + type(mini_batch_t) default_real_construct + end function + + end interface + +end module + +submodule(input_output_pair_m) input_output_pair_smod +contains + function default_real_construct() + type(mini_batch_t) default_real_construct + allocate (default_real_construct%input_output_pairs_(2)) + default_real_construct%input_output_pairs_%a = [42,43] + default_real_construct%input_output_pairs_%b = [420,421] + end +end submodule + + use input_output_pair_m + type(mini_batch_t), allocatable :: res + res = default_real_construct() + if (any (res%input_output_pairs_%a /= [42,43])) stop 1 + if (any (res%input_output_pairs_%b /= [420,421])) stop 2 + if (allocated (res)) deallocate (res) +end
