https://gcc.gnu.org/g:6eff7ad9d828e7406265c7b571247cc956232465
commit 6eff7ad9d828e7406265c7b571247cc956232465
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Wed Jul 16 22:09:17 2025 +0200
Extraction gfc_copy_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 25 ++-----------------------
gcc/fortran/trans-descriptor.cc | 33 +++++++++++++++++++++++++++++++++
gcc/fortran/trans-descriptor.h | 1 +
3 files changed, 36 insertions(+), 23 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index ca512aeceeba..2498fc545de2 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -7871,29 +7871,8 @@ gfc_conv_expr_descriptor (gfc_se *se, gfc_expr *expr)
if (full && !transposed_dims (ss))
{
if (se->direct_byref && !se->byref_noassign)
- {
- struct lang_type *lhs_ls
- = TYPE_LANG_SPECIFIC (TREE_TYPE (se->expr)),
- *rhs_ls = TYPE_LANG_SPECIFIC (TREE_TYPE (desc));
- /* When only the array_kind differs, do a view_convert. */
- tmp = lhs_ls && rhs_ls && lhs_ls->rank == rhs_ls->rank
- && lhs_ls->akind != rhs_ls->akind
- ? build1 (VIEW_CONVERT_EXPR, TREE_TYPE (se->expr), desc)
- : desc;
- /* Copy the descriptor for pointer assignments. */
- gfc_add_modify (&se->pre, se->expr, tmp);
-
- /* Add any offsets from subreferences. */
- gfc_get_dataptr_offset (&se->pre, se->expr, desc, NULL_TREE,
- subref_array_target, expr);
-
- /* ....and set the span field. */
- if (ss_info->expr->ts.type == BT_CHARACTER)
- tmp = gfc_conv_descriptor_span_get (desc);
- else
- tmp = gfc_get_array_span (desc, expr);
- gfc_conv_descriptor_span_set (&se->pre, se->expr, tmp);
- }
+ gfc_copy_descriptor (&se->pre, se->expr, desc, expr,
+ subref_array_target);
else if (se->want_pointer)
{
/* We pass full arrays directly. This means that pointers and
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 7b3c10f50994..2b37a0d82005 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1495,3 +1495,36 @@ gfc_copy_sequence_descriptor (stmtblock_t *block, tree
dest, tree src, int rank)
gfc_conv_descriptor_span_get (src));
gfc_conv_descriptor_offset_set (block, dest, gfc_index_zero_node);
}
+
+
+void
+gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src,
+ gfc_expr *src_expr, bool subref)
+{
+ struct lang_type *dest_ls = TYPE_LANG_SPECIFIC (TREE_TYPE (dest));
+ struct lang_type *src_ls = TYPE_LANG_SPECIFIC (TREE_TYPE (src));
+
+ /* When only the array_kind differs, do a view_convert. */
+ tree tmp1;
+ if (dest_ls
+ && src_ls
+ && dest_ls->rank == src_ls->rank
+ && dest_ls->akind != src_ls->akind)
+ tmp1 = build1 (VIEW_CONVERT_EXPR, TREE_TYPE (dest), src);
+ else
+ tmp1 = src;
+
+ /* Copy the descriptor for pointer assignments. */
+ gfc_add_modify (block, dest, tmp1);
+
+ /* Add any offsets from subreferences. */
+ gfc_get_dataptr_offset (block, dest, src, NULL_TREE, subref, src_expr);
+
+ /* ....and set the span field. */
+ tree tmp2;
+ if (src_expr->ts.type == BT_CHARACTER)
+ tmp2 = gfc_conv_descriptor_span_get (src);
+ else
+ tmp2 = gfc_get_array_span (src, src_expr);
+ gfc_conv_descriptor_span_set (block, dest, tmp2);
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 1b02c86fcf37..1367942ead29 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -113,6 +113,7 @@ void gfc_shift_descriptor (stmtblock_t *, tree, int, tree
[GFC_MAX_DIMENSIONS],
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_set_descriptor_from_scalar (stmtblock_t *, tree, tree);
void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *);
