https://gcc.gnu.org/g:2c6cdbb24c9c58258bca8ffb3db0230df9a140e9
commit 2c6cdbb24c9c58258bca8ffb3db0230df9a140e9 Author: Mikael Morin <[email protected]> Date: Mon Aug 10 21:56:32 2026 +0200 fortran: array descriptor: Move coarray bounds copy [PR122521] Fortran-tested on aarch64-unknown-linux-gnu. OK for mainline? -- >8 -- In the next patch, a chunk of code using the function copy_coarray_desc_part will be moved to trans-descriptor.cc, requiring the function to be visible outside of trans-expr.cc. Make it public now and move it to trans-descriptor.cc. PR fortran/122521 gcc/fortran/ChangeLog: * trans-descriptor.h (gfc_copy_coarray_desc_part): New declaration. * trans-descriptor.cc (gfc_copy_coarray_desc_part): New function, moved from... * trans-expr.cc (copy_coarray_desc_part): ... here. (gfc_class_array_data_assign, gfc_conv_derived_to_class): Update function name in callers. Diff: --- gcc/fortran/trans-descriptor.cc | 40 ++++++++++++++++++++++++++++++++++++++++ gcc/fortran/trans-descriptor.h | 2 ++ gcc/fortran/trans-expr.cc | 36 ++---------------------------------- 3 files changed, 44 insertions(+), 34 deletions(-) diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index 177469593b9d..4f4335b5332e 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -951,6 +951,46 @@ gfc_conv_shift_descriptor_lbound (stmtblock_t* block, tree desc, } +/* Add code to BLOCK copying the cobounds from array descriptor SRC to array + descriptor DEST. The values are picked from SRC's type if they are + set there. Otherwise the runtime values are used with references to SRC's + fields. The type of DEST is not enriched with the cobounds; only + assignments setting DEST's fields at runtime are generated. If SRC is not a + coarray, no code is generated. */ + +void +gfc_copy_coarray_desc_part (stmtblock_t *block, tree dest, tree src) +{ + tree src_type = TREE_TYPE (src); + if (TYPE_LANG_SPECIFIC (src_type) && TYPE_LANG_SPECIFIC (src_type)->corank) + { + struct lang_type *lang_specific = TYPE_LANG_SPECIFIC (src_type); + for (int c = 0; c < lang_specific->corank; ++c) + { + int dim = lang_specific->rank + c; + tree codim = gfc_rank_cst[dim]; + + if (lang_specific->lbound[dim]) + gfc_conv_descriptor_lbound_set (block, dest, codim, + lang_specific->lbound[dim]); + else + gfc_conv_descriptor_lbound_set ( + block, dest, codim, gfc_conv_descriptor_lbound_get (src, codim)); + if (dim + 1 < lang_specific->corank) + { + if (lang_specific->ubound[dim]) + gfc_conv_descriptor_ubound_set (block, dest, codim, + lang_specific->ubound[dim]); + else + gfc_conv_descriptor_ubound_set ( + block, dest, codim, + gfc_conv_descriptor_ubound_get (src, codim)); + } + } + } +} + + void gfc_copy_descriptor (stmtblock_t *block, tree dst, tree src, int rank) { diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h index 314e99819b43..0c13266b7711 100644 --- a/gcc/fortran/trans-descriptor.h +++ b/gcc/fortran/trans-descriptor.h @@ -82,6 +82,8 @@ tree gfc_conv_descriptor_cosize (tree, int, int); /* Shift lower bound of descriptor, updating ubound and offset. */ void gfc_conv_shift_descriptor_lbound (stmtblock_t*, tree, int, tree); +void gfc_copy_coarray_desc_part (stmtblock_t *, tree, tree); + void gfc_copy_descriptor (stmtblock_t *, tree, tree, int); void gfc_grow_array (stmtblock_t *, tree, tree); diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 25036e6ca7d2..172d5fa5b5ff 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -761,38 +761,6 @@ gfc_get_vptr_from_expr (tree expr) return NULL_TREE; } -static void -copy_coarray_desc_part (stmtblock_t *block, tree dest, tree src) -{ - tree src_type = TREE_TYPE (src); - if (TYPE_LANG_SPECIFIC (src_type) && TYPE_LANG_SPECIFIC (src_type)->corank) - { - struct lang_type *lang_specific = TYPE_LANG_SPECIFIC (src_type); - for (int c = 0; c < lang_specific->corank; ++c) - { - int dim = lang_specific->rank + c; - tree codim = gfc_rank_cst[dim]; - - if (lang_specific->lbound[dim]) - gfc_conv_descriptor_lbound_set (block, dest, codim, - lang_specific->lbound[dim]); - else - gfc_conv_descriptor_lbound_set ( - block, dest, codim, gfc_conv_descriptor_lbound_get (src, codim)); - if (dim + 1 < lang_specific->corank) - { - if (lang_specific->ubound[dim]) - gfc_conv_descriptor_ubound_set (block, dest, codim, - lang_specific->ubound[dim]); - else - gfc_conv_descriptor_ubound_set ( - block, dest, codim, - gfc_conv_descriptor_ubound_get (src, codim)); - } - } - } -} - void gfc_class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc, bool lhs_type) @@ -821,7 +789,7 @@ gfc_class_array_data_assign (stmtblock_t *block, tree lhs_desc, tree rhs_desc, gfc_add_modify (block, lhs_dim, rhs_dim); /* The corank dimensions are not copied by the ARRAY_RANGE_REF. */ - copy_coarray_desc_part (block, lhs_desc, rhs_desc); + gfc_copy_coarray_desc_part (block, lhs_desc, rhs_desc); } /* Takes a derived type expression and returns the address of a temporary @@ -937,7 +905,7 @@ gfc_conv_derived_to_class (gfc_se *parmse, gfc_expr *e, gfc_symbol *fsym, gfc_expr_attr (e)); gfc_conv_descriptor_dtype_set (&parmse->pre, ctree, gfc_get_dtype (type)); - copy_coarray_desc_part (&parmse->pre, ctree, parmse->expr); + gfc_copy_coarray_desc_part (&parmse->pre, ctree, parmse->expr); if (optional) parmse->expr = build3_loc (input_location, COND_EXPR, TREE_TYPE (parmse->expr),
