https://gcc.gnu.org/g:bee5a77a6b916dfa5ff522d58478f6ef2eedbe2c
commit bee5a77a6b916dfa5ff522d58478f6ef2eedbe2c
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Fri Jan 17 17:25:59 2025 +0100
Factorisation gfc_set_contiguous_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 40 ++++++++++++----------------------------
gcc/fortran/trans-descriptor.cc | 16 ++++++++++++++++
gcc/fortran/trans-descriptor.h | 2 ++
3 files changed, 30 insertions(+), 28 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index c76dd32fb95a..f071a5fc9220 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),
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index bf799fb3e467..91b71679dc9c 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -1343,3 +1343,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 884cd0d11a02..70238dd1001e 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -111,5 +111,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 */
