[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Extraction gfc_copy_descriptor

[Mikael Morin]

https://gcc.gnu.org/g:f20d1d53e139de278a6f23daa86ecf55211d3cfb

commit f20d1d53e139de278a6f23daa86ecf55211d3cfb
Author: Mikael Morin <mikael@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 123e7de97566..4572d16313fa 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 d5ca4d4fb82f..8b80c332f47d 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1270,3 +1270,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 cb920ff2cbbb..3a22abab72c2 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -108,6 +108,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_class (stmtblock_t *, tree, tree, gfc_expr *);
 void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, symbol_attribute,