https://gcc.gnu.org/g:849d4d315ad423df5bda4bb6ac1cc0bfac2725ee
commit 849d4d315ad423df5bda4bb6ac1cc0bfac2725ee
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Mon Mar 17 17:30:18 2025 +0100
Extraction gfc_set_pdt_array_descriptor
Diff:
---
gcc/fortran/trans-array.cc | 60 +++++------------------------------------
gcc/fortran/trans-descriptor.cc | 56 ++++++++++++++++++++++++++++++++++++++
gcc/fortran/trans-descriptor.h | 3 +++
3 files changed, 65 insertions(+), 54 deletions(-)
diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc
index 1c62e691d210..646069a6d358 100644
--- a/gcc/fortran/trans-array.cc
+++ b/gcc/fortran/trans-array.cc
@@ -9718,56 +9718,8 @@ structure_alloc_comps (gfc_symbol * der_type, tree decl,
tree dest,
if (c->attr.pdt_array)
{
- gfc_se tse;
- int i;
- tree size = gfc_index_one_node;
- tree offset = gfc_index_zero_node;
- tree lower, upper;
- gfc_expr *e;
-
- /* This chunk takes the expressions for 'lower' and 'upper'
- in the arrayspec and substitutes in the expressions for
- the parameters from 'pdt_param_list'. The descriptor
- fields can then be filled from the values so obtained. */
- gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (comp)));
- for (i = 0; i < c->as->rank; i++)
- {
- gfc_init_se (&tse, NULL);
- e = gfc_copy_expr (c->as->lower[i]);
- gfc_insert_parameter_exprs (e, pdt_param_list);
- gfc_conv_expr_type (&tse, e, gfc_array_index_type);
- gfc_free_expr (e);
- lower = tse.expr;
- gfc_conv_descriptor_lbound_set (&fnblock, comp,
- gfc_rank_cst[i],
- lower);
- e = gfc_copy_expr (c->as->upper[i]);
- gfc_insert_parameter_exprs (e, pdt_param_list);
- gfc_conv_expr_type (&tse, e, gfc_array_index_type);
- gfc_free_expr (e);
- upper = tse.expr;
- gfc_conv_descriptor_ubound_set (&fnblock, comp,
- gfc_rank_cst[i],
- upper);
- gfc_conv_descriptor_stride_set (&fnblock, comp,
- gfc_rank_cst[i],
- size);
- size = gfc_evaluate_now (size, &fnblock);
- offset = fold_build2_loc (input_location,
- MINUS_EXPR,
- gfc_array_index_type,
- offset, size);
- offset = gfc_evaluate_now (offset, &fnblock);
- tmp = fold_build2_loc (input_location, MINUS_EXPR,
- gfc_array_index_type,
- upper, lower);
- tmp = fold_build2_loc (input_location, PLUS_EXPR,
- gfc_array_index_type,
- tmp, gfc_index_one_node);
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size, tmp);
- }
- gfc_conv_descriptor_offset_set (&fnblock, comp, offset);
+ tree nelts = gfc_set_pdt_array_descriptor (&fnblock, comp,
+ c->as, pdt_param_list);
if (c->ts.type == BT_CLASS)
{
tmp = gfc_get_vptr_from_expr (comp);
@@ -9778,17 +9730,17 @@ structure_alloc_comps (gfc_symbol * der_type, tree
decl, tree dest,
else
tmp = TYPE_SIZE_UNIT (gfc_get_element_type (ctype));
tmp = fold_convert (gfc_array_index_type, tmp);
- size = fold_build2_loc (input_location, MULT_EXPR,
- gfc_array_index_type, size, tmp);
+ tree size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, nelts, tmp);
size = gfc_evaluate_now (size, &fnblock);
tmp = gfc_call_malloc (&fnblock, NULL, size);
gfc_conv_descriptor_data_set (&fnblock, comp, tmp);
- gfc_conv_descriptor_dtype_set (&fnblock, comp, gfc_get_dtype
(ctype));
if (c->initializer && c->initializer->rank)
{
+ gfc_se tse;
gfc_init_se (&tse, NULL);
- e = gfc_copy_expr (c->initializer);
+ gfc_expr *e = gfc_copy_expr (c->initializer);
gfc_insert_parameter_exprs (e, pdt_param_list);
gfc_conv_expr_descriptor (&tse, e);
gfc_add_block_to_block (&fnblock, &tse.pre);
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index ff7c9986f68c..658a6fd7ac64 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -3800,3 +3800,59 @@ gfc_set_descriptor_for_assign_realloc (stmtblock_t
*block, gfc_loopinfo *loop,
}
+tree
+gfc_set_pdt_array_descriptor (stmtblock_t *block, tree desc,
+ gfc_array_spec *as,
+ gfc_actual_arglist *pdt_param_list)
+{
+ /* This chunk takes the expressions for 'lower' and 'upper'
+ in the arrayspec and substitutes in the expressions for
+ the parameters from 'pdt_param_list'. The descriptor
+ fields can then be filled from the values so obtained. */
+ gcc_assert (GFC_DESCRIPTOR_TYPE_P (TREE_TYPE (desc)));
+
+ tree size = gfc_index_one_node;
+ tree offset = gfc_index_zero_node;
+ for (int i = 0; i < as->rank; i++)
+ {
+ gfc_se tse;
+ gfc_init_se (&tse, NULL);
+ gfc_expr *e = gfc_copy_expr (as->lower[i]);
+ gfc_insert_parameter_exprs (e, pdt_param_list);
+ gfc_conv_expr_type (&tse, e, gfc_array_index_type);
+ gfc_free_expr (e);
+ tree lower = tse.expr;
+ gfc_conv_descriptor_lbound_set (block, desc,
+ gfc_rank_cst[i],
+ lower);
+ e = gfc_copy_expr (as->upper[i]);
+ gfc_insert_parameter_exprs (e, pdt_param_list);
+ gfc_conv_expr_type (&tse, e, gfc_array_index_type);
+ gfc_free_expr (e);
+ tree upper = tse.expr;
+ gfc_conv_descriptor_ubound_set (block, desc,
+ gfc_rank_cst[i],
+ upper);
+ gfc_conv_descriptor_stride_set (block, desc,
+ gfc_rank_cst[i],
+ size);
+ size = gfc_evaluate_now (size, block);
+ offset = fold_build2_loc (input_location,
+ MINUS_EXPR,
+ gfc_array_index_type,
+ offset, size);
+ offset = gfc_evaluate_now (offset, block);
+ tree tmp = fold_build2_loc (input_location, MINUS_EXPR,
+ gfc_array_index_type,
+ upper, lower);
+ tmp = fold_build2_loc (input_location, PLUS_EXPR,
+ gfc_array_index_type,
+ tmp, gfc_index_one_node);
+ size = fold_build2_loc (input_location, MULT_EXPR,
+ gfc_array_index_type, size, tmp);
+ }
+ gfc_conv_descriptor_offset_set (block, desc, offset);
+ gfc_conv_descriptor_dtype_set (block, desc,
+ gfc_get_dtype (TREE_TYPE (desc)));
+ return size;
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 353e33880c7a..01d19e5e2c64 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -116,4 +116,7 @@ void
gfc_set_descriptor_for_assign_realloc (stmtblock_t *, gfc_loopinfo *,
gfc_expr *, gfc_expr *, tree, tree,
tree, tree);
+tree
+gfc_set_pdt_array_descriptor (stmtblock_t *, tree, gfc_array_spec *,
+ gfc_actual_arglist *);
