https://gcc.gnu.org/g:92d5a141a3b7e72831d728353bb8f3caff8e8273
commit 92d5a141a3b7e72831d728353bb8f3caff8e8273 Author: Mikael Morin <[email protected]> Date: Sat Aug 9 17:29:22 2025 +0200 Introduction gfc_create_null_actual_descriptor Diff: --- gcc/fortran/trans-descriptor.cc | 33 +++++++++++++++++++++++++++++++++ gcc/fortran/trans-descriptor.h | 2 ++ gcc/fortran/trans-expr.cc | 21 +++++++-------------- 3 files changed, 42 insertions(+), 14 deletions(-) diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index aa490a165588..710a984dcad1 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -975,3 +975,36 @@ gfc_create_unallocated_library_result_descriptor (stmtblock_t *block, tree sourc } +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; +} diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h index 780a62d081e9..6bed357988af 100644 --- a/gcc/fortran/trans-descriptor.h +++ b/gcc/fortran/trans-descriptor.h @@ -80,6 +80,8 @@ void gfc_init_absent_descriptor (stmtblock_t *block, tree descr); void gfc_init_static_descriptor (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); void gfc_init_descriptor_variable (stmtblock_t *block, gfc_symbol *sym, tree descr); diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 678f5ddf5c55..0192e80c8851 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -6881,8 +6881,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 @@ -6934,26 +6934,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); } }
