[gcc(refs/users/mikael/heads/refactor_descriptor_v05)] Factorisation initialisation dimension descripteur

[Mikael Morin]

https://gcc.gnu.org/g:76ad43b115e9b392799e3b656185cede4f3c313b

commit 76ad43b115e9b392799e3b656185cede4f3c313b
Author: Mikael Morin <mikael@gcc.gnu.org>
Date:   Sat Feb 8 21:37:49 2025 +0100

    Factorisation initialisation dimension descripteur
    
    Correction régression realloc_on_assign_12.f90

Diff:
---
 gcc/fortran/trans-array.cc | 87 +++++++++++++++++++++++++---------------------
 1 file changed, 48 insertions(+), 39 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 87114f13424b..cbe0c85ca235 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -1474,38 +1474,56 @@ gfc_build_null_descriptor (tree type)
 }
 
 
-static tree
-set_descriptor_dimension (stmtblock_t *block, tree desc, int dim,
-			  tree lbound, tree ubound, tree stride, tree *offset)
+static void
+set_bounds_update_offset (stmtblock_t *block, tree desc, int dim,
+			  tree lbound, tree ubound, tree stride, tree lbound_diff,
+			  tree *offset, tree *next_stride, bool stride_unchanged)
 {
-  /* Set bounds in descriptor.  */
+  /* Stabilize values in case the expressions depend on the existing bounds.  */
   lbound = fold_convert (gfc_array_index_type, lbound);
   lbound = gfc_evaluate_now (lbound, block);
-  gfc_conv_descriptor_lbound_set (block, desc,
-				  gfc_rank_cst[dim], lbound);
 
   ubound = fold_convert (gfc_array_index_type, ubound);
   ubound = gfc_evaluate_now (ubound, block);
-  gfc_conv_descriptor_ubound_set (block, desc,
-				  gfc_rank_cst[dim], ubound);
 
-  /* Set stride.  */
   stride = fold_convert (gfc_array_index_type, stride);
   stride = gfc_evaluate_now (stride, block);
-  gfc_conv_descriptor_stride_set (block, desc,
-				  gfc_rank_cst[dim], stride);
+
+  lbound_diff = fold_convert (gfc_array_index_type, lbound_diff);
+  lbound_diff = gfc_evaluate_now (lbound_diff, block);
+
+  gfc_conv_descriptor_lbound_set (block, desc,
+				  gfc_rank_cst[dim], lbound);
+  gfc_conv_descriptor_ubound_set (block, desc,
+				  gfc_rank_cst[dim], ubound);
+  if (!stride_unchanged)
+    gfc_conv_descriptor_stride_set (block, desc,
+				    gfc_rank_cst[dim], stride);
 
   /* Update offset.  */
   tree tmp = fold_build2_loc (input_location, MULT_EXPR,
-			      gfc_array_index_type, lbound, stride);
-  *offset = fold_build2_loc (input_location, MINUS_EXPR,
-			  gfc_array_index_type, *offset, tmp);
+			      gfc_array_index_type, lbound_diff, stride);
+  tmp = fold_build2_loc (input_location, MINUS_EXPR,
+			 gfc_array_index_type, *offset, tmp);
+  *offset = gfc_evaluate_now (tmp, block);
+
+  if (!next_stride)
+    return;
 
-  /* Return stride for next dimension.  */
+  /* Set stride for next dimension.  */
   tmp = gfc_conv_array_extent_dim (lbound, ubound, NULL);
-  stride = fold_build2_loc (input_location, MULT_EXPR,
-			    gfc_array_index_type, stride, tmp);
-  return stride;
+  *next_stride = fold_build2_loc (input_location, MULT_EXPR,
+				  gfc_array_index_type, stride, tmp);
+}
+
+
+static void
+set_descriptor_dimension (stmtblock_t *block, tree desc, int dim,
+			  tree lbound, tree ubound, tree stride, tree *offset,
+			  tree *next_stride)
+{
+  set_bounds_update_offset (block, desc, dim, lbound, ubound, stride, lbound,
+			    offset, next_stride, false);
 }
 
 
@@ -1514,7 +1532,7 @@ set_descriptor_dimension (stmtblock_t *block, tree desc, int dim,
 
 static void
 conv_shift_descriptor_lbound (stmtblock_t* block, tree from_desc, tree to_desc, int dim,
-			      tree new_lbound, tree offset, bool zero_based)
+			      tree new_lbound, tree *offset, bool zero_based)
 {
   new_lbound = fold_convert (gfc_array_index_type, new_lbound);
   new_lbound = gfc_evaluate_now (new_lbound, block);
@@ -1538,18 +1556,9 @@ conv_shift_descriptor_lbound (stmtblock_t* block, tree from_desc, tree to_desc,
      updating the lbound, as they depend on the lbound expression!  */
   tree tmp1 = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
 			       ubound, diff);
-  gfc_conv_descriptor_ubound_set (block, to_desc, gfc_rank_cst[dim], tmp1);
-  /* Set lbound to the value we want.  */
-  gfc_conv_descriptor_lbound_set (block, to_desc, gfc_rank_cst[dim], new_lbound);
 
-  tree offs_diff = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
-				    diff, stride);
-  tree tmp2 = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
-			       offset, offs_diff);
-  gfc_add_modify (block, offset, tmp2);
-
-  if (from_desc != to_desc)
-    gfc_conv_descriptor_stride_set (block, to_desc, gfc_rank_cst[dim], stride);
+  set_bounds_update_offset (block, to_desc, dim, new_lbound, tmp1, stride, diff,
+			    offset, nullptr, from_desc == to_desc);
 }
 
 
@@ -1627,23 +1636,23 @@ conv_shift_descriptor (stmtblock_t *block, tree src, tree dest, int rank,
       gfc_conv_descriptor_data_set (block, dest, tmp);
     }
 
-  tree offset_var = gfc_create_var (gfc_array_index_type, "offset");
+  tree offset = gfc_create_var (gfc_array_index_type, "offset");
   tree init_offset;
   if (info.zero_based_src ())
     init_offset = gfc_index_zero_node;
   else
     init_offset = gfc_conv_descriptor_offset_get (src);
-  gfc_add_modify (block, offset_var, init_offset);
+  gfc_add_modify (block, offset, init_offset);
 
   /* Apply a shift of the lbound when supplied.  */
   for (int dim = 0; dim < rank; ++dim)
     {
       tree lower_bound = info.lower_bound (block, dim);
-      conv_shift_descriptor_lbound (block, src, dest, dim, lower_bound, offset_var,
+      conv_shift_descriptor_lbound (block, src, dest, dim, lower_bound, &offset,
 				    info.zero_based_src ());
     }
 
-  gfc_conv_descriptor_offset_set (block, dest, offset_var);
+  gfc_conv_descriptor_offset_set (block, dest, offset);
 }
 
 
@@ -1881,8 +1890,8 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree dest, tree src,
     }
   /* Set the bounds as declared for the LHS and calculate strides as
      well as another offset update accordingly.  */
-  tree stride = gfc_conv_descriptor_stride_get (src,
-					   gfc_rank_cst[0]);
+  tree stride = gfc_conv_descriptor_stride_get (src, gfc_rank_cst[0]);
+  int last_dim = dest_rank - 1;
   for (int dim = 0; dim < dest_rank; ++dim)
     {
       gfc_se lower_se;
@@ -1899,9 +1908,9 @@ gfc_conv_remap_descriptor (stmtblock_t *block, tree dest, tree src,
       gfc_add_block_to_block (block, &lower_se.pre);
       gfc_add_block_to_block (block, &upper_se.pre);
 
-      stride = set_descriptor_dimension (block, dest, dim, 
-					 lower_se.expr, upper_se.expr, stride,
-					 &offset);
+      set_descriptor_dimension (block, dest, dim, lower_se.expr, upper_se.expr,
+				stride, &offset,
+				dim < last_dim ? &stride : nullptr);
     }
   gfc_conv_descriptor_offset_set (block, dest, offset);
 }