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

https://gcc.gnu.org/g:c87af3c793ff677ceb8d7bb06df20828c938cee6

commit c87af3c793ff677ceb8d7bb06df20828c938cee6
Author: Mikael Morin <[email protected]>
Date:   Wed Jul 22 22:06:34 2026 +0200

    Extraction gfc_set_gfc_from_cfi
    
    Correction artefact conflit rebase

Diff:
---
 gcc/fortran/trans-descriptor.cc | 98 +++++++++++++++++++++++++++++++++++++++++
 gcc/fortran/trans-descriptor.h  |  3 ++
 gcc/fortran/trans-expr.cc       | 91 +-------------------------------------
 3 files changed, 102 insertions(+), 90 deletions(-)

diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 6abaff7175f6..4bc2e1fb2419 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1980,3 +1980,101 @@ gfc_set_descriptor_with_shape (stmtblock_t *block, tree desc, tree ptr,
 				   gfc_array_index_type, offset));
   gfc_conv_descriptor_offset_set (block, desc, offset);
 }
+
+
+void
+gfc_set_gfc_from_cfi (stmtblock_t *block, tree gfc, gfc_expr *e, tree rank,
+		      tree gfc_strlen, tree cfi, gfc_symbol *fsym)
+{
+  stmtblock_t block2;
+  gfc_init_block (&block2);
+  if (e->rank == 0)
+    {
+      tree tmp = gfc_get_cfi_desc_base_addr (cfi);
+      gfc_add_modify (block, gfc, fold_convert (TREE_TYPE (gfc), tmp));
+    }
+  else
+    {
+      tree tmp = gfc_get_cfi_desc_base_addr (cfi);
+      gfc_conv_descriptor_data_set (block, gfc, tmp);
+
+      if (fsym->attr.allocatable)
+	{
+	  /* gfc->span = cfi->elem_len.  */
+	  tmp = fold_convert (gfc_array_index_type,
+			      gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]));
+	}
+      else
+	{
+	  /* gfc->span = ((cfi->dim[0].sm % cfi->elem_len)
+			  ? cfi->dim[0].sm : cfi->elem_len).  */
+	  tmp = gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]);
+	  tree tmp2 = fold_convert (gfc_array_index_type,
+				    gfc_get_cfi_desc_elem_len (cfi));
+	  tmp = fold_build2_loc (input_location, TRUNC_MOD_EXPR,
+				 gfc_array_index_type, tmp, tmp2);
+	  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			     tmp, gfc_index_zero_node);
+	  tmp = build3_loc (input_location, COND_EXPR, gfc_array_index_type, tmp,
+			    gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]), tmp2);
+	}
+      gfc_conv_descriptor_span_set (&block2, gfc, tmp);
+
+      /* Calculate offset + set lbound, ubound and stride.  */
+      gfc_conv_descriptor_offset_set (&block2, gfc, gfc_index_zero_node);
+      /* Loop: for (i = 0; i < rank; ++i).  */
+      tree idx = gfc_create_var (gfc_array_dim_rank_type, "idx");
+      /* Loop body.  */
+      stmtblock_t loop_body;
+      gfc_init_block (&loop_body);
+      /* gfc->dim[i].lbound = ... */
+      tmp = gfc_get_cfi_dim_lbound (cfi, idx);
+      gfc_conv_descriptor_lbound_set (&loop_body, gfc, idx, tmp);
+
+      /* gfc->dim[i].ubound = gfc->dim[i].lbound + cfi->dim[i].extent - 1. */
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_lbound_get (gfc, idx),
+			     gfc_index_one_node);
+      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
+			     gfc_get_cfi_dim_extent (cfi, idx), tmp);
+      gfc_conv_descriptor_ubound_set (&loop_body, gfc, idx, tmp);
+
+      /* gfc->dim[i].stride = cfi->dim[i].sm / cfi>elem_len */
+      tmp = gfc_get_cfi_dim_sm (cfi, idx);
+      tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+			     gfc_array_index_type, tmp,
+			     fold_convert (gfc_array_index_type,
+					   gfc_get_cfi_desc_elem_len (cfi)));
+      gfc_conv_descriptor_stride_set (&loop_body, gfc, idx, tmp);
+
+      /* gfc->offset -= gfc->dim[i].stride * gfc->dim[i].lbound. */
+      tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_stride_get (gfc, idx),
+			     gfc_conv_descriptor_lbound_get (gfc, idx));
+      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
+			     gfc_conv_descriptor_offset_get (gfc), tmp);
+      gfc_conv_descriptor_offset_set (&loop_body, gfc, tmp);
+      /* Generate loop.  */
+      gfc_simple_for_loop (&block2, idx, gfc_rank_cst[0], rank, LT_EXPR,
+			   gfc_rank_cst[1], gfc_finish_block (&loop_body));
+    }
+
+  if (e->ts.type == BT_CHARACTER && !e->ts.u.cl->length)
+    {
+      tree tmp = fold_convert (gfc_charlen_type_node,
+			       gfc_get_cfi_desc_elem_len (cfi));
+      if (e->ts.kind != 1)
+	tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
+			       gfc_charlen_type_node, tmp,
+			       build_int_cst (gfc_charlen_type_node,
+					      e->ts.kind));
+      gfc_add_modify (&block2, gfc_strlen, tmp);
+    }
+
+  tree tmp = gfc_get_cfi_desc_base_addr (cfi);
+  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
+			 tmp, null_pointer_node);
+  tmp = build3_v (COND_EXPR, tmp, gfc_finish_block (&block2),
+		  build_empty_stmt (input_location));
+  gfc_add_expr_to_block (block, tmp);
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 17f3a2c11bbc..c120fcd53f0d 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -121,4 +121,7 @@ void gfc_set_contiguous_descriptor (stmtblock_t *, tree, tree, tree);
 void gfc_set_descriptor_with_shape (stmtblock_t *, tree, tree,
 				    gfc_expr *, gfc_expr *, locus *);
 
+void gfc_set_gfc_from_cfi (stmtblock_t *, tree, gfc_expr *, tree, tree,
+			   tree, gfc_symbol *);
+
 #endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index e0bb1a124bb2..4fd4d36ec1bd 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -6396,96 +6396,7 @@ done:
       || fsym->attr.intent == INTENT_IN)
     goto post_call;
 
-  gfc_init_block (&block2);
-  if (e->rank == 0)
-    {
-      tmp = gfc_get_cfi_desc_base_addr (cfi);
-      gfc_add_modify (&block, gfc, fold_convert (TREE_TYPE (gfc), tmp));
-    }
-  else
-    {
-      tmp = gfc_get_cfi_desc_base_addr (cfi);
-      gfc_conv_descriptor_data_set (&block, gfc, tmp);
-
-      if (fsym->attr.allocatable)
-	{
-	  /* gfc->span = cfi->elem_len.  */
-	  tmp = fold_convert (gfc_array_index_type,
-			      gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]));
-	}
-      else
-	{
-	  /* gfc->span = ((cfi->dim[0].sm % cfi->elem_len)
-			  ? cfi->dim[0].sm : cfi->elem_len).  */
-	  tmp = gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]);
-	  tmp2 = fold_convert (gfc_array_index_type,
-			       gfc_get_cfi_desc_elem_len (cfi));
-	  tmp = fold_build2_loc (input_location, TRUNC_MOD_EXPR,
-				 gfc_array_index_type, tmp, tmp2);
-	  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
-			     tmp, gfc_index_zero_node);
-	  tmp = build3_loc (input_location, COND_EXPR, gfc_array_index_type, tmp,
-			    gfc_get_cfi_dim_sm (cfi, gfc_rank_cst[0]), tmp2);
-	}
-      gfc_conv_descriptor_span_set (&block2, gfc, tmp);
-
-      /* Calculate offset + set lbound, ubound and stride.  */
-      gfc_conv_descriptor_offset_set (&block2, gfc, gfc_index_zero_node);
-      /* Loop: for (i = 0; i < rank; ++i).  */
-      tree idx = gfc_create_var (gfc_array_dim_rank_type, "idx");
-      /* Loop body.  */
-      stmtblock_t loop_body;
-      gfc_init_block (&loop_body);
-      /* gfc->dim[i].lbound = ... */
-      tmp = gfc_get_cfi_dim_lbound (cfi, idx);
-      gfc_conv_descriptor_lbound_set (&loop_body, gfc, idx, tmp);
-
-      /* gfc->dim[i].ubound = gfc->dim[i].lbound + cfi->dim[i].extent - 1. */
-      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
-			     gfc_conv_descriptor_lbound_get (gfc, idx),
-			     gfc_index_one_node);
-      tmp = fold_build2_loc (input_location, PLUS_EXPR, gfc_array_index_type,
-			     gfc_get_cfi_dim_extent (cfi, idx), tmp);
-      gfc_conv_descriptor_ubound_set (&loop_body, gfc, idx, tmp);
-
-      /* gfc->dim[i].stride = cfi->dim[i].sm / cfi>elem_len */
-      tmp = gfc_get_cfi_dim_sm (cfi, idx);
-      tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
-			     gfc_array_index_type, tmp,
-			     fold_convert (gfc_array_index_type,
-					   gfc_get_cfi_desc_elem_len (cfi)));
-      gfc_conv_descriptor_stride_set (&loop_body, gfc, idx, tmp);
-
-      /* gfc->offset -= gfc->dim[i].stride * gfc->dim[i].lbound. */
-      tmp = fold_build2_loc (input_location, MULT_EXPR, gfc_array_index_type,
-			     gfc_conv_descriptor_stride_get (gfc, idx),
-			     gfc_conv_descriptor_lbound_get (gfc, idx));
-      tmp = fold_build2_loc (input_location, MINUS_EXPR, gfc_array_index_type,
-			     gfc_conv_descriptor_offset_get (gfc), tmp);
-      gfc_conv_descriptor_offset_set (&loop_body, gfc, tmp);
-      /* Generate loop.  */
-      gfc_simple_for_loop (&block2, idx, gfc_rank_cst[0], rank, LT_EXPR,
-			   gfc_rank_cst[1], gfc_finish_block (&loop_body));
-    }
-
-  if (e->ts.type == BT_CHARACTER && !e->ts.u.cl->length)
-    {
-      tmp = fold_convert (gfc_charlen_type_node,
-			  gfc_get_cfi_desc_elem_len (cfi));
-      if (e->ts.kind != 1)
-	tmp = fold_build2_loc (input_location, TRUNC_DIV_EXPR,
-			       gfc_charlen_type_node, tmp,
-			       build_int_cst (gfc_charlen_type_node,
-					      e->ts.kind));
-      gfc_add_modify (&block2, gfc_strlen, tmp);
-    }
-
-  tmp = gfc_get_cfi_desc_base_addr (cfi),
-  tmp = fold_build2_loc (input_location, NE_EXPR, boolean_type_node,
-			 tmp, null_pointer_node);
-  tmp = build3_v (COND_EXPR, tmp, gfc_finish_block (&block2),
-		  build_empty_stmt (input_location));
-  gfc_add_expr_to_block (&block, tmp);
+  gfc_set_gfc_from_cfi (&block, gfc, e, rank, gfc_strlen, cfi, fsym);
 
 post_call:
   gfc_add_block_to_block (&block, &se.post);