https://gcc.gnu.org/g:e4e3b20dca4ad0b3a1c9e7f0470ad4a9d5380150
commit e4e3b20dca4ad0b3a1c9e7f0470ad4a9d5380150 Author: Mikael Morin <[email protected]> Date: Wed Jul 29 12:43:53 2026 +0200 fortran: array descriptor: Move scalar descriptor init 1/3 [PR122521] Fortran-tested on aarch64-unknown-linux-gnu. OK for mainline? -- >8 -- The function gfc_conv_class_to_class has some specific code to initialize an array descriptor when it represents a scalar value. Move that code to its own function in trans-descriptor.cc. PR fortran/122521 gcc/fortran/ChangeLog: * trans-expr.cc (gfc_conv_class_to_class): Move descriptor initialization... * trans-descriptor.cc (gfc_set_descriptor_from_scalar_class): ... here as a new function. * trans-descriptor.h (gfc_set_descriptor_from_scalar_class): New declaration. Diff: --- gcc/fortran/trans-descriptor.cc | 23 +++++++++++++++++++++++ gcc/fortran/trans-descriptor.h | 3 +++ gcc/fortran/trans-expr.cc | 14 +------------- 3 files changed, 27 insertions(+), 13 deletions(-) diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index 9c273bf10ea9..177469593b9d 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -844,6 +844,29 @@ gfc_create_null_actual_descriptor (stmtblock_t *block, gfc_typespec *ts, } +/* Add code to BLOCK initializing the zero-rank array descriptor DESCR, so that + it represents the same data as the class descriptor reference SCALAR + corresponding to the scalar polymorphic expression SCALAR_EXPR. This is used + to implement the argument association between the actual argument SCALAR_EXPR + and an assumed-rank dummy argument. */ + +void +gfc_set_descriptor_from_scalar_class (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); +} + + /* For an array descriptor, get the total number of elements. This is just the product of the extents along from_dim to to_dim. */ diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h index c7f3df02def6..314e99819b43 100644 --- a/gcc/fortran/trans-descriptor.h +++ b/gcc/fortran/trans-descriptor.h @@ -73,6 +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_class (stmtblock_t *, tree, tree, + gfc_expr *); + 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 b12500e48f4a..25036e6ca7d2 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -1373,19 +1373,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; - 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_class (&block, ctree, parmse->expr, e); else gfc_class_array_data_assign (&block, ctree, parmse->expr, false); }
