[gcc(refs/users/mikael/heads/refactor_descriptor_v08)] Factorisation gfc_set_contiguous_descriptor

[Mikael Morin]

https://gcc.gnu.org/g:7a376d70aa3c7827597ba9003f6d9e0fb543f450

commit 7a376d70aa3c7827597ba9003f6d9e0fb543f450
Author: Mikael Morin <mikael@gcc.gnu.org>
Date:   Fri Jan 17 17:25:59 2025 +0100

    Factorisation gfc_set_contiguous_descriptor
    
    Factorisation set_contiguous_array

Diff:
---
 gcc/fortran/trans-array.cc      | 54 +++++++++++------------------------------
 gcc/fortran/trans-descriptor.cc | 18 ++++++++++++++
 gcc/fortran/trans-descriptor.h  |  1 +
 3 files changed, 33 insertions(+), 40 deletions(-)

diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index e5c8d7aca841..8d114492ba53 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9466,32 +9466,6 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
 	      ubound = build_int_cst (gfc_array_index_type, 1);
 	    }
 
-	  /* Treat strings like arrays.  Or the other way around, do not
-	   * generate an additional array layer for scalar components.  */
-	  if (attr->dimension || c->ts.type == BT_CHARACTER)
-	    {
-	      cdesc = gfc_get_array_type_bounds (tmp, 1, 0, &gfc_index_one_node,
-						 &ubound, 1,
-						 GFC_ARRAY_ALLOCATABLE, false);
-
-	      cdesc = gfc_create_var (cdesc, "cdesc");
-	      DECL_ARTIFICIAL (cdesc) = 1;
-
-	      gfc_conv_descriptor_dtype_set (&tmpblock, cdesc,
-					     gfc_get_dtype_rank_type (1, tmp));
-	      gfc_conv_descriptor_lbound_set (&tmpblock, cdesc,
-					      gfc_index_zero_node,
-					      gfc_index_one_node);
-	      gfc_conv_descriptor_stride_set (&tmpblock, cdesc,
-					      gfc_index_zero_node,
-					      gfc_index_one_node);
-	      gfc_conv_descriptor_ubound_set (&tmpblock, cdesc,
-					      gfc_index_zero_node, ubound);
-	    }
-	  else
-	    /* Prevent warning.  */
-	    cdesc = NULL_TREE;
-
 	  if (attr->dimension)
 	    {
 	      if (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp)))
@@ -9514,13 +9488,23 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
 	      gfc_add_block_to_block (&tmpblock, &se.pre);
 	    }
 
+	  /* Treat strings like arrays.  Or the other way around, do not
+	   * generate an additional array layer for scalar components.  */
 	  if (attr->dimension || c->ts.type == BT_CHARACTER)
-	    gfc_conv_descriptor_data_set (&tmpblock, cdesc, comp);
+	    {
+	      cdesc = gfc_get_array_type_bounds (tmp, 1, 0, &gfc_index_one_node,
+						 &ubound, 1,
+						 GFC_ARRAY_ALLOCATABLE, false);
+
+	      cdesc = gfc_create_var (cdesc, "cdesc");
+	      DECL_ARTIFICIAL (cdesc) = 1;
+
+	      gfc_set_contiguous_descriptor (&tmpblock, cdesc, ubound, comp);
+	    }
 	  else
 	    cdesc = comp;
 
 	  tree fndecl;
-
 	  fndecl = build_call_expr_loc (input_location,
 					gfor_fndecl_co_broadcast, 5,
 					gfc_build_addr_expr (pvoid_type_node,cdesc),
@@ -9668,21 +9652,11 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl, tree dest,
 	      cdesc = gfc_create_var (cdesc, "cdesc");
 	      DECL_ARTIFICIAL (cdesc) = 1;
 
-	      gfc_conv_descriptor_dtype_set (&dealloc_block, cdesc,
-					     gfc_get_dtype_rank_type (1, tmp));
-	      gfc_conv_descriptor_lbound_set (&dealloc_block, cdesc,
-					      gfc_index_zero_node,
-					      gfc_index_one_node);
-	      gfc_conv_descriptor_stride_set (&dealloc_block, cdesc,
-					      gfc_index_zero_node,
-					      gfc_index_one_node);
-	      gfc_conv_descriptor_ubound_set (&dealloc_block, cdesc,
-					      gfc_index_zero_node, ubound);
-
 	      if (attr->dimension)
 		comp = gfc_conv_descriptor_data_get (comp);
 
-	      gfc_conv_descriptor_data_set (&dealloc_block, cdesc, comp);
+	      gfc_set_contiguous_descriptor (&dealloc_block, cdesc, ubound,
+					     comp);
 
 	      /* Now call the deallocator.  */
 	      vtab = gfc_find_vtab (&c->ts);
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index ab2e33f87d83..761eb57e4ea2 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1658,3 +1658,21 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree src, gfc_expr *src_expr,
       gfc_conv_descriptor_token_set (block, dest, tmp);
     }
 }
+ 
+
+void
+gfc_set_contiguous_descriptor (stmtblock_t *block, tree desc, tree size,
+			       tree data_ptr)
+{
+  gfc_conv_descriptor_dtype_set (block, desc,
+				gfc_get_dtype_rank_type (1, TREE_TYPE (desc)));
+  gfc_conv_descriptor_lbound_set (block, desc,
+				  gfc_index_zero_node,
+				  gfc_index_one_node);
+  gfc_conv_descriptor_stride_set (block, desc,
+				  gfc_index_zero_node,
+				  gfc_index_one_node);
+  gfc_conv_descriptor_ubound_set (block, desc,
+				  gfc_index_zero_node, size);
+  gfc_conv_descriptor_data_set (block, desc, data_ptr);
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 098a079894dc..e945d8e884f0 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -129,5 +129,6 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree src, gfc_expr *src_expr,
 		    tree uppers[GFC_MAX_DIMENSIONS],
 		    bool unlimited_polymorphic, bool data_needed,
 		    bool subref);
+void gfc_set_contiguous_descriptor (stmtblock_t *, tree, tree, tree);
 
 #endif /* GFC_TRANS_DESCRIPTOR_H */