https://gcc.gnu.org/g:ca66c35875951bab30878e0f450eac5298b3daf7
commit ca66c35875951bab30878e0f450eac5298b3daf7 Author: Mikael Morin <mik...@gcc.gnu.org> Date: Thu Jul 31 20:42:28 2025 +0200 Extraction gfc_copy_descriptor Diff: --- gcc/fortran/trans-descriptor.cc | 24 ++++++++++++++++++++++++ gcc/fortran/trans-descriptor.h | 1 + gcc/fortran/trans-expr.cc | 23 +++-------------------- 3 files changed, 28 insertions(+), 20 deletions(-) diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index 3c458e7a82fc..5e870a8c1625 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -1232,6 +1232,30 @@ gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src, } +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 tmp = gfc_get_descriptor_dimension (dest); + tree tmp2 = gfc_get_descriptor_dimension (src); + + tree type = lhs_type ? TREE_TYPE (tmp) : TREE_TYPE (tmp2); + tmp = build4_loc (input_location, ARRAY_RANGE_REF, type, tmp, + gfc_index_zero_node, NULL_TREE, NULL_TREE); + tmp2 = build4_loc (input_location, ARRAY_RANGE_REF, type, tmp2, + gfc_index_zero_node, NULL_TREE, NULL_TREE); + gfc_add_modify (block, tmp, tmp2); +} + + void gfc_set_descriptor (stmtblock_t *block, tree dest, tree src, gfc_expr *src_expr, int rank, int corank, gfc_ss *ss, gfc_array_info *info, diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h index 38ad52ad5f9d..4826d7a5bd94 100644 --- a/gcc/fortran/trans-descriptor.h +++ b/gcc/fortran/trans-descriptor.h @@ -102,6 +102,7 @@ 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); void gfc_copy_descriptor (stmtblock_t *, tree, tree, gfc_expr *, bool); +void gfc_copy_descriptor (stmtblock_t *, tree, tree, bool); void gfc_set_descriptor (stmtblock_t *block, tree dest, tree src, gfc_expr *src_expr, int rank, int corank, gfc_ss *ss, gfc_array_info *info, diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index f279eb7aa597..67a68e69b15d 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -838,32 +838,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 tmp, tmp2, 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. */ - tmp = gfc_get_descriptor_dimension (lhs_desc); - tmp2 = gfc_get_descriptor_dimension (rhs_desc); - - type = lhs_type ? TREE_TYPE (tmp) : TREE_TYPE (tmp2); - tmp = build4_loc (input_location, ARRAY_RANGE_REF, type, tmp, - gfc_index_zero_node, NULL_TREE, NULL_TREE); - tmp2 = build4_loc (input_location, ARRAY_RANGE_REF, type, tmp2, - gfc_index_zero_node, NULL_TREE, NULL_TREE); - gfc_add_modify (block, tmp, tmp2); + 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.