[gcc(refs/users/mikael/heads/refactor_descriptor_v291.01)] Extraction gfc_conv_shift_subarray_descriptor

https://gcc.gnu.org/g:96a45aa102b29e6c12d91551da0851eda6529e14

commit 96a45aa102b29e6c12d91551da0851eda6529e14
Author: Mikael Morin <[email protected]>
Date:   Sun Jun 21 09:49:36 2026 +0200

    Extraction gfc_conv_shift_subarray_descriptor
    
    Correction alloc_comp_constructor_5
    
    Correction artefact suite conflit rebase

Diff:
---
 gcc/fortran/trans-descriptor.cc | 73 +++++++++++++++++++++++++++++++++++++
 gcc/fortran/trans-descriptor.h  |  1 +
 gcc/fortran/trans-expr.cc       | 81 +++--------------------------------------
 3 files changed, 80 insertions(+), 75 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 932161d6f3dc..ba2eb4952529 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1230,3 +1230,76 @@ gfc_conv_shift_descriptor (stmtblock_t *block, tree dest, tree src,
 
   gfc_conv_descriptor_offset_set (block, dest, offset);
 }
+
+
+void
+gfc_set_subarray_descriptor (stmtblock_t *block, tree descr, tree value,
+			     gfc_expr *value_expr, gfc_expr *conv_arg)
+{
+  if (value_expr->expr_type != EXPR_VARIABLE)
+    gfc_conv_descriptor_data_set (block, value,
+				  null_pointer_node);
+
+  /* Obtain the array spec of full array references.  */
+  gfc_array_spec *as;
+  if (conv_arg)
+    as = gfc_get_full_arrayspec_from_expr (conv_arg);
+  else
+    as = gfc_get_full_arrayspec_from_expr (value_expr);
+
+  /* Shift the lbound and ubound of temporaries to being unity,
+     rather than zero, based. Always calculate the offset.  */
+  gfc_conv_descriptor_offset_set (block, descr, gfc_index_zero_node);
+  tree offset = gfc_conv_descriptor_offset_get (descr);
+  tree tmp2 = gfc_create_var (gfc_array_index_type, NULL);
+
+  for (int n = 0; n < value_expr->rank; n++)
+    {
+      tree span;
+      tree lbound;
+
+      /* Obtain the correct lbound - ISO/IEC TR 15581:2001 page 9.
+	 TODO It looks as if gfc_conv_expr_descriptor should return
+	 the correct bounds and that the following should not be
+	 necessary.  This would simplify gfc_conv_intrinsic_bound
+	 as well.  */
+      if (as && as->lower[n])
+	{
+	  gfc_se lbse;
+	  gfc_init_se (&lbse, NULL);
+	  gfc_conv_expr (&lbse, as->lower[n]);
+	  gfc_add_block_to_block (block, &lbse.pre);
+	  lbound = gfc_evaluate_now (lbse.expr, block);
+	}
+      else if (as && conv_arg)
+	{
+	  tree tmp = gfc_get_symbol_decl (conv_arg->symtree->n.sym);
+	  lbound = gfc_conv_descriptor_lbound_get (tmp, gfc_rank_cst[n]);
+	}
+      else if (as)
+	lbound = gfc_conv_descriptor_lbound_get (descr, gfc_rank_cst[n]);
+      else
+	lbound = gfc_index_one_node;
+
+      lbound = fold_convert (gfc_array_index_type, lbound);
+
+      /* Shift the bounds and set the offset accordingly.  */
+      tree tmp = gfc_conv_descriptor_ubound_get (descr, gfc_rank_cst[n]);
+      span = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+		tmp, gfc_conv_descriptor_lbound_get (descr, gfc_rank_cst[n]));
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     span, lbound);
+      gfc_conv_descriptor_ubound_set (block, descr, gfc_rank_cst[n], tmp);
+      gfc_conv_descriptor_lbound_set (block, descr, gfc_rank_cst[n], lbound);
+
+      tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_lbound_get (descr,
+							     gfc_rank_cst[n]),
+			     gfc_conv_descriptor_stride_get (descr,
+							     gfc_rank_cst[n]));
+      gfc_add_modify (block, tmp2, tmp);
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     offset, tmp2);
+      gfc_conv_descriptor_offset_set (block, descr, tmp);
+    }
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index aa3da0090c87..a17113e89095 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -91,6 +91,7 @@ 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_conv_shift_descriptor (stmtblock_t *, tree, tree, int, tree);
+void gfc_set_subarray_descriptor (stmtblock_t *, tree, tree, gfc_expr *, gfc_expr *);
 
 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 6439e3f8050a..b81410394dc4 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -9645,12 +9645,7 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
 {
   gfc_se se;
   stmtblock_t block;
-  tree offset;
-  int n;
   tree tmp;
-  tree tmp2;
-  gfc_array_spec *as;
-  gfc_expr *arg = NULL;
 
   gfc_start_block (&block);
   gfc_init_se (&se, NULL);
@@ -9728,83 +9723,19 @@ gfc_trans_alloc_subarray_assign (tree dest, gfc_component * cm,
 						  se.expr, cm->as->rank, true);
 	  gfc_add_expr_to_block (&block, tmp);
 	}
-      gfc_conv_descriptor_data_set (&block, se.expr, null_pointer_node);
     }
 
   /* We need to know if the argument of a conversion function is a
      variable, so that the correct lower bound can be used.  */
+  gfc_expr *arg = nullptr;
   if (expr->expr_type == EXPR_FUNCTION
-	&& expr->value.function.isym
-	&& expr->value.function.isym->conversion
-	&& expr->value.function.actual->expr
-	&& expr->value.function.actual->expr->expr_type == EXPR_VARIABLE)
+      && expr->value.function.isym
+      && expr->value.function.isym->conversion
+      && expr->value.function.actual->expr
+      && expr->value.function.actual->expr->expr_type == EXPR_VARIABLE)
     arg = expr->value.function.actual->expr;
 
-  /* Obtain the array spec of full array references.  */
-  if (arg)
-    as = gfc_get_full_arrayspec_from_expr (arg);
-  else
-    as = gfc_get_full_arrayspec_from_expr (expr);
-
-  /* Shift the lbound and ubound of temporaries to being unity,
-     rather than zero, based. Always calculate the offset.  */
-  gfc_conv_descriptor_offset_set (&block, dest, gfc_index_zero_node);
-  offset = gfc_conv_descriptor_offset_get (dest);
-  tmp2 =gfc_create_var (gfc_array_index_type, NULL);
-
-  for (n = 0; n < expr->rank; n++)
-    {
-      tree span;
-      tree lbound;
-
-      /* Obtain the correct lbound - ISO/IEC TR 15581:2001 page 9.
-	 TODO It looks as if gfc_conv_expr_descriptor should return
-	 the correct bounds and that the following should not be
-	 necessary.  This would simplify gfc_conv_intrinsic_bound
-	 as well.  */
-      if (as && as->lower[n])
-	{
-	  gfc_se lbse;
-	  gfc_init_se (&lbse, NULL);
-	  gfc_conv_expr (&lbse, as->lower[n]);
-	  gfc_add_block_to_block (&block, &lbse.pre);
-	  lbound = gfc_evaluate_now (lbse.expr, &block);
-	}
-      else if (as && arg)
-	{
-	  tmp = gfc_get_symbol_decl (arg->symtree->n.sym);
-	  lbound = gfc_conv_descriptor_lbound_get (tmp,
-					gfc_rank_cst[n]);
-	}
-      else if (as)
-	lbound = gfc_conv_descriptor_lbound_get (dest,
-						gfc_rank_cst[n]);
-      else
-	lbound = gfc_index_one_node;
-
-      lbound = fold_convert (gfc_array_index_type, lbound);
-
-      /* Shift the bounds and set the offset accordingly.  */
-      tmp = gfc_conv_descriptor_ubound_get (dest, gfc_rank_cst[n]);
-      span = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
-		tmp, gfc_conv_descriptor_lbound_get (dest, gfc_rank_cst[n]));
-      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
-			     span, lbound);
-      gfc_conv_descriptor_ubound_set (&block, dest,
-				      gfc_rank_cst[n], tmp);
-      gfc_conv_descriptor_lbound_set (&block, dest,
-				      gfc_rank_cst[n], lbound);
-
-      tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
-			 gfc_conv_descriptor_lbound_get (dest,
-							 gfc_rank_cst[n]),
-			 gfc_conv_descriptor_stride_get (dest,
-							 gfc_rank_cst[n]));
-      gfc_add_modify (&block, tmp2, tmp);
-      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
-			     offset, tmp2);
-      gfc_conv_descriptor_offset_set (&block, dest, tmp);
-    }
+  gfc_set_subarray_descriptor (&block, dest, se.expr, expr, arg);
 
   if (arg)
     {