https://gcc.gnu.org/g:090b8d040a7cd76f68ae647df61fdee39acd4a10
commit 090b8d040a7cd76f68ae647df61fdee39acd4a10 Author: Mikael Morin <mik...@gcc.gnu.org> Date: Thu May 22 19:28:41 2025 +0200 Correction partielle régression class_transformational_2 Diff: --- gcc/fortran/trans-array.cc | 3 --- gcc/fortran/trans-expr.cc | 15 ++++++++++++--- 2 files changed, 12 insertions(+), 6 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index c1d46b8e98d0..b28d65445bc6 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -1142,9 +1142,6 @@ gfc_trans_create_temp_array (stmtblock_t * pre, stmtblock_t * post, gfc_ss * ss, class_data = gfc_class_data_get (tmp); - if (rank_changer) - fcn_ss->info->class_container = NULL_TREE; - /* Assign the new descriptor to the _data field. This allows the vptr _copy to be used for scalarized assignment since the class temporary can be found from the descriptor. */ diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index c4ab6a2ef772..8b32de1ef292 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -8397,6 +8397,10 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym, !sym->attr.pointer, callee_alloc, &se->ss->info->expr->where, true); + if (se->ss->info->class_container + && !se->class_container) + se->class_container = se->ss->info->class_container; + /* Pass the temporary as the first argument. */ result = info->descriptor; tmp = gfc_build_addr_expr (NULL_TREE, result); @@ -12835,10 +12839,15 @@ gfc_trans_assignment_1 (gfc_expr * expr1, gfc_expr * expr2, bool init_flag, references. Use the vptr copy function, since this does a deep copy of allocatable components, without which the finalizer call will deallocate the components. */ - tmp = gfc_get_vptr_from_expr (rse.expr); - if (tmp != NULL_TREE) + tree cls = rse.class_container; + tree vptr; + if (cls == NULL_TREE) + vptr = gfc_get_vptr_from_expr (rse.expr); + else + vptr = gfc_class_vptr_get (cls); + if (vptr != NULL_TREE) { - tree fcn = gfc_vptr_copy_get (tmp); + tree fcn = gfc_vptr_copy_get (vptr); if (POINTER_TYPE_P (TREE_TYPE (fcn))) fcn = build_fold_indirect_ref_loc (input_location, fcn); tmp = build_call_expr_loc (input_location,