https://gcc.gnu.org/g:04c3c1b5b2391e33c460d45d22cfa046121c0361
commit r17-1377-g04c3c1b5b2391e33c460d45d22cfa046121c0361 Author: Jerry DeLisle <[email protected]> Date: Fri Jun 5 09:22:55 2026 -0700 fortran: Refactor the commit for 60576 PR fortran/60576 gcc/fortran/ChangeLog: * trans-array.cc (gfc_resize_assumed_rank_dim_field): New function extracted from gfc_conv_array_parameter. (gfc_conv_array_parameter): Use the new function. Diff: --- gcc/fortran/trans-array.cc | 61 ++++++++++++++++++++++------------------------ 1 file changed, 29 insertions(+), 32 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 6c8167e1b15d..211ce36fe8f0 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -9231,6 +9231,34 @@ is_pointer (gfc_expr *e) return sym->attr.pointer || sym->attr.proc_pointer; } +/* Assumed-rank actual argument: the caller only allocates storage for dtype + rank dimensions. Copying GFC_MAX_DIMENSIONS dim entries would read past the + physical end of the descriptor. Copy the header fields explicitly and use a + runtime-sized memcpy for the dim[] entries. */ +void +gfc_resize_assumed_rank_dim_field (gfc_se *se, stmtblock_t *block, tree desc) +{ + tree rank, dim_field, dim_size, copy_size, dst_ptr, src_ptr; + + gfc_conv_descriptor_data_set (block, desc, + gfc_conv_descriptor_data_get (se->expr)); + gfc_conv_descriptor_offset_set (block, desc, + gfc_conv_descriptor_offset_get (se->expr)); + gfc_add_modify (block, gfc_conv_descriptor_dtype (desc), + gfc_conv_descriptor_dtype (se->expr)); + rank = fold_convert (size_type_node, gfc_conv_descriptor_rank (se->expr)); + dim_field = gfc_get_descriptor_dimension (se->expr); + dim_size = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (dim_field))); + copy_size = fold_build2_loc (input_location, MULT_EXPR, + size_type_node, rank, dim_size); + dst_ptr = gfc_build_addr_expr (pvoid_type_node, + gfc_get_descriptor_dimension (desc)); + src_ptr = gfc_build_addr_expr (pvoid_type_node, dim_field); + gfc_add_expr_to_block (block, build_call_expr_loc (input_location, + builtin_decl_explicit (BUILT_IN_MEMCPY), + 3, dst_ptr, src_ptr, copy_size)); +} + /* Convert an array for passing as an actual parameter. */ void @@ -9506,39 +9534,8 @@ gfc_conv_array_parameter (gfc_se *se, gfc_expr *expr, bool g77, se->expr = arr; } if (expr->rank == -1) - { - /* Assumed-rank actual argument: the caller only allocates storage - for dtype.rank dimensions. Copying GFC_MAX_DIMENSIONS dim - entries would read past the physical end of the descriptor. - Copy the header fields explicitly and use a runtime-sized - memcpy for the dim[] entries. PR fortran/60576. */ - tree rank, dim_field, dim_size, copy_size, dst_ptr, src_ptr; - - gfc_conv_descriptor_data_set (&block, tmp, - gfc_conv_descriptor_data_get (se->expr)); - gfc_conv_descriptor_offset_set (&block, tmp, - gfc_conv_descriptor_offset_get (se->expr)); - gfc_add_modify (&block, gfc_conv_descriptor_dtype (tmp), - gfc_conv_descriptor_dtype (se->expr)); - rank = fold_convert (size_type_node, - gfc_conv_descriptor_rank (se->expr)); - dim_field = gfc_get_descriptor_dimension (se->expr); - dim_size = TYPE_SIZE_UNIT (TREE_TYPE (TREE_TYPE (dim_field))); - copy_size = fold_build2_loc (input_location, MULT_EXPR, - size_type_node, rank, dim_size); - dst_ptr = gfc_build_addr_expr (pvoid_type_node, - gfc_get_descriptor_dimension (tmp)); - src_ptr = gfc_build_addr_expr (pvoid_type_node, dim_field); - gfc_add_expr_to_block (&block, - build_call_expr_loc (input_location, - builtin_decl_explicit (BUILT_IN_MEMCPY), - 3, dst_ptr, src_ptr, copy_size)); - } + gfc_resize_assumed_rank_dim_field (se, &block, tmp); else if (CLASS_DATA (fsym)->as->rank == -1) - /* Fixed-rank actual to class assumed-rank formal: the formal's - class descriptor has dim_t[GFC_MAX_DIMENSIONS]; use lhs_type=false - so the ARRAY_RANGE_REF is sized by TREE_TYPE(rhs_dim) = dim_t[rank], - copying only the physically present entries. PR fortran/60576. */ gfc_class_array_data_assign (&block, tmp, se->expr, false); else gfc_class_array_data_assign (&block, tmp, se->expr, true);
