[gcc(refs/users/mikael/heads/refactor_descriptor_v291.01)] Extraction gfc_copy_descriptor

https://gcc.gnu.org/g:8d2de5216539d9ac0cb2bacbc511678c2aec6407

commit 8d2de5216539d9ac0cb2bacbc511678c2aec6407
Author: Mikael Morin <[email protected]>
Date:   Wed Jul 22 21:48:21 2026 +0200

    Extraction gfc_copy_descriptor
    
    Correction artefact conflit rebase
    
    Correction de la correction
    
    Correction artefact conflit rebase
    
    Correction artefact conflit rebase

Diff:
---
 gcc/fortran/trans-array.cc      | 131 +++-------------------------------------
 gcc/fortran/trans-array.h       |   1 +
 gcc/fortran/trans-descriptor.cc | 111 +++++++++++++++++++++++++++++++++-
 gcc/fortran/trans-descriptor.h  |   1 +
 4 files changed, 119 insertions(+), 125 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 509eaaf90a81..3f7f0c415409 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -896,8 +896,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]);
@@ -2497,7 +2497,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 ();
@@ -5702,7 +5702,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);
@@ -9252,129 +9253,11 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77,
 	    {
 	      /* The original descriptor may have transposed dims so we
 		 can't reuse it directly; we have to create a new one.  */
-	      tree old_field;
 	      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);
-
-	      if (expr->rank == -1)
-		{
-		  tree idx = gfc_create_var (gfc_array_dim_rank_type, "idx");
-		  tree stride = gfc_create_var (gfc_array_index_type, "stride");
-		  stmtblock_t loop_body;
-
-		  gfc_conv_descriptor_offset_set (&se->pre, new_desc,
-						  gfc_index_zero_node);
-		  gfc_conv_descriptor_span_set (&se->pre, new_desc,
-						gfc_conv_descriptor_span_get
-						(old_desc));
-		  gfc_add_modify (&se->pre, stride, gfc_index_one_node);
-
-		  gfc_init_block (&loop_body);
-
-		  old_field = gfc_conv_descriptor_lbound_get (old_desc, idx);
-		  gfc_conv_descriptor_lbound_set (&loop_body, new_desc, idx,
-						  old_field);
-
-		  old_field = gfc_conv_descriptor_ubound_get (old_desc, idx);
-		  gfc_conv_descriptor_ubound_set (&loop_body, new_desc, idx,
-						  old_field);
-
-		  gfc_conv_descriptor_stride_set (&loop_body, new_desc, idx,
-						  stride);
-
-		  tree offset = fold_build2_loc (input_location, MULT_EXPR,
-						 gfc_array_index_type, stride,
-						 gfc_conv_descriptor_lbound_get
-						 (new_desc, idx));
-		  offset = fold_build2_loc (input_location, MINUS_EXPR,
-					    gfc_array_index_type,
-					    gfc_conv_descriptor_offset_get
-					    (new_desc), offset);
-		  gfc_conv_descriptor_offset_set (&loop_body, new_desc, offset);
-
-		  tree extent = gfc_conv_array_extent_dim
-				(gfc_conv_descriptor_lbound_get (new_desc, idx),
-				 gfc_conv_descriptor_ubound_get (new_desc, idx),
-				 NULL);
-		  extent = fold_build2_loc (input_location, MULT_EXPR,
-					    gfc_array_index_type, stride,
-					    extent);
-		  gfc_add_modify (&loop_body, stride, extent);
-
-		  gfc_simple_for_loop (&se->pre, idx,
-				       build_int_cst (TREE_TYPE (idx), 0),
-				       gfc_conv_descriptor_rank_get (old_desc),
-				       LT_EXPR,
-				       build_int_cst (TREE_TYPE (idx), 1),
-				       gfc_finish_block (&loop_body));
-		}
-	      else
-		{
-		  tree offset = gfc_index_zero_node;
-
-		  tree stride = gfc_index_one_node;
-
-		  for (int i = 0; i < expr->rank; i++)
-		    {
-		      tree dim = gfc_rank_cst[i];
-
-		      tree lbound = gfc_conv_descriptor_lbound_get (old_desc,
-								    dim);
-		      lbound = gfc_evaluate_now (lbound, &se->pre);
-		      gfc_conv_descriptor_lbound_set (&se->pre, new_desc, dim,
-						      lbound);
-
-		      tree ubound = gfc_conv_descriptor_ubound_get (old_desc,
-								    dim);
-		      ubound = gfc_evaluate_now (ubound, &se->pre);
-		      gfc_conv_descriptor_ubound_set (&se->pre, new_desc, dim,
-						      ubound);
-
-		      gfc_conv_descriptor_stride_set (&se->pre, new_desc, dim,
-						      stride);
-
-		      tree tmp = fold_build2_loc (input_location, MULT_EXPR,
-						  gfc_array_index_type,
-						  stride, lbound);
-		      offset = fold_build2_loc (input_location, MINUS_EXPR,
-						gfc_array_index_type,
-						offset, tmp);
-		      offset = gfc_evaluate_now (offset, &se->pre);
-
-		      /* Now calculate the stride for next dimension, unless the
-			 current dimension is the last one.  */
-		      if (i == expr->rank - 1)
-			break;
-
-		      tmp = fold_build2_loc (input_location, MINUS_EXPR,
-					     gfc_array_index_type,
-					     lbound, gfc_index_one_node);
-		      tree extent = fold_build2_loc (input_location, MINUS_EXPR,
-						     gfc_array_index_type,
-						     ubound, tmp);
-		      stride = fold_build2_loc (input_location, MULT_EXPR,
-						gfc_array_index_type,
-						stride, extent);
-		      stride = gfc_evaluate_now (stride, &se->pre);
-		    }
-
-		  gfc_conv_descriptor_offset_set (&se->pre, new_desc, offset);
-		}
-
-	      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);
 	      se->expr = gfc_build_addr_expr (NULL_TREE, new_desc);
 	    }
 	}
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 1dde17d42b21..de08126ebac5 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -192,3 +192,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 9b8132870620..aa2e87200448 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -895,7 +895,7 @@ gfc_grow_array (stmtblock_t * pblock, tree desc, tree extra)
 void
 gfc_nullify_descriptor (stmtblock_t *block, tree descr)
 {
-  gfc_conv_descriptor_data_set (block, descr, null_pointer_node); 
+  gfc_conv_descriptor_data_set (block, descr, null_pointer_node);
 }
 
 
@@ -1375,3 +1375,112 @@ 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_conv_descriptor_dtype_set (block, dest,
+				 gfc_conv_descriptor_dtype_get (src));
+
+  if (rank == -1)
+    {
+      tree idx = gfc_create_var (gfc_array_dim_rank_type, "idx");
+      tree stride = gfc_create_var (gfc_array_index_type, "stride");
+      stmtblock_t loop_body;
+
+      gfc_conv_descriptor_offset_set (block, dest, gfc_index_zero_node);
+      gfc_conv_descriptor_span_set (block, dest,
+				    gfc_conv_descriptor_span_get (src));
+      gfc_add_modify (block, stride, gfc_index_one_node);
+
+      gfc_init_block (&loop_body);
+
+      tree old_field = gfc_conv_descriptor_lbound_get (src, idx);
+      gfc_conv_descriptor_lbound_set (&loop_body, dest, idx,
+				      old_field);
+
+      old_field = gfc_conv_descriptor_ubound_get (src, idx);
+      gfc_conv_descriptor_ubound_set (&loop_body, dest, idx,
+				      old_field);
+
+      gfc_conv_descriptor_stride_set (&loop_body, dest, idx,
+				      stride);
+
+      tree offset = fold_build2_loc (input_location, MULT_EXPR,
+				     gfc_array_index_type, stride,
+				     gfc_conv_descriptor_lbound_get (dest,
+								     idx));
+      offset = fold_build2_loc (input_location, MINUS_EXPR,
+				gfc_array_index_type,
+				gfc_conv_descriptor_offset_get (dest),
+				offset);
+      gfc_conv_descriptor_offset_set (&loop_body, dest, offset);
+
+      tree extent = gfc_conv_array_extent_dim
+		    (gfc_conv_descriptor_lbound_get (dest, idx),
+		     gfc_conv_descriptor_ubound_get (dest, idx),
+		     NULL);
+      extent = fold_build2_loc (input_location, MULT_EXPR,
+				gfc_array_index_type, stride,
+				extent);
+      gfc_add_modify (&loop_body, stride, extent);
+
+      gfc_simple_for_loop (block, idx, build_int_cst (TREE_TYPE (idx), 0),
+			   gfc_conv_descriptor_rank_get (src), LT_EXPR,
+			   build_int_cst (TREE_TYPE (idx), 1),
+			   gfc_finish_block (&loop_body));
+    }
+  else
+    {
+      tree offset = gfc_index_zero_node;
+
+      tree stride = gfc_index_one_node;
+
+      for (int i = 0; i < rank; i++)
+	{
+	  tree dim = gfc_rank_cst[i];
+
+	  tree lbound = gfc_conv_descriptor_lbound_get (src, dim);
+	  lbound = gfc_evaluate_now (lbound, block);
+	  gfc_conv_descriptor_lbound_set (block, dest, dim, lbound);
+
+	  tree ubound = gfc_conv_descriptor_ubound_get (src, dim);
+	  ubound = gfc_evaluate_now (ubound, block);
+	  gfc_conv_descriptor_ubound_set (block, dest, dim, ubound);
+
+	  gfc_conv_descriptor_stride_set (block, dest, dim, stride);
+
+	  tree tmp = fold_build2_loc (input_location, MULT_EXPR,
+				      gfc_array_index_type, stride, lbound);
+	  offset = fold_build2_loc (input_location, MINUS_EXPR,
+				    gfc_array_index_type, offset, tmp);
+	  offset = gfc_evaluate_now (offset, block);
+
+	  /* Now calculate the stride for next dimension, unless the
+	     current dimension is the last one.  */
+	  if (i == rank - 1)
+	    break;
+
+	  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+				 gfc_array_index_type, lbound,
+				 gfc_index_one_node);
+	  tree extent = fold_build2_loc (input_location, MINUS_EXPR,
+					 gfc_array_index_type, ubound, tmp);
+	  stride = fold_build2_loc (input_location, MULT_EXPR,
+				    gfc_array_index_type, stride, extent);
+	  stride = gfc_evaluate_now (stride, block);
+	}
+
+      gfc_conv_descriptor_offset_set (block, dest, offset);
+    }
+
+  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 7e4bbe7439c0..037e7f0668a6 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -96,6 +96,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);
 
 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,