https://gcc.gnu.org/g:26383c0b0a5aaa3248dd4949928faf734291364e
commit 26383c0b0a5aaa3248dd4949928faf734291364e
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 323bec17093c..93420e756361 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -8379,6 +8379,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);
@@ -12810,10 +12814,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,
