https://gcc.gnu.org/g:646acf566654d9815ab80927e5f97e8038d1dc1a
commit 646acf566654d9815ab80927e5f97e8038d1dc1a
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Fri Feb 14 13:50:51 2025 +0100
Dépl. init bornes descripteur gfc_conv_procedure_call -> scalarizer
Essai suppression code inutile
Sauvegarde modif
Correction ICE class_to_type_1
Correction régression class_to_type_2.f90
Correction class_result_10.f90
Correction régressions inline_sum_*
Correction régression class_assign_4.f90
Diff:
---
gcc/fortran/trans-array.cc | 113 ++++++++++++++++++++++++++++++++++++---------
gcc/fortran/trans-expr.cc | 35 ++------------
2 files changed, 94 insertions(+), 54 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 0f7637dd535c..9a738bd5204d 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1426,12 +1426,6 @@ get_class_info_from_ss (stmtblock_t * pre, gfc_ss *ss,
tree *eltype,
tmp2 = gfc_class_len_get (class_expr);
gfc_add_modify (pre, tmp, tmp2);
}
-
- if (rhs_function)
- {
- tmp = gfc_class_data_get (class_expr);
- gfc_conv_descriptor_offset_set (pre, tmp, gfc_index_zero_node);
- }
}
else if (rhs_ss->info->data.array.descriptor)
{
@@ -3372,18 +3366,48 @@ gfc_add_loop_ss_code (gfc_loopinfo * loop, gfc_ss * ss,
bool subscript,
break;
case GFC_SS_FUNCTION:
- /* Array function return value. We call the function and save its
- result in a temporary for use inside the loop. */
- gfc_init_se (&se, NULL);
- se.loop = loop;
- se.ss = ss;
- if (gfc_is_class_array_function (expr))
- expr->must_finalize = 1;
- gfc_conv_expr (&se, expr);
- gfc_add_block_to_block (&outer_loop->pre, &se.pre);
- gfc_add_block_to_block (&outer_loop->post, &se.post);
- gfc_add_block_to_block (&outer_loop->post, &se.finalblock);
- ss_info->string_length = se.string_length;
+ {
+ /* Array function return value. We call the function and save its
+ result in a temporary for use inside the loop. */
+ gfc_init_se (&se, NULL);
+ se.loop = loop;
+ se.ss = ss;
+ bool class_func = gfc_is_class_array_function (expr);
+ if (class_func)
+ expr->must_finalize = 1;
+ gfc_conv_expr (&se, expr);
+ gfc_add_block_to_block (&outer_loop->pre, &se.pre);
+ if (class_func
+ && se.expr
+ && GFC_CLASS_TYPE_P (TREE_TYPE (se.expr)))
+ {
+ tree tmp = gfc_class_data_get (se.expr);
+ info->descriptor = tmp;
+ info->data = gfc_conv_descriptor_data_get (tmp);
+ info->offset = gfc_conv_descriptor_offset_get (tmp);
+ for (gfc_ss *s = ss; s; s = s->parent)
+ for (int n = 0; n < s->dimen; n++)
+ {
+ int dim = s->dim[n];
+ tree tree_dim = gfc_rank_cst[dim];
+
+ tree start = gfc_conv_descriptor_lbound_get (tmp,
tree_dim);
+ start = gfc_evaluate_now (start, &outer_loop->pre);
+ info->start[dim] = start;
+
+ tree end = gfc_conv_descriptor_ubound_get (tmp, tree_dim);
+ end = gfc_evaluate_now (end, &outer_loop->pre);
+ info->end[dim] = end;
+
+ tree stride = gfc_conv_descriptor_stride_get (tmp,
tree_dim);
+ stride = gfc_evaluate_now (stride, &outer_loop->pre);
+ info->stride[dim] = stride;
+ }
+ }
+ gfc_add_block_to_block (&outer_loop->post, &se.post);
+ gfc_add_block_to_block (&outer_loop->post, &se.finalblock);
+ ss_info->string_length = se.string_length;
+ }
break;
case GFC_SS_CONSTRUCTOR:
@@ -5383,7 +5407,8 @@ done:
int dim = ss->dim[n];
info->start[dim] = gfc_index_zero_node;
- info->end[dim] = gfc_index_zero_node;
+ if (ss_info->type != GFC_SS_FUNCTION)
+ info->end[dim] = gfc_index_zero_node;
info->stride[dim] = gfc_index_one_node;
}
break;
@@ -6068,6 +6093,46 @@ set_loop_bounds (gfc_loopinfo *loop)
}
+/* Last attempt to set the loop bounds, in case they depend on an allocatable
+ function result. */
+
+static void
+late_set_loop_bounds (gfc_loopinfo *loop)
+{
+ int n, dim;
+ gfc_array_info *info;
+ gfc_ss **loopspec;
+
+ loopspec = loop->specloop;
+
+ for (n = 0; n < loop->dimen; n++)
+ {
+ /* Set the extents of this range. */
+ if (loop->from[n] == NULL_TREE
+ || loop->to[n] == NULL_TREE)
+ {
+ /* We should have found the scalarization loop specifier. If not,
+ that's bad news. */
+ gcc_assert (loopspec[n]);
+
+ info = &loopspec[n]->info->data.array;
+ dim = loopspec[n]->dim[n];
+
+ if (loopspec[n]->info->type == GFC_SS_FUNCTION
+ && info->start[dim]
+ && info->end[dim])
+ {
+ loop->from[n] = info->start[dim];
+ loop->to[n] = info->end[dim];
+ }
+ }
+ }
+
+ for (loop = loop->nested; loop; loop = loop->next)
+ late_set_loop_bounds (loop);
+}
+
+
/* Initialize the scalarization loop. Creates the loop variables. Determines
the range of the loop variables. Creates a temporary if required.
Also generates code for scalar expressions which have been
@@ -6086,6 +6151,8 @@ gfc_conv_loop_setup (gfc_loopinfo * loop, locus * where)
allocating the temporary. */
gfc_add_loop_ss_code (loop, loop->ss, false, where);
+ late_set_loop_bounds (loop);
+
tmp_ss = loop->temp_ss;
/* If we want a temporary then create it. */
if (tmp_ss != NULL)
@@ -6142,9 +6209,11 @@ gfc_set_delta (gfc_loopinfo *loop)
gfc_ss_type ss_type;
ss_type = ss->info->type;
- if (ss_type != GFC_SS_SECTION
- && ss_type != GFC_SS_COMPONENT
- && ss_type != GFC_SS_CONSTRUCTOR)
+ if (!(ss_type == GFC_SS_SECTION
+ || ss_type == GFC_SS_COMPONENT
+ || ss_type == GFC_SS_CONSTRUCTOR
+ || (ss_type == GFC_SS_FUNCTION
+ && gfc_is_class_array_function (ss->info->expr))))
continue;
info = &ss->info->data.array;
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 0db7ba3fd52e..bfc38add72d0 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -5485,16 +5485,6 @@ gfc_conv_subref_array_arg (gfc_se *se, gfc_expr * expr,
int g77,
/* Translate the expression. */
gfc_conv_expr (&rse, expr);
- /* Reset the offset for the function call since the loop
- is zero based on the data pointer. Note that the temp
- comes first in the loop chain since it is added second. */
- if (gfc_is_class_array_function (expr))
- {
- tmp = loop.ss->loop_chain->info->data.array.descriptor;
- gfc_conv_descriptor_offset_set (&loop.pre, tmp,
- gfc_index_zero_node);
- }
-
gfc_conv_tmp_array_ref (&lse);
if (intent != INTENT_OUT)
@@ -8864,28 +8854,9 @@ gfc_conv_procedure_call (gfc_se * se, gfc_symbol * sym,
&& se->expr && GFC_CLASS_TYPE_P (TREE_TYPE (se->expr))
&& expr->must_finalize)
{
- int n;
- if (se->ss && se->ss->loop)
- {
- gfc_add_block_to_block (&se->ss->loop->pre, &se->pre);
- se->expr = gfc_evaluate_now (se->expr, &se->ss->loop->pre);
- tmp = gfc_class_data_get (se->expr);
- info->descriptor = tmp;
- info->data = gfc_conv_descriptor_data_get (tmp);
- info->offset = gfc_conv_descriptor_offset_get (tmp);
- for (n = 0; n < se->ss->loop->dimen; n++)
- {
- tree dim = gfc_rank_cst[n];
- se->ss->loop->to[n] = gfc_conv_descriptor_ubound_get (tmp,
dim);
- se->ss->loop->from[n] = gfc_conv_descriptor_lbound_get (tmp,
dim);
- }
- }
- else
- {
- /* TODO Eliminate the doubling of temporaries. This
- one is necessary to ensure no memory leakage. */
- se->expr = gfc_evaluate_now (se->expr, &se->pre);
- }
+ /* TODO Eliminate the doubling of temporaries. This
+ one is necessary to ensure no memory leakage. */
+ se->expr = gfc_evaluate_now (se->expr, &se->pre);
/* Finalize the result, if necessary. */
attr = expr->value.function.esym
