https://gcc.gnu.org/g:c820a4548c4b0bf7c6f9080643f2b233ad3d0e85
commit c820a4548c4b0bf7c6f9080643f2b233ad3d0e85 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 38b67b5e6a7f..3081a7fcc3a3 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -11670,7 +11670,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; @@ -11703,9 +11702,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. */ @@ -11749,37 +11745,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); }