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

[Mikael Morin]

https://gcc.gnu.org/g:0d3e7672030237c5410d96cc7b9534e6f2a0dc5d

commit 0d3e7672030237c5410d96cc7b9534e6f2a0dc5d
Author: Mikael Morin <mikael@gcc.gnu.org>
Date:   Tue Dec 17 22:37:18 2024 +0100

    Appel méthode shift descriptor dans gfc_trans_pointer_assignment

Diff:
---
 gcc/fortran/trans-array.cc | 129 +++++++++++++++++++++++++++++++++++++++++++--
 gcc/fortran/trans-array.h  |   1 +
 gcc/fortran/trans-expr.cc  |  28 +---------
 3 files changed, 129 insertions(+), 29 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 22ec1fc05a14..8f0dff10fd81 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1153,13 +1153,136 @@ gfc_conv_shift_descriptor_lbound (stmtblock_t* block, tree desc,
 }
 
 
+class lb_info
+{
+public:
+  virtual gfc_expr *lower_bound (int dim) const = 0;
+};
+
+
+class unset_lb : public lb_info
+{
+public:
+  virtual gfc_expr *lower_bound (int) const { return nullptr; }
+};
+
+
+class defined_lb : public lb_info
+{
+  int rank;
+  gfc_expr * const * lower_bounds;
+
+public:
+  defined_lb (int arg_rank, gfc_expr * const arg_lower_bounds[GFC_MAX_DIMENSIONS])
+    : rank(arg_rank), lower_bounds(arg_lower_bounds) { }
+  virtual gfc_expr *lower_bound (int dim) const { return lower_bounds[dim]; }
+};
+
+
 static void
-conv_shift_descriptor (stmtblock_t* block, tree desc, int rank)
+conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
+		       const lb_info &info)
 {
   /* Apply a shift of the lbound when supplied.  */
   for (int dim = 0; dim < rank; ++dim)
-    gfc_conv_shift_descriptor_lbound (block, desc, dim,
-				      gfc_index_one_node);
+    {
+      gfc_expr *lb_expr = info.lower_bound(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, int rank)
+{
+  conv_shift_descriptor (block, desc, rank, unset_lb ());
+}
+
+
+static void
+conv_shift_descriptor (stmtblock_t *block, tree desc, int rank,
+		       gfc_expr * const lower_bounds[GFC_MAX_DIMENSIONS])
+{
+  conv_shift_descriptor (block, desc, rank, defined_lb (rank, lower_bounds));
+}
+
+
+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-array.h b/gcc/fortran/trans-array.h
index 17e3d08fdba0..3b05a2eb197a 100644
--- a/gcc/fortran/trans-array.h
+++ b/gcc/fortran/trans-array.h
@@ -214,6 +214,7 @@ tree gfc_get_cfi_dim_sm (tree, tree);
 
 /* Shift lower bound of descriptor, updating ubound and offset.  */
 void gfc_conv_shift_descriptor_lbound (stmtblock_t*, tree, int, tree);
+void gfc_conv_shift_descriptor (stmtblock_t*, tree, const gfc_array_ref &);
 
 /* Add pre-loop scalarization code for intrinsic functions which require
    special handling.  */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 23a570d7b5a1..3a166a728708 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11399,32 +11399,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