https://gcc.gnu.org/g:a0bc4c739c644480fa162fe3f5557f2e9bb7b7ee
commit a0bc4c739c644480fa162fe3f5557f2e9bb7b7ee Author: Mikael Morin <[email protected]> Date: Thu Aug 20 20:36:40 2026 +0200 fortran: array descriptor: Factor scalar descriptor init 1/2 [PR122521] TODO: FAIL unlimited_polymorphic_{1,32}.f03, intent_out_19.f90, associate_66.f90 -- >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 | 41 +++++++++++++++++++++++++++-------------- 1 file changed, 27 insertions(+), 14 deletions(-) diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index 802d20f807b1..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,7 @@ 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)) || (POINTER_TYPE_P (TREE_TYPE (tmp)) @@ -969,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); }
