From: Mikael Morin <[email protected]>
Fortran-tested on aarch64-unknown-linux-gnu. OK for master?
-- >8 --
When the result of a non-inlined intrinsic function is used in a
reallocating assignment, a fresh unallocated array descriptor is created
for passing as function result to the library function. Move the code that
creates that fresh descriptor to its own function in trans-descriptor.cc.
PR fortran/122521
gcc/fortran/ChangeLog:
* trans-expr.cc (fcncall_realloc_result): Move descriptor
creation and initialization...
* trans-descriptor.cc
(gfc_create_unallocated_library_result_descriptor): ... here as a
new function.
* trans-descriptor.h
(gfc_create_unallocated_library_result_descriptor): New declaration.
---
gcc/fortran/trans-descriptor.cc | 31 +++++++++++++++++++++++++++++++
gcc/fortran/trans-descriptor.h | 2 ++
gcc/fortran/trans-expr.cc | 11 ++---------
3 files changed, 35 insertions(+), 9 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index aab7310265a..85a9471bcf1 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -774,6 +774,37 @@ gfc_init_descriptor_variable (stmtblock_t *block,
gfc_symbol *sym, tree descr)
}
+/* Create a fresh array descriptor copied from SOURCE_DESCR, with a cleared
data
+ pointer and a possibly different dtype value. Set the dtype field to DTYPE
+ if different from NULL_TREE; otherwise set it with a default value built
+ using SOURCE_DESCR's type. Add the copying code and any other
initialization
+ to BLOCK and return the descriptor declaration.
+
+ The descriptor created by this function is used to pass to intrinsic
+ functions from the library, when the result is assigned to a reallocatable
+ variable. The left hand side variable descriptor is not passed directly to
+ the library, and the unallocated descriptor this function creates is passed
+ instead. Allocation happens in the library; deallocation of the left hand
+ side variable data, if any, and correct bounds mapping happen outside the
+ library, after the function returns. */
+
+tree
+gfc_create_unallocated_library_result_descriptor (stmtblock_t *block,
+ tree source_descr, tree dtype)
+{
+ /* Unallocated, the descriptor does not have a dtype. */
+ if (dtype == NULL_TREE)
+ dtype = gfc_get_dtype (TREE_TYPE (source_descr));
+
+ gfc_conv_descriptor_dtype_set (block, source_descr, dtype);
+
+ tree res_desc = gfc_evaluate_now (source_descr, block);
+ gfc_conv_descriptor_data_set (block, res_desc, null_pointer_node);
+
+ return res_desc;
+}
+
+
/* For an array descriptor, get the total number of elements. This is just
the product of the extents along from_dim to to_dim. */
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index e9006a22971..80f5db72d84 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -68,6 +68,8 @@ void gfc_init_result_descriptor (stmtblock_t *block, tree
descr);
void gfc_init_absent_descriptor (stmtblock_t *block, tree descr);
void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym,
tree descr);
+tree gfc_create_unallocated_library_result_descriptor (stmtblock_t *, tree,
+ tree);
tree gfc_conv_descriptor_size (tree, int);
tree gfc_conv_descriptor_cosize (tree, int, int);
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 406189af157..59ce9c64ad8 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -12200,15 +12200,8 @@ fcncall_realloc_result (gfc_se *se, int rank, tree
dtype)
if (POINTER_TYPE_P (TREE_TYPE (desc)))
desc = build_fold_indirect_ref_loc (input_location, desc);
- /* Unallocated, the descriptor does not have a dtype. */
- if (dtype != NULL_TREE)
- gfc_conv_descriptor_dtype_set (&se->pre, desc, dtype);
- else
- gfc_conv_descriptor_dtype_set (&se->pre, desc,
- gfc_get_dtype (TREE_TYPE (desc)));
-
- res_desc = gfc_evaluate_now (desc, &se->pre);
- gfc_conv_descriptor_data_set (&se->pre, res_desc, null_pointer_node);
+ res_desc = gfc_create_unallocated_library_result_descriptor (&se->pre, desc,
+ dtype);
se->expr = gfc_build_addr_expr (NULL_TREE, res_desc);
/* Free the lhs after the function call and copy the result data to
--
2.53.0
