https://gcc.gnu.org/g:66e95e5e1d3723eb8bf998df7246bdad57224274
commit 66e95e5e1d3723eb8bf998df7246bdad57224274 Author: Mikael Morin <[email protected]> Date: Sun Sep 28 19:01:09 2025 +0200 Correction régression dependency_60.f90 Diff: --- gcc/fortran/trans-descriptor.cc | 64 +++++++++++++++++++++++++++++++++++++++++ gcc/fortran/trans-descriptor.h | 4 +++ gcc/fortran/trans-expr.cc | 7 +---- gcc/fortran/trans-stmt.cc | 6 ++-- 4 files changed, 72 insertions(+), 9 deletions(-) diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index 57cfe7f575fb..1eb89fd729f2 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -600,6 +600,12 @@ gfc_conv_descriptor_stride_get (tree desc, tree dim) return non_lvalue_loc (input_location, get_descriptor_stride (desc, dim)); } +tree +gfc_conv_descriptor_stride_get (tree desc, int dim) +{ + return gfc_conv_descriptor_stride_get (desc, gfc_rank_cst[dim]); +} + tree gfc_conv_descriptor_stride_units_get (tree desc, tree dim) @@ -645,6 +651,12 @@ gfc_conv_descriptor_lbound_get (tree desc, tree dim) return non_lvalue_loc (input_location, get_descriptor_lbound (desc, dim)); } +tree +gfc_conv_descriptor_lbound_get (tree desc, int dim) +{ + return gfc_conv_descriptor_lbound_get (desc, gfc_rank_cst[dim]); +} + void gfc_conv_descriptor_lbound_set (stmtblock_t *block, tree desc, tree dim, tree value) @@ -664,6 +676,12 @@ gfc_conv_descriptor_ubound_get (tree desc, tree dim) return non_lvalue_loc (input_location, get_descriptor_ubound (desc, dim)); } +tree +gfc_conv_descriptor_ubound_get (tree desc, int dim) +{ + return gfc_conv_descriptor_ubound_get (desc, gfc_rank_cst[dim]); +} + void gfc_conv_descriptor_ubound_set (stmtblock_t *block, tree desc, tree dim, tree value) @@ -1807,6 +1825,52 @@ gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src, tree ptr, } +void +gfc_copy_descriptor (stmtblock_t *block, tree dest, tree src) +{ + if (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (dest)) + == GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (src))) + gfc_add_modify (block, dest, src); + else + { + gfc_conv_descriptor_data_set (block, dest, + gfc_conv_descriptor_data_get (src)); + gfc_conv_descriptor_dtype_set (block, dest, + gfc_conv_descriptor_dtype_get (src)); + gfc_conv_descriptor_bytes_counted_strides_set (block, dest); + gfc_conv_descriptor_span_set (block, dest, + gfc_conv_descriptor_span_get (src)); + + tree element_len = gfc_conv_descriptor_elem_len_get (src); + element_len = fold_convert_loc (input_location, gfc_array_index_type, + element_len); + + tree offset = gfc_index_zero_node; + + gcc_assert (GFC_TYPE_ARRAY_RANK (TREE_TYPE (dest)) + == GFC_TYPE_ARRAY_RANK (TREE_TYPE (src))); + int rank = GFC_TYPE_ARRAY_RANK (TREE_TYPE (dest)); + for (int i = 0; i < rank; i++) + { + tree lbound = gfc_conv_descriptor_lbound_get (src, i); + tree ubound = gfc_conv_descriptor_ubound_get (src, i); + tree stride_raw = gfc_conv_descriptor_stride_get (src, i); + gcc_assert (GFC_BYTES_STRIDES_ARRAY_TYPE_P (TREE_TYPE (dest))); + tree stride = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, stride_raw, + element_len); + set_dimension_fields (block, dest, gfc_rank_cst[i], + lbound, ubound, stride, &offset); + } + gfc_conv_descriptor_offset_set (block, dest, offset); + + if (flag_coarray == GFC_FCOARRAY_LIB) + gfc_conv_descriptor_token_set (block, dest, + gfc_conv_descriptor_token (src)); + } +} + + void gfc_conv_remap_descriptor (stmtblock_t *block, tree dest, int dest_rank, tree src, bool contiguous_src, gfc_array_ref *ar) diff --git a/gcc/fortran/trans-descriptor.h b/gcc/fortran/trans-descriptor.h index c6e13941f367..744c264a986b 100644 --- a/gcc/fortran/trans-descriptor.h +++ b/gcc/fortran/trans-descriptor.h @@ -57,10 +57,13 @@ tree gfc_conv_descriptor_span_get (tree desc); tree gfc_conv_descriptor_dimension_get (tree desc, tree dim); tree gfc_conv_descriptor_dimension_get (tree desc, int dim); tree gfc_conv_descriptor_stride_get (tree desc, tree dim); +tree gfc_conv_descriptor_stride_get (tree desc, int dim); tree gfc_conv_descriptor_stride_units_get (tree desc, tree dim); tree gfc_conv_descriptor_stride_bytes_get (tree desc, tree dim); tree gfc_conv_descriptor_lbound_get (tree desc, tree dim); +tree gfc_conv_descriptor_lbound_get (tree desc, int dim); tree gfc_conv_descriptor_ubound_get (tree desc, tree dim); +tree gfc_conv_descriptor_ubound_get (tree desc, int dim); tree gfc_conv_descriptor_sm_get (tree desc, tree dim); tree gfc_conv_descriptor_extent_get (tree desc, tree dim); @@ -106,6 +109,7 @@ void gfc_copy_descriptor (stmtblock_t *, tree, tree, gfc_expr *, bool); void gfc_copy_descriptor (stmtblock_t *, tree, tree, tree, int, gfc_ss *); void gfc_copy_descriptor (stmtblock_t *, tree, tree, bool); void gfc_copy_descriptor (stmtblock_t *, tree, tree, int); +void gfc_copy_descriptor (stmtblock_t *, tree, tree); void gfc_conv_remap_descriptor (stmtblock_t *, tree, int, tree, bool, gfc_array_ref *); diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index c062a64ba38a..7277d6034cb8 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -1264,12 +1264,7 @@ gfc_conv_class_to_class (gfc_se *parmse, gfc_expr *e, gfc_typespec class_ts, gfc_class_array_data_assign (&block, ctree, parmse->expr, false); } else - { - if (TREE_TYPE (parmse->expr) != TREE_TYPE (ctree)) - parmse->expr = fold_build1_loc (input_location, VIEW_CONVERT_EXPR, - TREE_TYPE (ctree), parmse->expr); - gfc_add_modify (&block, ctree, parmse->expr); - } + gfc_copy_descriptor (&block, ctree, parmse->expr); /* Return the data component, except in the case of scalarized array references, where nullification of the cannot occur and so there diff --git a/gcc/fortran/trans-stmt.cc b/gcc/fortran/trans-stmt.cc index e203be6ffb9f..a9b84d0c00e9 100644 --- a/gcc/fortran/trans-stmt.cc +++ b/gcc/fortran/trans-stmt.cc @@ -2189,11 +2189,11 @@ trans_associate_var (gfc_symbol *sym, gfc_wrapped_block *block) else tmp = se.expr; - gfc_add_modify (&se.pre, sym->backend_decl, - gfc_class_data_get (GFC_DECL_SAVED_DESCRIPTOR (tmp))); + gfc_copy_descriptor (&se.pre, sym->backend_decl, + gfc_class_data_get (GFC_DECL_SAVED_DESCRIPTOR (tmp))); } else - gfc_add_modify (&se.pre, sym->backend_decl, se.expr); + gfc_copy_descriptor (&se.pre, sym->backend_decl, se.expr); if (unlimited) {
