https://gcc.gnu.org/g:7a8cc81ed230a4fff48cc5c84534801da75e31fb
commit 7a8cc81ed230a4fff48cc5c84534801da75e31fb
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Fri Feb 14 16:55:42 2025 +0100
Sauvegarde modif
Diff:
---
gcc/fortran/trans-array.cc | 94 ++++++++++++++++++++++++++++++++++++++++------
gcc/fortran/trans-expr.cc | 25 ++----------
2 files changed, 85 insertions(+), 34 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 9b026bac56a0..d085e76a14e3 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -5591,18 +5591,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:
@@ -8100,6 +8130,44 @@ 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++)
+ {
+ /* 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];
+
+ /* Set the extents of this range. */
+ if ((loop->from[n] == NULL_TREE
+ || loop->to[n] == NULL_TREE)
+ && 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)
+ 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
@@ -8118,6 +8186,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)
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index d13b7d9e61d4..1a42a78f66a1 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -8721,28 +8721,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
