[PATCH 5/6] fortran: array descriptor: Move unallocated library result init [PR122521]

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