https://gcc.gnu.org/g:29f0c2a9f39a734b7e01ad691e6c814e4d75f689
commit 29f0c2a9f39a734b7e01ad691e6c814e4d75f689 Author: Mikael Morin <[email protected]> Date: Wed Jul 22 22:02:16 2026 +0200 Extraction gfc_copy_descriptor Correction artefact conflit rebase Suppression fonction inutilisée Diff: --- gcc/fortran/trans-descriptor.cc | 60 +++++++++++++++++++++++++++++++++++++++++ gcc/fortran/trans-descriptor.h | 1 + gcc/fortran/trans-expr.cc | 26 +++--------------- 3 files changed, 64 insertions(+), 23 deletions(-) diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index ad5687d2d610..b9f005fd7a86 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -1362,6 +1362,66 @@ gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src, } +static void +copy_coarray_desc_part (stmtblock_t *block, tree dest, tree src) +{ + tree src_type = TREE_TYPE (src); + if (TYPE_LANG_SPECIFIC (src_type) && TYPE_LANG_SPECIFIC (src_type)->corank) + { + struct lang_type *lang_specific = TYPE_LANG_SPECIFIC (src_type); + for (int c = 0; c < lang_specific->corank; ++c) + { + int dim = lang_specific->rank + c; + tree codim = gfc_rank_cst[dim]; + + if (lang_specific->lbound[dim]) + gfc_conv_descriptor_lbound_set (block, dest, codim, + lang_specific->lbound[dim]); + else + gfc_conv_descriptor_lbound_set ( + block, dest, codim, gfc_conv_descriptor_lbound_get (src, codim)); + if (dim + 1 < lang_specific->corank) + { + if (lang_specific->ubound[dim]) + gfc_conv_descriptor_ubound_set (block, dest, codim, + lang_specific->ubound[dim]); + else + gfc_conv_descriptor_ubound_set ( + block, dest, codim, + gfc_conv_descriptor_ubound_get (src, codim)); + } + } + } +} + + +void +gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src, bool lhs_type) +{ + gfc_conv_descriptor_data_set (block, dest, + gfc_conv_descriptor_data_get (src)); + gfc_conv_descriptor_offset_set (block, dest, + gfc_conv_descriptor_offset_get (src)); + + gfc_conv_descriptor_dtype_set (block, dest, + gfc_conv_descriptor_dtype_get (src)); + + /* Assign the dimension as range-ref. */ + tree lhs_dim = gfc_get_descriptor_dimension (dest); + tree rhs_dim = gfc_get_descriptor_dimension (src); + + tree type = lhs_type ? TREE_TYPE (lhs_dim) : TREE_TYPE (rhs_dim); + lhs_dim = build4_loc (input_location, ARRAY_RANGE_REF, type, lhs_dim, + gfc_index_zero_node, NULL_TREE, NULL_TREE); + rhs_dim = build4_loc (input_location, ARRAY_RANGE_REF, type, rhs_dim, + gfc_index_zero_node, NULL_TREE, NULL_TREE); + gfc_add_modify (block, lhs_dim, rhs_dim); + + /* The corank dimensions are not copied by the ARRAY_RANGE_REF. */ + copy_coarray_desc_part (block, dest, src); +} + + void gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src, tree ptr, int rank) diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h index 808007345084..59b93ab9a29a 100644 --- a/gcc/fortran/trans-descriptor.h +++ b/gcc/fortran/trans-descriptor.h @@ -95,6 +95,7 @@ void gfc_shift_descriptor (stmtblock_t *, tree, int, tree [GFC_MAX_DIMENSIONS], void gfc_copy_sequence_descriptor (stmtblock_t *, tree, tree, int); void gfc_copy_descriptor (stmtblock_t *, tree, tree, gfc_expr *, bool); void gfc_copy_descriptor (stmtblock_t *, tree, tree, tree, int); +void gfc_copy_descriptor (stmtblock_t *, tree, tree, bool); void gfc_set_descriptor_from_scalar_class (stmtblock_t *, tree, tree, gfc_expr *); void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, symbol_attribute, diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 6f5a3308b76c..f365a847d805 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -760,35 +760,15 @@ gfc_get_vptr_from_expr (tree expr) return NULL_TREE; } + void gfc_class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc, bool lhs_type) { - tree lhs_dim, rhs_dim, type; - - gfc_conv_descriptor_data_set (block, lhs_desc, - gfc_conv_descriptor_data_get (rhs_desc)); - gfc_conv_descriptor_offset_set (block, lhs_desc, - gfc_conv_descriptor_offset_get (rhs_desc)); - - gfc_conv_descriptor_dtype_set (block, lhs_desc, - gfc_conv_descriptor_dtype_get (rhs_desc)); - - /* Assign the dimension as range-ref. */ - lhs_dim = gfc_get_descriptor_dimension (lhs_desc); - rhs_dim = gfc_get_descriptor_dimension (rhs_desc); - - type = lhs_type ? TREE_TYPE (lhs_dim) : TREE_TYPE (rhs_dim); - lhs_dim = build4_loc (input_location, ARRAY_RANGE_REF, type, lhs_dim, - gfc_index_zero_node, NULL_TREE, NULL_TREE); - rhs_dim = build4_loc (input_location, ARRAY_RANGE_REF, type, rhs_dim, - gfc_index_zero_node, NULL_TREE, NULL_TREE); - gfc_add_modify (block, lhs_dim, rhs_dim); - - /* The corank dimensions are not copied by the ARRAY_RANGE_REF. */ - gfc_copy_coarray_desc_part (block, lhs_desc, rhs_desc); + gfc_copy_descriptor (block, lhs_desc, rhs_desc, lhs_type); } + /* Takes a derived type expression and returns the address of a temporary class object of the 'declared' type. If opt_vptr_src is not NULL, this is used for the temporary class object.
