https://gcc.gnu.org/g:8d7da63c1209cbd6f9392d4b482d824459256896
commit 8d7da63c1209cbd6f9392d4b482d824459256896
Author: Mikael Morin <mik...@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 ec1517cf227e..81f33a235038 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9482,32 +9482,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)))
@@ -9530,13 +9504,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),
@@ -9684,21 +9668,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 49e02fe7f9e7..948e7c6fdf5b 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1379,3 +1379,21 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree
src, gfc_expr *src_expr,
gfc_conv_descriptor_offset_set (block, dest, offset);
}
+
+
+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 ecd45b7e697c..37540691c44a 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -117,5 +117,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 */
