https://gcc.gnu.org/g:a5061e3ce60d95da8babf9fc16e012a78f9d4af4
commit a5061e3ce60d95da8babf9fc16e012a78f9d4af4 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 dd1c431ff7f5..f9a4bdc892d8 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -826,3 +826,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 bd205c13b99c..f0d309729c5e 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 9fcd5268adb7..d533bec6a471 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); }