https://gcc.gnu.org/g:fdeb3c8b4d4eead6b6c28e4531b2cc086933a1ab
commit fdeb3c8b4d4eead6b6c28e4531b2cc086933a1ab
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Wed Jul 16 21:39:51 2025 +0200
Extraction gfc_conv_shift_descriptor
Suppression variable inutilisée
Diff:
---
gcc/fortran/trans-descriptor.cc | 40 ++++++++++++++++++++++++++++++++++++++++
gcc/fortran/trans-descriptor.h | 1 +
gcc/fortran/trans-expr.cc | 36 +-----------------------------------
3 files changed, 42 insertions(+), 35 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index d9a817c2e1e8..2f248b18eb81 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1331,3 +1331,43 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree
dest, int dest_rank,
gfc_array_index_type, stride, tmp);
}
}
+
+
+void
+gfc_conv_shift_descriptor (stmtblock_t *block, tree dest, tree src,
+ int rank, tree zero_cond)
+{
+ tree tmp = gfc_conv_descriptor_data_get (src);
+ gfc_conv_descriptor_data_set (block, dest, tmp);
+
+ tree offset = gfc_index_zero_node;
+ for (int n = 0 ; n < rank; n++)
+ {
+ tree lbound = gfc_conv_descriptor_lbound_get (dest, gfc_rank_cst[n]);
+ lbound = fold_build3_loc (input_location, COND_EXPR,
+ gfc_array_index_type, zero_cond,
+ gfc_index_one_node, lbound);
+ lbound = gfc_evaluate_now (lbound, block);
+
+ tmp = gfc_conv_descriptor_ubound_get (src, gfc_rank_cst[n]);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type, tmp, lbound);
+ gfc_conv_descriptor_lbound_set (block, dest,
+ gfc_rank_cst[n], lbound);
+ gfc_conv_descriptor_ubound_set (block, dest,
+ gfc_rank_cst[n], tmp);
+
+ /* Set stride and accumulate the offset. */
+ tmp = gfc_conv_descriptor_stride_get (src, gfc_rank_cst[n]);
+ gfc_conv_descriptor_stride_set (block, dest,
+ gfc_rank_cst[n], tmp);
+ tmp = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, lbound, tmp);
+ offset = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type, offset, tmp);
+ offset = gfc_evaluate_now (offset, block);
+ }
+
+ gfc_conv_descriptor_offset_set (block, dest, offset);
+}
+
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index a356628e6755..44d8f26a62bd 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -105,6 +105,7 @@ void gfc_init_descriptor_variable (stmtblock_t *block,
gfc_symbol *sym, tree des
void gfc_conv_shift_descriptor_lbound (stmtblock_t *, tree, int, tree);
void gfc_conv_shift_descriptor (stmtblock_t *, tree, int);
void gfc_conv_shift_descriptor (stmtblock_t *, tree, const gfc_array_ref &);
+void gfc_conv_shift_descriptor (stmtblock_t *, tree, tree, int, tree);
void gfc_conv_remap_descriptor (stmtblock_t *, tree, int, tree, int,
gfc_array_ref *);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 05840c271037..5eff59150acf 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11600,7 +11600,6 @@ fcncall_realloc_result (gfc_se *se, int rank, tree
dtype)
tree desc;
tree res_desc;
tree tmp;
- tree offset;
tree zero_cond;
tree not_same_shape;
stmtblock_t shape_block;
@@ -11633,9 +11632,6 @@ fcncall_realloc_result (gfc_se *se, int rank, tree
dtype)
tmp = gfc_call_free (tmp);
gfc_add_expr_to_block (&se->post, tmp);
- tmp = gfc_conv_descriptor_data_get (res_desc);
- gfc_conv_descriptor_data_set (&se->post, desc, tmp);
-
/* Check that the shapes are the same between lhs and expression.
The evaluation of the shape is done in 'shape_block' to avoid
unitialized warnings from the lhs bounds. */
@@ -11679,37 +11675,7 @@ fcncall_realloc_result (gfc_se *se, int rank, tree
dtype)
/* Now reset the bounds returned from the function call to bounds based
on the lhs lbounds, except where the lhs is not allocated or the shapes
of 'variable and 'expr' are different. Set the offset accordingly. */
- offset = gfc_index_zero_node;
- for (n = 0 ; n < rank; n++)
- {
- tree lbound;
-
- lbound = gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[n]);
- lbound = fold_build3_loc (input_location, COND_EXPR,
- gfc_array_index_type, zero_cond,
- gfc_index_one_node, lbound);
- lbound = gfc_evaluate_now (lbound, &se->post);
-
- tmp = gfc_conv_descriptor_ubound_get (res_desc, gfc_rank_cst[n]);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type, tmp, lbound);
- gfc_conv_descriptor_lbound_set (&se->post, desc,
- gfc_rank_cst[n], lbound);
- gfc_conv_descriptor_ubound_set (&se->post, desc,
- gfc_rank_cst[n], tmp);
-
- /* Set stride and accumulate the offset. */
- tmp = gfc_conv_descriptor_stride_get (res_desc, gfc_rank_cst[n]);
- gfc_conv_descriptor_stride_set (&se->post, desc,
- gfc_rank_cst[n], tmp);
- tmp = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, lbound, tmp);
- offset = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type, offset, tmp);
- offset = gfc_evaluate_now (offset, &se->post);
- }
-
- gfc_conv_descriptor_offset_set (&se->post, desc, offset);
+ gfc_conv_shift_descriptor (&se->post, desc, res_desc, rank, zero_cond);
}
