https://gcc.gnu.org/g:f2dd14273480ab0145a7931e1be1bf3cfae0e935
commit f2dd14273480ab0145a7931e1be1bf3cfae0e935
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Tue Sep 23 18:55:08 2025 +0200
Correction régression class_result_10.f90
Diff:
---
gcc/fortran/trans-array.cc | 25 ++++++++++++++++++-------
gcc/fortran/trans-expr.cc | 4 +++-
gcc/fortran/trans.cc | 16 +++++++++-------
gcc/fortran/trans.h | 2 +-
4 files changed, 31 insertions(+), 16 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index cea098c5a94e..22db090d62d8 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -3641,7 +3641,8 @@ conv_array_index_offset (gfc_se * se, gfc_ss * ss, int
dim, int i,
static bool
-is_class_array_ref (tree base, gfc_expr *expr, tree *class_descr)
+is_class_array_ref (gfc_se *se, tree base, gfc_expr *expr, gfc_array_ref *ar,
+ tree *class_descr)
{
tree decl = NULL_TREE;
tree tmp;
@@ -3649,6 +3650,15 @@ is_class_array_ref (tree base, gfc_expr *expr, tree
*class_descr)
gfc_typespec *ts;
gfc_symbol *sym;
+ if (se->class_container)
+ {
+ if (class_descr)
+ *class_descr = se->class_container;
+ return true;
+ }
+ else if (ar && ar->type == AR_ELEMENT)
+ return false;
+
tmp = !VAR_P (base) ? gfc_get_class_from_expr (base) : NULL_TREE;
if (tmp != NULL_TREE)
@@ -3714,12 +3724,13 @@ give_up:
/* Build a scalarized array reference using the vptr 'size'. */
static bool
-build_class_array_ref (gfc_se *se, tree base, gfc_expr * expr, tree index)
+build_class_array_ref (gfc_se *se, tree base, gfc_expr * expr,
+ gfc_array_ref *ar, tree index)
{
tree size;
tree decl = NULL_TREE;
- if (!is_class_array_ref (base, expr, &decl))
+ if (!is_class_array_ref (se, base, expr, ar, &decl))
return false;
se->class_vptr = gfc_evaluate_now (gfc_class_vptr_get (decl), &se->pre);
@@ -3795,7 +3806,7 @@ enum gfc_array_ref_sort
static gfc_array_ref_sort
-classify_array_ref (tree array, tree ref_base, gfc_expr *expr,
+classify_array_ref (gfc_se *se, tree array, tree ref_base, gfc_expr *expr,
gfc_array_ref *ar, bool tmp_array)
{
if (ar && ar->dimen == 0 && ar->codimen != 0)
@@ -3834,7 +3845,7 @@ classify_array_ref (tree array, tree ref_base, gfc_expr
*expr,
return ARS_CLASS_PTR_ARITH;
}
}
- else if (is_class_array_ref (ref_base, expr, nullptr))
+ else if (is_class_array_ref (se, ref_base, expr, ar, nullptr))
return ARS_CLASS_PTR_ARITH;
if (tmp_array || non_negative_strides_array_p (array))
@@ -3848,11 +3859,11 @@ static void
build_array_ref (gfc_se *se, tree array, tree ref_base, gfc_expr *expr,
gfc_array_ref *ar, bool is_temp_array, tree index)
{
- switch (classify_array_ref (array, ref_base, expr, ar, is_temp_array))
+ switch (classify_array_ref (se, array, ref_base, expr, ar, is_temp_array))
{
case ARS_CLASS_PTR_ARITH:
{
- bool success = build_class_array_ref (se, ref_base, expr, index);
+ bool success = build_class_array_ref (se, ref_base, expr, ar, index);
gcc_assert (success);
}
break;
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index d6130bae5292..c2d5730a9d78 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -671,7 +671,7 @@ gfc_reset_len (stmtblock_t *block, gfc_expr *expr)
for expressions other than variables. */
tree
-gfc_get_class_from_gfc_expr (gfc_expr *e)
+gfc_get_class_from_gfc_expr (gfc_expr *e, stmtblock_t *pre_block)
{
gfc_expr *class_expr;
gfc_se cse;
@@ -681,6 +681,8 @@ gfc_get_class_from_gfc_expr (gfc_expr *e)
gfc_init_se (&cse, NULL);
gfc_conv_expr (&cse, class_expr);
gfc_free_expr (class_expr);
+ if (pre_block)
+ gfc_add_block_to_block (pre_block, &cse.pre);
return cse.expr;
}
diff --git a/gcc/fortran/trans.cc b/gcc/fortran/trans.cc
index 66c0bf28f06b..adb8eea70198 100644
--- a/gcc/fortran/trans.cc
+++ b/gcc/fortran/trans.cc
@@ -1422,14 +1422,14 @@ gfc_add_finalizer_call (stmtblock_t *block, gfc_expr
*expr2,
expr->corank = CLASS_DATA (expr2->symtree->n.sym)->as->corank;
}
- stmtblock_t tmp_block;
- gfc_start_block (&tmp_block);
-
gfc_se final_se;
gfc_init_se (&final_se, NULL);
get_final_proc_ref (&final_se, expr, class_container);
gfc_add_block_to_block (block, &final_se.pre);
+ stmtblock_t tmp_block;
+ gfc_start_block (&tmp_block);
+
gfc_se size_se;
gfc_init_se (&size_se, NULL);
get_elem_size (&size_se, expr, class_container);
@@ -1507,8 +1507,6 @@ gfc_assignment_finalizer_call (gfc_se *lse, gfc_expr
*expr1, bool init_flag)
gfc_se se;
gfc_symbol *sym = expr1->symtree->n.sym;
gfc_ref *ref = expr1->ref;
- stmtblock_t final_block;
- gfc_init_block (&final_block);
gfc_expr *finalize_expr;
bool class_array_ref;
@@ -1544,6 +1542,8 @@ gfc_assignment_finalizer_call (gfc_se *lse, gfc_expr
*expr1, bool init_flag)
if (!gfc_may_be_finalized (sym->ts))
return false;
+ stmtblock_t outer_block, final_block;
+ gfc_start_block (&outer_block);
gfc_init_block (&final_block);
bool finalizable = gfc_add_finalizer_call (&final_block, finalize_expr);
gfc_free_expr (finalize_expr);
@@ -1558,7 +1558,7 @@ gfc_assignment_finalizer_call (gfc_se *lse, gfc_expr
*expr1, bool init_flag)
{
if (expr1->ts.type == BT_CLASS)
{
- ptr = gfc_get_class_from_gfc_expr (expr1);
+ ptr = gfc_get_class_from_gfc_expr (expr1, &outer_block);
gcc_assert (ptr != NULL_TREE);
ptr = gfc_class_data_get (ptr);
if (lhs_attr.dimension)
@@ -1577,6 +1577,7 @@ gfc_assignment_finalizer_call (gfc_se *lse, gfc_expr
*expr1, bool init_flag)
gfc_conv_expr (&se, expr1);
ptr = gfc_build_addr_expr (NULL_TREE, se.expr);
}
+ gfc_add_block_to_block (&outer_block, &se.pre);
}
cond = fold_build2_loc (input_location, NE_EXPR, logical_type_node,
@@ -1597,7 +1598,8 @@ gfc_assignment_finalizer_call (gfc_se *lse, gfc_expr
*expr1, bool init_flag)
build_empty_stmt (input_location));
}
- gfc_add_expr_to_block (&lse->finalblock, final_expr);
+ gfc_add_expr_to_block (&outer_block, final_expr);
+ gfc_add_expr_to_block (&lse->finalblock, gfc_finish_block (&outer_block));
return true;
}
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 1cfe8824fecc..3dda2f2ecb96 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -473,7 +473,7 @@ void gfc_reset_vptr (stmtblock_t *, gfc_expr *, tree =
NULL_TREE,
gfc_symbol * = nullptr);
void gfc_class_set_vptr (stmtblock_t *, tree, tree);
void gfc_reset_len (stmtblock_t *, gfc_expr *);
-tree gfc_get_class_from_gfc_expr (gfc_expr *);
+tree gfc_get_class_from_gfc_expr (gfc_expr *, stmtblock_t *pre_block =
nullptr);
tree gfc_get_class_from_expr (tree);
tree gfc_get_vptr_from_expr (tree);
tree gfc_copy_class_to_class (tree, tree, tree, bool);
