[gcc(refs/users/mikael/heads/refactor_descriptor_v01)] Déplacement gfc_copy_sequence_descriptor

[Mikael Morin via Gcc-cvs]

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

commit b829f1bacdd278adf81ed3033c805b00068375c9
Author: Mikael Morin <mik...@gcc.gnu.org>
Date:   Thu Jan 30 21:21:39 2025 +0100

    Déplacement gfc_copy_sequence_descriptor

Diff:
---
 gcc/fortran/trans-array.cc | 64 ++++++++++++++++++++++++++++++++++++++++++++++
 gcc/fortran/trans-array.h  |  1 +
 gcc/fortran/trans.h        |  1 -
 3 files changed, 65 insertions(+), 1 deletion(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index a1fb41fc9354..455c9bcd76cc 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1835,6 +1835,70 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree 
desc, tree scalar,
   gfc_conv_descriptor_data_set (block, desc, tmp);
 }
 
+int
+gfc_descriptor_rank (tree descriptor)
+{
+  if (TREE_TYPE (descriptor) != NULL_TREE)
+    return GFC_TYPE_ARRAY_RANK (TREE_TYPE (descriptor));
+
+  tree dim = gfc_get_descriptor_dimension (descriptor);
+  tree dim_type = TREE_TYPE (dim);
+  gcc_assert (TREE_CODE (dim_type) == ARRAY_TYPE);
+  tree idx_type = TYPE_DOMAIN (dim_type);
+  gcc_assert (TREE_CODE (idx_type) == INTEGER_TYPE);
+  gcc_assert (integer_zerop (TYPE_MIN_VALUE (idx_type)));
+  tree idx_max = TYPE_MAX_VALUE (idx_type);
+  if (idx_max == NULL_TREE)
+    return GFC_MAX_DIMENSIONS;
+  wide_int max = wi::to_wide (idx_max);
+  return max.to_shwi () + 1;
+}
+
+
+void
+gfc_copy_sequence_descriptor (stmtblock_t &block, tree lhs_desc, tree rhs_desc,
+                             bool assumed_rank_lhs)
+{
+  int lhs_rank = gfc_descriptor_rank (lhs_desc);
+  int rhs_rank = gfc_descriptor_rank (rhs_desc);
+  tree desc;
+
+  if (assumed_rank_lhs || lhs_rank == rhs_rank)
+    desc = rhs_desc;
+  else
+    {
+      tree arr = gfc_create_var (TREE_TYPE (lhs_desc), "parm");
+      gfc_conv_descriptor_data_set (&block, arr,
+                                   gfc_conv_descriptor_data_get (rhs_desc));
+      gfc_conv_descriptor_lbound_set (&block, arr, gfc_index_zero_node,
+                                     gfc_index_zero_node);
+      tree size = gfc_conv_descriptor_size (rhs_desc, rhs_rank);
+      gfc_conv_descriptor_ubound_set (&block, arr, gfc_index_zero_node, size);
+      gfc_conv_descriptor_stride_set (
+       &block, arr, gfc_index_zero_node,
+       gfc_conv_descriptor_stride_get (rhs_desc, gfc_index_zero_node));
+      for (int i = 1; i < lhs_rank; i++)
+       {
+         gfc_conv_descriptor_lbound_set (&block, arr, gfc_rank_cst[i],
+                                         gfc_index_zero_node);
+         gfc_conv_descriptor_ubound_set (&block, arr, gfc_rank_cst[i],
+                                         gfc_index_zero_node);
+         gfc_conv_descriptor_stride_set (&block, arr, gfc_rank_cst[i], size);
+       }
+      gfc_add_modify (&block, gfc_conv_descriptor_dtype (arr),
+                     gfc_conv_descriptor_dtype (rhs_desc));
+      gfc_add_modify (&block, gfc_conv_descriptor_rank (arr),
+                     build_int_cst (signed_char_type_node, lhs_rank));
+      gfc_conv_descriptor_span_set (&block, arr,
+                                   gfc_conv_descriptor_span_get (arr));
+      gfc_conv_descriptor_offset_set (&block, arr, gfc_index_zero_node);
+      desc = arr;
+    }
+
+  gfc_class_array_data_assign (&block, lhs_desc, desc, true);
+}
+
+
 
 /* Obtain offsets for trans-types.cc(gfc_get_array_descr_info).  */
 
diff --git a/gcc/fortran/trans-array.h b/gcc/fortran/trans-array.h
index 691231f66903..124020a53858 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -150,6 +150,7 @@ void gfc_set_descriptor_with_shape (stmtblock_t *, tree, 
tree,
 tree gfc_get_scalar_to_descriptor_type (tree scalar, symbol_attribute attr);
 void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree,
                                     symbol_attribute, bool, tree);
+void gfc_copy_sequence_descriptor (stmtblock_t &, tree, tree, bool);
 
 /* Get a single array element.  */
 void gfc_conv_array_ref (gfc_se *, gfc_array_ref *, gfc_expr *, locus *);
diff --git a/gcc/fortran/trans.h b/gcc/fortran/trans.h
index 797b4843e65e..8a72f5b84c11 100644
--- a/gcc/fortran/trans.h
+++ b/gcc/fortran/trans.h
@@ -462,7 +462,6 @@ void gfc_finalize_tree_expr (gfc_se *, gfc_symbol *, 
symbol_attribute, int);
 bool gfc_assignment_finalizer_call (gfc_se *, gfc_expr *, bool);
 
 void gfc_class_array_data_assign (stmtblock_t *, tree, tree, bool);
-void gfc_copy_sequence_descriptor (stmtblock_t &, tree, tree, bool);
 void gfc_conv_remap_descriptor (stmtblock_t *, tree, tree, int, const 
gfc_array_ref &);
 int gfc_descriptor_rank (tree);
 void gfc_conv_derived_to_class (gfc_se *, gfc_expr *, gfc_symbol *fsym, tree,