https://gcc.gnu.org/g:bcafcf66fa743fc5353271f2db875ea9085396f6
commit bcafcf66fa743fc5353271f2db875ea9085396f6 Author: Mikael Morin <mik...@gcc.gnu.org> Date: Thu Aug 7 14:11:43 2025 +0200 Extraction gfc_set_descriptor_from_scalar Correction gfc_get_scalar_to_descriptor_type Diff: --- gcc/fortran/trans-descriptor.cc | 17 +++++++++++++++++ gcc/fortran/trans-descriptor.h | 2 ++ gcc/fortran/trans-expr.cc | 13 +------------ 3 files changed, 20 insertions(+), 12 deletions(-) diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index a73717f043e6..e8110f9f1974 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -933,3 +933,20 @@ gfc_create_null_actual_descriptor (stmtblock_t *block, gfc_typespec *ts, return desc; } + + +void +gfc_set_descriptor_from_scalar (stmtblock_t *block, tree descr, + tree scalar, gfc_expr *scalar_expr) +{ + tree type = gfc_get_scalar_to_descriptor_type (TREE_TYPE (scalar), + gfc_expr_attr (scalar_expr)); + gfc_conv_descriptor_dtype_set (block, descr, + gfc_get_dtype (type)); + + tree tmp = gfc_class_data_get (scalar); + if (!POINTER_TYPE_P (TREE_TYPE (tmp))) + tmp = gfc_build_addr_expr (NULL_TREE, tmp); + + gfc_conv_descriptor_data_set (block, descr, tmp); +} diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h index 4cbcc56f24b3..871d94687508 100644 --- a/gcc/fortran/trans-descriptor.h +++ b/gcc/fortran/trans-descriptor.h @@ -102,4 +102,6 @@ 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, gfc_expr *); + #endif /* GFC_TRANS_DESCRIPTOR_H */ diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index eeab771d2bba..5f2289d9c630 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -1311,18 +1311,7 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts, && e->rank != class_ts.u.derived->components->as->rank) { if (e->rank == 0) - { - tree type = gfc_get_scalar_to_descriptor_type (TREE_TYPE (parmse->expr), - gfc_expr_attr (e)); - gfc_conv_descriptor_dtype_set (&block, ctree, - gfc_get_dtype (type)); - - tmp = gfc_class_data_get (parmse->expr); - if (!POINTER_TYPE_P (TREE_TYPE (tmp))) - tmp = gfc_build_addr_expr (NULL_TREE, tmp); - - gfc_conv_descriptor_data_set (&block, ctree, tmp); - } + gfc_set_descriptor_from_scalar (&block, ctree, parmse->expr, e); else gfc_class_array_data_assign (&block, ctree, parmse->expr, false); }