[gcc(refs/users/mikael/heads/refactor_descriptor_v291.01)] Factorisation gfc_set_contiguous_descriptor

https://gcc.gnu.org/g:39f6cf4f48e148596f1816fbf6e89c0bd76cfd67

commit 39f6cf4f48e148596f1816fbf6e89c0bd76cfd67
Author: Mikael Morin <[email protected]>
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 798abaaf440a..6b2f73d47731 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9891,32 +9891,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)))
@@ -9939,13 +9913,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),
@@ -10093,21 +10077,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 6326ce3adda8..8771c6d34cb9 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1845,3 +1845,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 7fb6d85ba9bb..bfb3ca372645 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -116,5 +116,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 */