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

[Mikael Morin]

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

commit cb75a4a15b1fcc7b80c14192b4cd56e3f5237475
Author: Mikael Morin <mikael@gcc.gnu.org>
Date:   Wed Jul 23 10:48:32 2025 +0200

    Extraction gfc_copy_descriptor

Diff:
---
 gcc/fortran/trans-array.cc      | 39 +++++++--------------------------------
 gcc/fortran/trans-array.h       |  1 +
 gcc/fortran/trans-descriptor.cc | 27 +++++++++++++++++++++++++++
 gcc/fortran/trans-descriptor.h  |  1 +
 4 files changed, 36 insertions(+), 32 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 4572d16313fa..c1bad7057af5 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -788,8 +788,8 @@ innermost_ss (gfc_ss *ss)
    It is different from the loop dimension in the case of a transposed array.
    */
 
-static int
-get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim)
+int
+gfc_get_array_ref_dim_for_loop_dim (gfc_ss *ss, int loop_dim)
 {
   return get_scalarizer_dim_for_array_dim (innermost_ss (ss),
 					   ss->dim[loop_dim]);
@@ -2361,7 +2361,7 @@ get_loop_upper_bound_for_array (gfc_ss *array, int array_dim)
 
   for (ss = array; ss; ss = ss->parent)
     for (n = 0; n < ss->loop->dimen; n++)
-      if (array_dim == get_array_ref_dim_for_loop_dim (ss, n))
+      if (array_dim == gfc_get_array_ref_dim_for_loop_dim (ss, n))
 	return &(ss->loop->to[n]);
 
   gcc_unreachable ();
@@ -5480,7 +5480,8 @@ set_loop_bounds (gfc_loopinfo *loop)
 	  && INTEGER_CST_P (info->stride[dim]))
 	{
 	  loop->from[n] = info->start[dim];
-	  mpz_set (i, cshape[get_array_ref_dim_for_loop_dim (loopspec[n], n)]);
+	  int idx = gfc_get_array_ref_dim_for_loop_dim (loopspec[n], n);
+	  mpz_set (i, cshape[idx]);
 	  mpz_sub_ui (i, i, 1);
 	  /* To = from + (size - 1) * stride.  */
 	  tmp = gfc_conv_mpz_to_tree (i, gfc_index_integer_kind);
@@ -8952,39 +8953,13 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77,
 	    }
 	  else if (!ctree)
 	    {
-	      tree old_field;
-
 	      /* The original descriptor has transposed dims so we can't reuse
 		 it directly; we have to create a new one.  */
 	      tree old_desc = tmp;
 	      tree new_desc = gfc_create_var (TREE_TYPE (old_desc), "arg_desc");
 
-	      old_field = gfc_conv_descriptor_dtype_get (old_desc);
-	      gfc_conv_descriptor_dtype_set (&se->pre, new_desc, old_field);
-
-	      old_field = gfc_conv_descriptor_offset_get (old_desc);
-	      gfc_conv_descriptor_offset_set (&se->pre, new_desc, old_field);
-
-	      for (int i = 0; i < expr->rank; i++)
-		{
-		  int idx = get_array_ref_dim_for_loop_dim (ss, i);
-		  old_field = gfc_conv_descriptor_dimension_get (old_desc, idx);
-		  gfc_conv_descriptor_dimension_set (&se->pre, new_desc, i,
-						     old_field);
-						      
-		}
-
-	      if (flag_coarray == GFC_FCOARRAY_LIB
-		  && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (old_desc))
-		  && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (old_desc))
-		     == GFC_ARRAY_ALLOCATABLE)
-		{
-		  old_field = gfc_conv_descriptor_token (old_desc);
-		  gfc_conv_descriptor_token_set (&se->pre, new_desc,
-						 old_field);
-		}
-
-	      gfc_conv_descriptor_data_set (&se->pre, new_desc, ptr);
+	      gfc_copy_descriptor (&se->pre, new_desc, old_desc, ptr,
+				   expr->rank, ss);
 	      se->expr = gfc_build_addr_expr (NULL_TREE, new_desc);
 	    }
 	  gfc_free_ss (ss);
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index f0ecc8c57877..8b02e331aa1a 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -189,3 +189,4 @@ void gfc_trans_string_copy (stmtblock_t *, tree, tree, int, tree, tree, int);
 
 /* Calculate extent / size of an array.  */
 tree gfc_conv_array_extent_dim (tree, tree, tree*);
+int gfc_get_array_ref_dim_for_loop_dim (gfc_ss *, int);
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 8b80c332f47d..7fcd8a8bb207 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1303,3 +1303,30 @@ gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src,
     tmp2 = gfc_get_array_span (src, src_expr);
   gfc_conv_descriptor_span_set (block, dest, tmp2);
 }
+
+
+void
+gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src, tree ptr,
+		     int rank, gfc_ss *ss)
+{
+  gfc_conv_descriptor_dtype_set (block, dest,
+				 gfc_conv_descriptor_dtype_get (src));
+
+  gfc_conv_descriptor_offset_set (block, dest,
+				  gfc_conv_descriptor_offset_get (src));
+
+  for (int i = 0; i < rank; i++)
+    {
+      int idx = gfc_get_array_ref_dim_for_loop_dim (ss, i);
+      tree old_field = gfc_conv_descriptor_dimension_get (src, idx);
+      gfc_conv_descriptor_dimension_set (block, dest, i, old_field);
+    }
+
+  if (flag_coarray == GFC_FCOARRAY_LIB
+      && GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (src))
+      && GFC_TYPE_ARRAY_AKIND (TREE_TYPE (src)) == GFC_ARRAY_ALLOCATABLE)
+    gfc_conv_descriptor_token_set (block, dest,
+				   gfc_conv_descriptor_token (src));
+
+  gfc_conv_descriptor_data_set (block, dest, ptr);
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 3a22abab72c2..ab4d1755132a 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -109,6 +109,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_set_descriptor_from_scalar_class (stmtblock_t *, tree, tree, gfc_expr *);
 void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, symbol_attribute,