https://gcc.gnu.org/g:4a644e3a0ffd7a40badb7f5a61cc7f934b4f9a8c
commit 4a644e3a0ffd7a40badb7f5a61cc7f934b4f9a8c 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 0ad9fa12d0d8..0970334b811b 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -842,3 +842,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 0b07c60de1e8..06c429165bc0 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 0866d506936a..dda2c10cbe2f 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(). */