https://gcc.gnu.org/g:beb47b799cd1945fc85c0c37269dd322585eb084
commit beb47b799cd1945fc85c0c37269dd322585eb084
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 | 16 ++++++++++++
gcc/fortran/trans-descriptor.h | 2 ++
3 files changed, 32 insertions(+), 40 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 954ca9a3ba76..68f84db1818f 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 57e64be2e697..a0e56be4a041 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1377,3 +1377,19 @@ gfc_set_descriptor (stmtblock_t *block, tree dest, tree
src, gfc_expr *src_expr,
}
+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 de3962b9632f..0ce9dc363ca7 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -113,5 +113,7 @@ void gfc_copy_descriptor (stmtblock_t *, tree, tree,
gfc_expr *, bool);
void gfc_set_descriptor (stmtblock_t *, tree, tree, gfc_expr *, int, int,
gfc_ss *, gfc_array_info *, tree [GFC_MAX_DIMENSIONS],
tree [GFC_MAX_DIMENSIONS], bool, bool, bool);
+void gfc_set_contiguous_descriptor (stmtblock_t *, tree, tree, tree);
+
#endif /* GFC_TRANS_DESCRIPTOR_H */
