https://gcc.gnu.org/g:457a288791975fa9838a263ad541074c0104b72f
commit 457a288791975fa9838a263ad541074c0104b72f Author: Mikael Morin <[email protected]> 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 82bbc167a217..8701452627b1 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -2925,3 +2925,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 005d537841fe..2782993e22e6 100644 --- a/gcc/fortran/trans-descriptor.h +++ b/gcc/fortran/trans-descriptor.h @@ -132,5 +132,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 f4d5c6559d14..6401daa2baa3 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -11612,14 +11612,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
