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.

Reply via email to