https://gcc.gnu.org/g:33186137f05f110b9c8b6f5e1b54bb4f16643b8d
commit 33186137f05f110b9c8b6f5e1b54bb4f16643b8d Author: Mikael Morin <[email protected]> Date: Thu Aug 20 11:43:34 2026 +0200 fortran: array descriptor: Simplify scalar dtype initialization [PR122521] TODO -- >8 -- The functions gfc_set_descriptor_from_scalar_class and gfc_set_descriptor_from_scalar both create a new scalar descriptor type that is only used as argument to gfc_get_dtype, to get the dtype initialization value. gfc_get_dtype extracts two pieces of information from that descriptor type: the rank, and the element type. As the rank is known to be zero, and the element type was part of the input to create the descriptor type, we can avoid the roundtrip through the descriptor type creation, and use directly the zero rank and the element type. This change does that. It permits the removal of one argument from both scalar descriptor initialization functions. With the call to the descriptor type creation function removed, the pointer unwrapping of the element type the function was doing is removed as well. Add it back to the code of both scalar descriptor initialization functions. PR fortran/122521 gcc/fortran/ChangeLog: * trans-descriptor.h (gfc_set_descriptor_from_scalar_class, gfc_set_descriptor_from_scalar): Remove expression argument. * trans-descriptor.cc (gfc_set_descriptor_from_scalar_class, gfc_set_descriptor_from_scalar): Ditto. Explicitly unwrap element type if it's pointer-typed. Use gfc_get_dtype_rank_type instead of gfc_get_dtype. Remove scalar descriptor type creation. * trans-expr.cc (gfc_conv_derived_to_class, gfc_conv_class_to_class): Update callers. Diff: --- gcc/fortran/trans-descriptor.cc | 23 +++++++++++++---------- gcc/fortran/trans-descriptor.h | 6 ++---- gcc/fortran/trans-expr.cc | 4 ++-- 3 files changed, 17 insertions(+), 16 deletions(-) diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index fc467c99d15b..6277ebd31135 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -857,13 +857,15 @@ gfc_create_null_actual_descriptor (stmtblock_t *block, gfc_typespec *ts, void gfc_set_descriptor_from_scalar (stmtblock_t *block, tree descr, - tree scalar, gfc_expr *scalar_expr, - tree cond_presence) + tree scalar, tree cond_presence) { - tree type = gfc_get_scalar_to_descriptor_type (TREE_TYPE (scalar), - gfc_expr_attr (scalar_expr)); + tree scalar_type = TREE_TYPE (scalar); + tree etype = POINTER_TYPE_P (scalar_type) + ? TREE_TYPE (scalar_type) + : scalar_type; gfc_conv_descriptor_dtype_set (block, descr, - gfc_get_dtype (type)); + gfc_get_dtype_rank_type (0, etype)); + gfc_copy_coarray_desc_part (block, descr, scalar); if (cond_presence) scalar = build3_loc (input_location, COND_EXPR, @@ -905,13 +907,14 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree descr, tree scalar) void gfc_set_descriptor_from_scalar_class (stmtblock_t *block, tree descr, - tree scalar, gfc_expr *scalar_expr) + tree scalar) { - tree type = gfc_get_scalar_to_descriptor_type (TREE_TYPE (scalar), - gfc_expr_attr (scalar_expr)); + tree scalar_type = TREE_TYPE (scalar); + tree etype = POINTER_TYPE_P (scalar_type) + ? TREE_TYPE (scalar_type) + : scalar_type; gfc_conv_descriptor_dtype_set (block, descr, - gfc_get_dtype (type)); - + gfc_get_dtype_rank_type (0, etype)); tree tmp = gfc_class_data_get (scalar); if (!POINTER_TYPE_P (TREE_TYPE (tmp))) tmp = gfc_build_addr_expr (NULL_TREE, tmp); diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h index 3f611b1d76af..8b342dd7c010 100644 --- a/gcc/fortran/trans-descriptor.h +++ b/gcc/fortran/trans-descriptor.h @@ -73,11 +73,9 @@ tree gfc_create_unallocated_library_result_descriptor (stmtblock_t *, tree, tree gfc_create_null_actual_descriptor (stmtblock_t *, gfc_typespec *, symbol_attribute, int); -void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, gfc_expr *, - tree); +void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree, tree); void gfc_set_descriptor_from_scalar (stmtblock_t *, tree, tree); -void gfc_set_descriptor_from_scalar_class (stmtblock_t *, tree, tree, - gfc_expr *); +void gfc_set_descriptor_from_scalar_class (stmtblock_t *, tree, tree); tree gfc_conv_descriptor_size (tree, int); tree gfc_conv_descriptor_cosize (tree, int, int); diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index a1b739da6344..25d81154f3fa 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -892,7 +892,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym, /* Scalar to an assumed-rank array. */ if (fsym->ts.u.derived->components->as) gfc_set_descriptor_from_scalar (&parmse->pre, ctree, - parmse->expr, e, cond_optional); + parmse->expr, cond_optional); else { tmp = fold_convert (TREE_TYPE (ctree), parmse->expr); @@ -1320,7 +1320,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) - gfc_set_descriptor_from_scalar_class (&block, ctree, parmse->expr, e); + gfc_set_descriptor_from_scalar_class (&block, ctree, parmse->expr); else gfc_class_array_data_assign (&block, ctree, parmse->expr, false); }
