https://gcc.gnu.org/g:5fda078f56b74fbb8ca9ccb1d88b12395bc4d5a2

commit 5fda078f56b74fbb8ca9ccb1d88b12395bc4d5a2
Author: Mikael Morin <mik...@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       |  3 +++
 gcc/fortran/trans-descriptor.cc | 26 ++++++++++++++++++++++++++
 gcc/fortran/trans-descriptor.h  |  1 +
 4 files changed, 37 insertions(+), 32 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 079ed89ae10b..9d3ce7321129 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]);
@@ -2367,7 +2367,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 ();
@@ -5435,7 +5435,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);
@@ -8769,39 +8770,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 d8f3364a2122..7e3a2116cb4d 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -191,3 +191,6 @@ void gfc_trans_string_copy (stmtblock_t *, tree, tree, int, 
tree, tree, int);
 tree gfc_conv_array_extent_dim (tree, tree, tree*);
 tree gfc_conv_descriptor_size (tree, int);
 tree gfc_conv_descriptor_cosize (tree, int, int);
+
+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 cac02333ec8c..f06c097d4c2a 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1924,3 +1924,29 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree 
descr, tree scalar)
 
 }
 
+
+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 c37a3abacee6..fcdb6f8b84c7 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -130,5 +130,6 @@ void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, 
tree);
 void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *);
 void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *,
                                     tree, tree);
+void gfc_copy_descriptor (stmtblock_t *, tree, tree, tree, int, gfc_ss *);
 
 #endif /* GFC_TRANS_DESCRIPTOR_H */

Reply via email to