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

https://gcc.gnu.org/g:8633643bfa82d9d37b2c552ca6aa9344f0ded2c2

commit 8633643bfa82d9d37b2c552ca6aa9344f0ded2c2
Author: Mikael Morin <[email protected]>
Date:   Wed Jul 22 22:02:16 2026 +0200

    Extraction gfc_copy_descriptor
    
    Correction artefact conflit rebase
    
    Suppression fonction inutilisée

Diff:
---
 gcc/fortran/trans-descriptor.cc | 60 +++++++++++++++++++++++++++++++++++++++++
 gcc/fortran/trans-descriptor.h  |  1 +
 gcc/fortran/trans-expr.cc       | 26 +++---------------
 3 files changed, 64 insertions(+), 23 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index aa2e87200448..5771788c517c 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1377,6 +1377,66 @@ gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src,
 }
 
 
+static void
+copy_coarray_desc_part (stmtblock_t *block, tree dest, tree src)
+{
+  tree src_type = TREE_TYPE (src);
+  if (TYPE_LANG_SPECIFIC (src_type) && TYPE_LANG_SPECIFIC (src_type)->corank)
+    {
+      struct lang_type *lang_specific = TYPE_LANG_SPECIFIC (src_type);
+      for (int c = 0; c < lang_specific->corank; ++c)
+	{
+	  int dim = lang_specific->rank + c;
+	  tree codim = gfc_rank_cst[dim];
+
+	  if (lang_specific->lbound[dim])
+	    gfc_conv_descriptor_lbound_set (block, dest, codim,
+					    lang_specific->lbound[dim]);
+	  else
+	    gfc_conv_descriptor_lbound_set (
+	      block, dest, codim, gfc_conv_descriptor_lbound_get (src, codim));
+	  if (dim + 1 < lang_specific->corank)
+	    {
+	      if (lang_specific->ubound[dim])
+		gfc_conv_descriptor_ubound_set (block, dest, codim,
+						lang_specific->ubound[dim]);
+	      else
+		gfc_conv_descriptor_ubound_set (
+		  block, dest, codim,
+		  gfc_conv_descriptor_ubound_get (src, codim));
+	    }
+	}
+    }
+}
+
+
+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 lhs_dim = gfc_get_descriptor_dimension (dest);
+  tree rhs_dim = gfc_get_descriptor_dimension (src);
+
+  tree type = lhs_type ? TREE_TYPE (lhs_dim) : TREE_TYPE (rhs_dim);
+  lhs_dim = build4_loc (input_location, ARRAY_RANGE_REF, type, lhs_dim,
+		    gfc_index_zero_node, NULL_TREE, NULL_TREE);
+  rhs_dim = build4_loc (input_location, ARRAY_RANGE_REF, type, rhs_dim,
+		     gfc_index_zero_node, NULL_TREE, NULL_TREE);
+  gfc_add_modify (block, lhs_dim, rhs_dim);
+
+  /* The corank dimensions are not copied by the ARRAY_RANGE_REF.  */
+  copy_coarray_desc_part (block, dest, src);
+}
+
+
 void
 gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src, tree ptr,
 		     int rank)
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 037e7f0668a6..f13ef56f264e 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -97,6 +97,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_copy_descriptor (stmtblock_t *, tree, tree, 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,
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index a79f95ee0f48..5a8f05f5204a 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -760,35 +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 lhs_dim, rhs_dim, 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.  */
-  lhs_dim = gfc_get_descriptor_dimension (lhs_desc);
-  rhs_dim = gfc_get_descriptor_dimension (rhs_desc);
-
-  type = lhs_type ? TREE_TYPE (lhs_dim) : TREE_TYPE (rhs_dim);
-  lhs_dim = build4_loc (input_location, ARRAY_RANGE_REF, type, lhs_dim,
-			gfc_index_zero_node, NULL_TREE, NULL_TREE);
-  rhs_dim = build4_loc (input_location, ARRAY_RANGE_REF, type, rhs_dim,
-			gfc_index_zero_node, NULL_TREE, NULL_TREE);
-  gfc_add_modify (block, lhs_dim, rhs_dim);
-
-  /* The corank dimensions are not copied by the ARRAY_RANGE_REF.  */
-  gfc_copy_coarray_desc_part (block, lhs_desc, rhs_desc);
+  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.