https://gcc.gnu.org/g:f5fa3301ef375aec591412971e167c75a498f9db
commit f5fa3301ef375aec591412971e167c75a498f9db
Author: Mikael Morin <mik...@gcc.gnu.org>
Date: Wed Sep 10 20:38:07 2025 +0200
Extraction gfc_create_unallocated_library_result_descriptor
Diff:
---
gcc/fortran/trans-descriptor.cc | 14 ++++++++++++++
gcc/fortran/trans-descriptor.h | 2 ++
gcc/fortran/trans-expr.cc | 10 ++--------
3 files changed, 18 insertions(+), 8 deletions(-)
diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc
index 556a749fad6c..994e9543adab 100644
--- a/gcc/fortran/trans-descriptor.cc
+++ b/gcc/fortran/trans-descriptor.cc
@@ -2959,3 +2959,17 @@ gfc_set_empty_descriptor_bounds (stmtblock_t *block,
tree descr, int rank)
gfc_conv_descriptor_offset_set (block, descr, gfc_index_zero_node);
}
+
+
+tree
+gfc_create_unallocated_library_result_descriptor (stmtblock_t *block, tree
source_descr, tree 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;
+}
diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h
index 52762c3c94a4..70dfab8b6f6d 100644
--- a/gcc/fortran/trans-descriptor.h
+++ b/gcc/fortran/trans-descriptor.h
@@ -144,5 +144,7 @@ gfc_descriptor_init_count (tree, int, int, gfc_expr **,
gfc_expr **,
tree, gfc_expr *, tree, bool, gfc_expr *, tree,
bool, tree *);
void gfc_set_empty_descriptor_bounds (stmtblock_t *, tree, int);
+tree gfc_create_unallocated_library_result_descriptor (stmtblock_t *, tree,
+ tree);
#endif /* GFC_TRANS_DESCRIPTOR_H */
diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc
index 96b8f62ad692..af73c6b6a15a 100644
--- a/gcc/fortran/trans-expr.cc
+++ b/gcc/fortran/trans-expr.cc
@@ -11352,14 +11352,8 @@ fcncall_realloc_result (gfc_se *se, int rank, tree
dtype)
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
