https://gcc.gnu.org/g:99d04dd616579638b4702f084242c26c9f915f8d
commit 99d04dd616579638b4702f084242c26c9f915f8d Author: Mikael Morin <[email protected]> Date: Thu Aug 20 20:36:40 2026 +0200 fortran: array descriptor: Factor scalar descriptor init 1/2 [PR122521] Fortran-tested on aarch64-unknown-linux-gnu. OK for mainline? -- >8 -- Factor to a common function the identical scalar descriptor initialization parts between gfc_set_descriptor_from_scalar_class and gfc_set_descriptor_from_scalar. The new function is mostly copied from gfc_set_descriptor_from_scalar, with an extra type argument from which the dtype initialization values are built. PR fortran/122521 gcc/fortran/ChangeLog: * trans-descriptor.cc (gfc_set_descriptor_from_scalar_class, gfc_set_descriptor_from_scalar): Factor common code... (set_descriptor_from_scalar): ... to this new function. Diff: --- gcc/fortran/trans-descriptor.cc | 40 ++++++++++++++++++++++++++-------------- 1 file changed, 26 insertions(+), 14 deletions(-) diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index 9980e9183f35..3f86be584428 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -847,6 +847,29 @@ gfc_create_null_actual_descriptor (stmtblock_t *block, gfc_typespec *ts, } +/* Add code to BLOCK initializing the zero-rank array descriptor DESCR. Guess + the dtype field initialization values using TYPE. If COND_PRESENCE is set, + make the value assigned to the data field either SCALAR or nullptr depending + on COND_PRESENCE; otherwise SCALAR unconditionally. */ + +static void +set_descriptor_from_scalar (stmtblock_t *block, tree descr, tree type, + tree scalar, tree cond_presence) +{ + gfc_conv_descriptor_dtype_set (block, descr, + gfc_get_dtype_rank_type (0, type)); + + gfc_copy_coarray_desc_part (block, descr, scalar); + if (cond_presence) + scalar = build3_loc (input_location, COND_EXPR, + TREE_TYPE (scalar), + cond_presence, scalar, + fold_convert (TREE_TYPE (scalar), + null_pointer_node)); + gfc_conv_descriptor_data_set (block, descr, scalar); +} + + /* Add code to BLOCK initializing the zero-rank array descriptor DESCR, so that it represents the same data as the pointer-typed middle-end expression SCALAR corresponding to the scalar front-end expression SCALAR_EXPR. If @@ -863,17 +886,7 @@ gfc_set_descriptor_from_scalar (stmtblock_t *block, tree descr, tree etype = POINTER_TYPE_P (scalar_type) ? TREE_TYPE (scalar_type) : scalar_type; - gfc_conv_descriptor_dtype_set (block, descr, - 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, - TREE_TYPE (scalar), - cond_presence, scalar, - fold_convert (TREE_TYPE (scalar), - null_pointer_node)); - gfc_conv_descriptor_data_set (block, descr, scalar); + set_descriptor_from_scalar (block, descr, etype, scalar, cond_presence); } @@ -959,8 +972,6 @@ gfc_set_descriptor_from_scalar_class (stmtblock_t *block, tree descr, tree class_ref; if (!is_polymorphic_ref (scalar, &class_ref)) gcc_unreachable (); - tree dtype_val = gfc_get_dtype_rank_type (0, TREE_TYPE (class_ref)); - gfc_conv_descriptor_dtype_set (block, descr, dtype_val); tree tmp = scalar; if (GFC_CLASS_TYPE_P (TREE_TYPE (tmp)) @@ -970,7 +981,8 @@ gfc_set_descriptor_from_scalar_class (stmtblock_t *block, tree descr, if (!POINTER_TYPE_P (TREE_TYPE (tmp))) tmp = gfc_build_addr_expr (NULL_TREE, tmp); - gfc_conv_descriptor_data_set (block, descr, tmp); + set_descriptor_from_scalar (block, descr, TREE_TYPE (class_ref), tmp, + NULL_TREE); }
