https://gcc.gnu.org/g:1241140c1f4b340f1f27170e094fbca9bc786519
commit 1241140c1f4b340f1f27170e094fbca9bc786519
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 46477b42aa7f..652f0cb5c0f5 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1125,3 +1125,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 b3eada85332b..89312f8654ce 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -106,6 +106,7 @@ void gfc_descriptor_set_dtype_if_unallocated (stmtblock_t
*, tree, int);
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 f63ecb205153..84953d5504a0 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11584,7 +11584,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;
@@ -11617,9 +11616,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. */
@@ -11663,37 +11659,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);
}
