https://gcc.gnu.org/g:f57c8d156448c6fe6c5ee22f983ca3667f4f3be8
commit f57c8d156448c6fe6c5ee22f983ca3667f4f3be8 Author: Mikael Morin <[email protected]> Date: Sun Aug 2 11:05:05 2026 +0200 fortran: array descriptor: Move null actual creation [PR122521] Fortran-tested on aarch64-unknown-linux-gnu. OK for mainline? -- >8 -- The creation of a descriptor corresponding to a null() actual argument is repeated three times in conv_null_actual to handle three different cases. Factor that code to a common function in to trans-descriptor.cc. The factored code consisted of calling the scalar descriptor generator, and then generating a modification of the descriptor rank. This was producing correct initialization code for the descriptor, but with a wrong type and an incorrect zero GFC_TYPE_ARRAY_RANK attached to it. So this change additionnally inlines the scalar descriptor generation, replacing the hardcoded zero rank with the true rank passed as argument, so that the variable has the right type and is directly generated with the correct rank. With this, the descriptor is bigger because of a non-empty array of useless (and uninitialized) dimensions, but it's the type that is expected from within the procedure. More, the scalar descriptor generation, as an argument passing implementation detail, was generating code copying back to the original variable on return. This is not applicable to null() actual arguments and this change removes it from the inlined code. That part actually used to cause a gimplification failure for copy back code that looked like this: &C.5048 = (void * *) desc.14.data; Harald provided a workaround for this with his r15-6408-gd637e6d069ade7 [1] null() work, that changed the intent attribute of an argument in one of the three places modified here. This change, having removed the offending code, removes the workaround as well. [1]: https://gcc.gnu.org/pipermail/gcc-patches/2024-December/671673.html PR fortran/122521 gcc/fortran/ChangeLog: * trans-expr.cc (conv_null_actual): Remove dummy symbol intent attribute modification. Move the three times repeated descriptor initialization... * trans-descriptor.cc (gfc_create_null_actual_descriptor): ... here as a new function and inline the call to gfc_conv_scalar_to_descriptor. Remove the inapplicable or redundant parts from the inlined code. Create lower and upper bounds arrays and clear them before passing to the type creation function. * trans-descriptor.h (gfc_create_null_actual_descriptor): New declaration. Diff: --- gcc/fortran/trans-descriptor.cc | 39 +++++++++++++++++++++++++++++++++++++++ gcc/fortran/trans-descriptor.h | 2 ++ gcc/fortran/trans-expr.cc | 21 +++++++-------------- 3 files changed, 48 insertions(+), 14 deletions(-) diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index 85a9471bcf1d..9c273bf10ea9 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -805,6 +805,45 @@ gfc_create_unallocated_library_result_descriptor (stmtblock_t *block, } +/* Create a new descriptor to represent a null actual argument of type TS and + rank RANK passed to a dummy argument having attributes ATTR. Add + initialization code to BLOCK and return the descriptor declaration. */ + +tree +gfc_create_null_actual_descriptor (stmtblock_t *block, gfc_typespec *ts, + symbol_attribute attr, int rank) +{ + tree etype = gfc_typenode_for_spec (ts); + + enum gfc_array_kind akind; + + if (attr.pointer) + akind = GFC_ARRAY_POINTER_CONT; + else if (attr.allocatable) + akind = GFC_ARRAY_ALLOCATABLE; + else + akind = GFC_ARRAY_ASSUMED_SHAPE_CONT; + + tree lower[GFC_MAX_DIMENSIONS]; + tree upper[GFC_MAX_DIMENSIONS]; + memset (&lower, 0, rank * sizeof (lower[0])); + memset (&upper, 0, rank * sizeof (upper[0])); + + tree type = gfc_get_array_type_bounds (etype, rank, 0, lower, upper, 1, + akind, !(attr.pointer || attr.target)); + tree desc = gfc_create_var (type, "desc"); + DECL_ARTIFICIAL (desc) = 1; + + gfc_conv_descriptor_dtype_set (block, desc, + gfc_get_dtype_rank_type (rank, etype)); + gfc_conv_descriptor_data_set (block, desc, null_pointer_node); + gfc_conv_descriptor_span_set (block, desc, + gfc_conv_descriptor_elem_len_get (desc)); + + return desc; +} + + /* 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 80f5db72d842..c7f3df02def6 100644 --- a/gcc/fortran/trans-descriptor.h +++ b/gcc/fortran/trans-descriptor.h @@ -70,6 +70,8 @@ void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree descr); tree gfc_create_unallocated_library_result_descriptor (stmtblock_t *, tree, tree); +tree gfc_create_null_actual_descriptor (stmtblock_t *, gfc_typespec *, + symbol_attribute, int); 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 59ce9c64ad89..5e13d5950959 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -6874,8 +6874,8 @@ conv_null_actual (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym) if (fsym->as && fsym->as->type == AS_ASSUMED_RANK) { tree tmp = parmse->expr; - tmp = gfc_conv_scalar_to_descriptor (parmse, tmp, fsym->attr); - gfc_conv_descriptor_rank_set (&parmse->pre, tmp, e->rank); + tmp = gfc_create_null_actual_descriptor (&parmse->pre, &e->ts, + fsym->attr, e->rank); parmse->expr = gfc_build_addr_expr (NULL_TREE, tmp); } else @@ -6927,26 +6927,19 @@ conv_null_actual (gfc_se * parmse, gfc_expr * e, gfc_symbol * fsym) { tree tmp = parmse->expr; - tmp = gfc_conv_scalar_to_descriptor (parmse, tmp, gfc_expr_attr (e)); - gfc_conv_descriptor_rank_set (&parmse->pre, tmp, e->rank); - gfc_conv_descriptor_data_set (&parmse->pre, tmp, null_pointer_node); + tmp = gfc_create_null_actual_descriptor (&parmse->pre, &e->ts, + fsym->attr, e->rank); parmse->expr = gfc_build_addr_expr (NULL_TREE, tmp); } else /* MOLD is not present. Use attributes from dummy argument, which is not allowed to be assumed-rank. */ { - int dummy_rank; tree tmp = parmse->expr; - if ((fsym->attr.allocatable || fsym->attr.pointer) - && fsym->attr.intent == INTENT_UNKNOWN) - fsym->attr.intent = INTENT_IN; - tmp = gfc_conv_scalar_to_descriptor (parmse, tmp, fsym->attr); - dummy_rank = fsym->as ? fsym->as->rank : 0; - if (dummy_rank > 0) - gfc_conv_descriptor_rank_set (&parmse->pre, tmp, dummy_rank); - gfc_conv_descriptor_data_set (&parmse->pre, tmp, null_pointer_node); + int dummy_rank = fsym->as ? fsym->as->rank : 0; + tmp = gfc_create_null_actual_descriptor (&parmse->pre, &fsym->ts, + fsym->attr, dummy_rank); parmse->expr = gfc_build_addr_expr (NULL_TREE, tmp); } }
