[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Appel méthode shift descriptor dans gfc_trans_pointer_assignment

[Mikael Morin]

https://gcc.gnu.org/g:01451d552f75b6ad4564b8d6983b6d7b86667da5

commit 01451d552f75b6ad4564b8d6983b6d7b86667da5
Author: Mikael Morin <mikael@gcc.gnu.org>
Date:   Wed Jul 16 15:07:58 2025 +0200

    Appel méthode shift descriptor dans gfc_trans_pointer_assignment

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

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index b8ab46190fe4..591887cb70e2 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1027,3 +1027,95 @@ gfc_conv_shift_descriptor (stmtblock_t* block, tree desc, int rank)
     gfc_conv_shift_descriptor_lbound (block, desc, dim,
 				      gfc_index_one_node);
 }
+
+
+static void
+conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
+		       gfc_expr * const (lbound[GFC_MAX_DIMENSIONS]))
+{
+  /* Apply a shift of the lbound when supplied.  */
+  for (int dim = 0; dim < rank; ++dim)
+    {
+      gfc_expr *lb_expr = lbound[dim];
+
+      tree lower_bound;
+      if (lb_expr == nullptr)
+	lower_bound = gfc_index_one_node;
+      else
+	{
+	  gfc_se lb_se;
+
+	  gfc_init_se (&lb_se, nullptr);
+	  gfc_conv_expr (&lb_se, lb_expr);
+
+	  gfc_add_block_to_block (block, &lb_se.pre);
+	  tree lb_var = gfc_create_var (TREE_TYPE (lb_se.expr), "lower_bound");
+	  gfc_add_modify (block, lb_var, lb_se.expr);
+	  gfc_add_block_to_block (block, &lb_se.post);
+
+	  lower_bound = lb_var;
+	}
+
+      gfc_conv_shift_descriptor_lbound (block, desc, dim, lower_bound);
+    }
+}
+
+
+static void
+conv_shift_descriptor (stmtblock_t *block, tree desc,
+		       const gfc_array_spec &as)
+{
+  conv_shift_descriptor (block, desc, as.rank, as.lower);
+}
+
+
+static void
+set_type (array_type &type, array_type value)
+{
+  gcc_assert (type == AS_UNKNOWN || type == value);
+  type = value;
+}
+
+
+static void
+array_ref_to_array_spec (const gfc_array_ref &ref, gfc_array_spec &spec)
+{
+  spec.rank = ref.dimen;
+  spec.corank = ref.codimen;
+
+  spec.type = AS_UNKNOWN;
+  spec.cotype = AS_ASSUMED_SIZE;
+
+  for (int dim = 0; dim < spec.rank + spec.corank; dim++)
+    switch (ref.dimen_type[dim])
+      {
+      case DIMEN_ELEMENT:
+	spec.upper[dim] = ref.start[dim];
+	set_type (spec.type, AS_EXPLICIT);
+	break;
+
+      case DIMEN_RANGE:
+	spec.lower[dim] = ref.start[dim];
+	spec.upper[dim] = ref.end[dim];
+	if (spec.upper[dim] == nullptr)
+	  set_type (spec.type, AS_DEFERRED);
+	else
+	  set_type (spec.type, AS_EXPLICIT);
+	break;
+
+      default:
+	break;
+      }
+}
+
+
+void
+gfc_conv_shift_descriptor (stmtblock_t *block, tree desc,
+			   const gfc_array_ref &ar)
+{
+  gfc_array_spec as;
+
+  array_ref_to_array_spec (ar, as);
+
+  conv_shift_descriptor (block, desc, as);
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 21c52e37f0e0..1d9a640bccb5 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -102,6 +102,7 @@ void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree des
 
 void gfc_conv_shift_descriptor_lbound (stmtblock_t *, tree, int, tree);
 void gfc_conv_shift_descriptor (stmtblock_t *, tree, int);
+void gfc_conv_shift_descriptor (stmtblock_t *, tree, const gfc_array_ref &);
 
 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 8916087d53e5..096abd600dd9 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11376,32 +11376,8 @@ gfc_trans_pointer_assignment (gfc_expr * expr1, gfc_expr * expr2)
 		}
 	    }
 	  else
-	    {
-	      /* Bounds remapping.  Just shift the lower bounds.  */
-
-	      gcc_assert (expr1->rank == expr2->rank);
-
-	      for (dim = 0; dim < remap->u.ar.dimen; ++dim)
-		{
-		  gfc_se lbound_se;
-
-		  gcc_assert (!remap->u.ar.end[dim]);
-		  gfc_init_se (&lbound_se, NULL);
-		  if (remap->u.ar.start[dim])
-		    {
-		      gfc_conv_expr (&lbound_se, remap->u.ar.start[dim]);
-		      gfc_add_block_to_block (&block, &lbound_se.pre);
-		    }
-		  else
-		    /* This remap arises from a target that is not a whole
-		       array. The start expressions will be NULL but we need
-		       the lbounds to be one.  */
-		    lbound_se.expr = gfc_index_one_node;
-		  gfc_conv_shift_descriptor_lbound (&block, desc,
-						    dim, lbound_se.expr);
-		  gfc_add_block_to_block (&block, &lbound_se.post);
-		}
-	    }
+	    /* Bounds remapping.  Just shift the lower bounds.  */
+	    gfc_conv_shift_descriptor (&block, desc, remap->u.ar);
 	}
 
       /* If rank remapping was done, check with -fcheck=bounds that