https://gcc.gnu.org/g:22cfb070e12082813deddcc0b6e04af5bc7b5b3a
commit 22cfb070e12082813deddcc0b6e04af5bc7b5b3a Author: Mikael Morin <mik...@gcc.gnu.org> Date: Tue Jul 22 21:14:56 2025 +0200 Extraction gfc_set_descriptor_from_scalar Correction code en doublon Diff: --- gcc/fortran/trans-descriptor.cc | 17 +++++++++++++++++ gcc/fortran/trans-descriptor.h | 1 + gcc/fortran/trans-expr.cc | 14 +++----------- 3 files changed, 21 insertions(+), 11 deletions(-) diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index 8d07e8eb7043..f1aaba4350ac 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -863,3 +863,20 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree descr, null_pointer_node)); gfc_conv_descriptor_data_set (block, descr, scalar); } + + +void +gfc_set_descriptor_from_scalar (stmtblock_t *block, tree descr, tree scalar) +{ + tree etype = TREE_TYPE (scalar); + if (!POINTER_TYPE_P (TREE_TYPE (scalar))) + scalar = gfc_build_addr_expr (NULL_TREE, scalar); + else if (TREE_TYPE (etype) && TREE_CODE (TREE_TYPE (etype)) == ARRAY_TYPE) + etype = TREE_TYPE (etype); + + gfc_conv_descriptor_dtype_set (block, descr, + gfc_get_dtype_rank_type (0, etype)); + gfc_conv_descriptor_data_set (block, descr, scalar); + gfc_conv_descriptor_span_set (block, descr, + gfc_conv_descriptor_elem_len_get (descr)); +} diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h index 548f04ffc11d..5eecb142d0b6 100644 --- a/gcc/fortran/trans-descriptor.h +++ b/gcc/fortran/trans-descriptor.h @@ -102,6 +102,7 @@ tree gfc_create_null_actual_descriptor (stmtblock_t *, gfc_typespec *, void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree descr); +void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree); void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *); void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *, tree); diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 00dade8cfc34..295059ea8749 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -94,10 +94,9 @@ gfc_get_character_len_in_bytes (tree type) tree gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr) { - tree desc, type, etype; + tree desc, type; type = gfc_get_scalar_to_descriptor_type (TREE_TYPE (scalar), attr); - etype = TREE_TYPE (scalar); desc = gfc_create_var (type, "desc"); DECL_ARTIFICIAL (desc) = 1; @@ -108,15 +107,8 @@ gfc_conv_scalar_to_descriptor (gfc_se *se, tree scalar, symbol_attribute attr) gfc_add_modify (&se->pre, tmp, scalar); scalar = tmp; } - if (!POINTER_TYPE_P (TREE_TYPE (scalar))) - scalar = gfc_build_addr_expr (NULL_TREE, scalar); - else if (TREE_TYPE (etype) && TREE_CODE (TREE_TYPE (etype)) == ARRAY_TYPE) - etype = TREE_TYPE (etype); - gfc_conv_descriptor_dtype_set (&se->pre, desc, - gfc_get_dtype_rank_type (0, etype)); - gfc_conv_descriptor_data_set (&se->pre, desc, scalar); - gfc_conv_descriptor_span_set (&se->pre, desc, - gfc_conv_descriptor_elem_len_get (desc)); + + gfc_set_descriptor_from_scalar (&se->pre, desc, scalar); /* Copy pointer address back - but only if it could have changed and if the actual argument is a pointer and not, e.g., NULL(). */