https://gcc.gnu.org/g:088a96c96cb6c3f1f4cf227c7c9e0a1dd868d8b2
commit 088a96c96cb6c3f1f4cf227c7c9e0a1dd868d8b2
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 e72720967e6d..6ca84c84e9ee 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1151,3 +1151,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 955778a3f412..5d4981ec29b1 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -109,5 +109,6 @@ void gfc_nullify_descriptor (stmtblock_t *block, tree);
void gfc_copy_sequence_descriptor (stmtblock_t *, tree, tree, int);
void gfc_conv_remap_descriptor (stmtblock_t *, tree, int, tree, int,
gfc_array_ref *);
+void gfc_conv_shift_descriptor (stmtblock_t *, tree, tree, int, tree);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index dde4e98986b4..b569cd8b73c9 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11787,7 +11787,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;
@@ -11820,9 +11819,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. */
@@ -11866,37 +11862,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);
}
