https://gcc.gnu.org/g:1055ec09666a68a24ff8badcc85529b886549397
commit 1055ec09666a68a24ff8badcc85529b886549397 Author: Mikael Morin <[email protected]> Date: Sun Oct 5 17:12:01 2025 +0200 Correction régression class_70.f03 Diff: --- gcc/fortran/trans-array.cc | 52 +++++++++++++++++++++++++++++++++++++++++++++- gcc/fortran/trans-decl.cc | 42 ++++++++++++++++--------------------- 2 files changed, 69 insertions(+), 25 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index 3edb6eb9c897..3132b5070244 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -6643,7 +6643,57 @@ gfc_trans_array_bounds (tree type, gfc_symbol * sym, tree * poffset, offset = gfc_index_zero_node; stride = GFC_TYPE_ARRAY_STRIDE (type, 0); if (stride && VAR_P (stride)) - gfc_add_modify (pblock, stride, gfc_index_one_node); + { + if (GFC_BYTES_STRIDES_ARRAY_TYPE_P (type)) + { + tree span; + if (sym->ts.type == BT_CLASS) + { + tree class_descr = sym->backend_decl; + if (POINTER_TYPE_P (TREE_TYPE (class_descr))) + class_descr = build_fold_indirect_ref_loc (input_location, + class_descr); + tree class_type = TREE_TYPE (class_descr); + gcc_assert (GFC_CLASS_TYPE_P (class_type) + || GFC_CLASS_TYPE_P (TYPE_MAIN_VARIANT (class_type))); + tree array_descr = gfc_class_data_get (class_descr); + span = gfc_conv_descriptor_span_get (array_descr); + } + else if (sym->ts.type == BT_CHARACTER) + { + tree len = sym->ts.u.cl->backend_decl; + if (!len) + len = sym->ts.u.cl->passed_length; + if (!len && sym->ts.u.cl->length) + { + gfc_se se; + gfc_init_se (&se, nullptr); + gfc_conv_expr_val (&se, sym->ts.u.cl->length); + gfc_add_block_to_block (pblock, &se.pre); + len = se.expr; + } + span = fold_convert_loc (input_location, gfc_array_index_type, + len); + if (sym->ts.kind != 1) + { + tree kind = build_int_cst (gfc_array_index_type, + sym->ts.kind); + span = fold_build2_loc (input_location, MULT_EXPR, + gfc_array_index_type, + span, kind); + } + } + else + { + tree elt_type = gfc_get_element_type (type); + span = TYPE_SIZE_UNIT (elt_type); + } + span = fold_convert_loc (input_location, gfc_array_index_type, span); + gfc_add_modify (pblock, stride, span); + } + else + gfc_add_modify (pblock, stride, gfc_index_one_node); + } for (dim = 0; dim < as->rank; dim++) { /* Evaluate non-constant array bound expressions. diff --git a/gcc/fortran/trans-decl.cc b/gcc/fortran/trans-decl.cc index 46819df3f6c1..d768c3e32652 100644 --- a/gcc/fortran/trans-decl.cc +++ b/gcc/fortran/trans-decl.cc @@ -1318,41 +1318,35 @@ gfc_build_dummy_array_decl (gfc_symbol * sym, tree dummy) { bool bytes_strides_p = GFC_BYTES_STRIDES_ARRAY_TYPE_P (type); - /* Create a descriptorless array pointer. */ - packed = PACKED_NO; - - /* Even when -frepack-arrays is used, symbols with TARGET attribute - are not repacked. */ - if (!flag_repack_arrays || sym->attr.target) + if (as->type == AS_ASSUMED_SIZE) + packed = PACKED_FULL; + else if (as->type == AS_EXPLICIT) { - if (as->type == AS_ASSUMED_SIZE) - packed = PACKED_FULL; - } - else - { - if (as->type == AS_EXPLICIT) + packed = PACKED_FULL; + for (n = 0; n < as->rank; n++) { - packed = PACKED_FULL; - for (n = 0; n < as->rank; n++) + if (!(as->upper[n] + && as->lower[n] + && as->upper[n]->expr_type == EXPR_CONSTANT + && as->lower[n]->expr_type == EXPR_CONSTANT)) { - if (!(as->upper[n] - && as->lower[n] - && as->upper[n]->expr_type == EXPR_CONSTANT - && as->lower[n]->expr_type == EXPR_CONSTANT)) - { - packed = PACKED_PARTIAL; - break; - } + packed = PACKED_PARTIAL; + break; } } - else - packed = PACKED_PARTIAL; } + else if (flag_repack_arrays && !sym->attr.target) + /* Even when -frepack-arrays is used, symbols with TARGET attribute + are not repacked. */ + packed = PACKED_PARTIAL; + else + packed = PACKED_NO; /* For classarrays the element type is required, but gfc_typenode_for_spec () returns the array descriptor. */ type = is_classarray ? gfc_get_element_type (type) : gfc_typenode_for_spec (&sym->ts); + /* Create a descriptorless array pointer. */ type = gfc_get_nodesc_array_type (type, as, packed, !sym->attr.target); GFC_BYTES_STRIDES_ARRAY_TYPE_P (type) = bytes_strides_p;
