https://gcc.gnu.org/g:fb326b71e6b3cf80ebce86996bb62d059aee4080
commit fb326b71e6b3cf80ebce86996bb62d059aee4080
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 5c28ca14723a..3a6716d8acbf 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1530,6 +1530,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_copy_descriptor (stmtblock_t *block, tree dest, tree src, tree ptr,
int rank, gfc_ss *ss)
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index b20f13b0d453..44cd4c8bf4d7 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -115,6 +115,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, gfc_ss *);
+void gfc_copy_descriptor (stmtblock_t *, tree, tree, bool);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 6e8a4d1400bb..6eeb8c33c604 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -760,32 +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 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.
