https://gcc.gnu.org/g:c91fc64318132f965c6c686d4142f948e58ec5d8
commit r16-4657-gc91fc64318132f965c6c686d4142f948e58ec5d8 Author: Paul Thomas <[email protected]> Date: Mon Oct 27 14:19:33 2025 +0000 Fortran: Fix ICE due to PDT selector expression in ASSOCIATE [PR95541] 2025-10-27 Paul Thomas <[email protected]> gcc/fortran PR fortran/922290 * resolve.cc (resolve_typebound_intrinsic_op): Add pdt_template to the list of preemted specifics. PR fortran/95541 * trans-stmt.cc (trans_associate_var): PDT array and string components are separately allocated for each element of a PDT array, so copy in and copy out the selector expression. gcc/testsuite/ PR fortran/95541 * gfortran.dg/pdt_61.f03: New test. Diff: --- gcc/fortran/resolve.cc | 3 ++- gcc/fortran/trans-stmt.cc | 16 ++++++++++++++++ gcc/testsuite/gfortran.dg/pdt_61.f03 | 35 +++++++++++++++++++++++++++++++++++ 3 files changed, 53 insertions(+), 1 deletion(-) diff --git a/gcc/fortran/resolve.cc b/gcc/fortran/resolve.cc index 0d5444848f02..117a51c7e9a3 100644 --- a/gcc/fortran/resolve.cc +++ b/gcc/fortran/resolve.cc @@ -16083,7 +16083,8 @@ resolve_typebound_intrinsic_op (gfc_symbol* derived, gfc_intrinsic_op op, for (intr = derived->ns->op[op]; intr; intr = intr->next) if (intr->sym == target_proc && (target_proc->attr.used_in_submodule - || derived->attr.pdt_type)) + || derived->attr.pdt_type + || derived->attr.pdt_template)) return true; if (!gfc_check_new_interface (derived->ns->op[op], diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc index f25335d6bdbd..0e82d2a4e9ac 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -2092,6 +2092,22 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) gfc_free_expr (expr1); gfc_free_expr (expr2); } + /* PDT array and string components are separately allocated for each element + of a PDT array. Therefore, there is no choice but to copy in and copy out + the target expression. */ + else if (e && is_subref_array (e) + && (gfc_expr_attr (e).pdt_array || gfc_expr_attr (e).pdt_string)) + { + gfc_se init; + gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (sym->backend_decl))); + gfc_init_se (&init, NULL); + gfc_conv_subref_array_arg (&init, e, false, INTENT_INOUT, + sym && sym->attr.pointer); + init.expr = build_fold_indirect_ref_loc (input_location, init.expr); + gfc_add_modify (&init.pre, sym->backend_decl, init.expr); + gfc_add_init_cleanup (block, gfc_finish_block (&init.pre), + gfc_finish_block (&init.post)); + } else if ((sym->attr.dimension || sym->attr.codimension) && !class_target && (sym->as->type == AS_DEFERRED || sym->assoc->variable)) { diff --git a/gcc/testsuite/gfortran.dg/pdt_61.f03 b/gcc/testsuite/gfortran.dg/pdt_61.f03 new file mode 100644 index 000000000000..20b97b0b1eb3 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/pdt_61.f03 @@ -0,0 +1,35 @@ +! { dg-do run } +! +! Test the fix for PR95541, in which parameterized array and string components +! of PDT arrays caused an ICE in the ASSOCIATE selector expressions below. +! +! Contributed by Gerhard Steinmetz <[email protected]> +! +program p + type t(n) + integer, len :: n + integer :: a(n) + character(len = n) :: chr + end type + type(t(3)) :: x(2) + integer :: tgt(2) + x(1)%a = [1, 2, 3] + x(1)%chr = "abc" + x(2)%a = [4, 5, 6] + x(2)%chr = "def" + associate (y => x(:)%a(3)) + if (any (y /= [3,6])) stop 1 + y = -y + end associate + associate (y => x%a(3)) + if (any (y /= [-3,-6])) stop 2 + y = -y * 10 + end associate + if (any (x%a(3) /= [30,60])) stop 3 + if (any (x%a(2) /= [2,5])) stop 4 + associate (y => x%chr(2:2)) + if (any (y /= ["b","e"])) stop 5 + y = ["x", "y"] + end associate + if (any (x%chr /= ["axc","dyf"])) stop 6 +end
