https://gcc.gnu.org/g:994478c4a6e87d6c978f0356f97951761bf70807
commit 994478c4a6e87d6c978f0356f97951761bf70807 Author: Mikael Morin <[email protected]> Date: Sat Oct 11 15:34:46 2025 +0200 Correction régression class_dummy_7.f90 Diff: --- gcc/fortran/trans-array.cc | 18 ++++++++++++------ gcc/fortran/trans-descriptor.cc | 4 +++- gcc/fortran/trans-expr.cc | 25 ++++++++++--------------- 3 files changed, 25 insertions(+), 22 deletions(-) diff --git a/gcc/fortran/trans-array.cc b/gcc/fortran/trans-array.cc index ea0bb0c7eddf..b72556613a0d 100644 --- a/gcc/fortran/trans-array.cc +++ b/gcc/fortran/trans-array.cc @@ -4357,13 +4357,16 @@ gfc_trans_preloop_setup (gfc_loopinfo * loop, int dim, int flag, { gcc_assert (0 == ploop->order[0]); - stride = gfc_conv_array_stride (info->descriptor, - innermost_ss (ss)->dim[0]); + if (!ss->is_alloc_lhs) + { + stride = gfc_conv_array_stride (info->descriptor, + innermost_ss (ss)->dim[0]); - /* Calculate the stride of the innermost loop. Hopefully this will - allow the backend optimizers to do their stuff more effectively. - */ - info->stride0 = gfc_evaluate_now (stride, pblock); + /* Calculate the stride of the innermost loop. Hopefully this will + allow the backend optimizers to do their stuff more effectively. + */ + info->stride0 = gfc_evaluate_now (stride, pblock); + } /* For the outermost loop calculate the offset due to any elemental dimensions. It will have been initialized with the @@ -10884,6 +10887,9 @@ gfc_update_reallocated_descriptor (stmtblock_t *block, gfc_loopinfo *loop) } #undef SAVE_VALUE + + info->stride0 = gfc_conv_array_stride (info->descriptor, + innermost_ss (s)->dim[0]); } } diff --git a/gcc/fortran/trans-descriptor.cc b/gcc/fortran/trans-descriptor.cc index a1c818862d9d..176ce86bb585 100644 --- a/gcc/fortran/trans-descriptor.cc +++ b/gcc/fortran/trans-descriptor.cc @@ -614,7 +614,9 @@ gfc_conv_descriptor_stride_get (tree desc, tree dim) || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_CONT || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_ALLOCATABLE || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_ASSUMED_RANK_POINTER_CONT - || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT)) + || GFC_TYPE_ARRAY_AKIND (type) == GFC_ARRAY_POINTER_CONT) + && !(TREE_CODE (desc) == COMPONENT_REF + && GFC_CLASS_TYPE_P (TREE_TYPE (TREE_OPERAND (desc, 0))))) return gfc_index_one_node; return non_lvalue_loc (input_location, get_descriptor_stride (desc, dim)); diff --git a/gcc/fortran/trans-expr.cc b/gcc/fortran/trans-expr.cc index 4520493b6f87..5009c7d81d70 100644 --- a/gcc/fortran/trans-expr.cc +++ b/gcc/fortran/trans-expr.cc @@ -6620,25 +6620,20 @@ contiguous_argument (gfc_actual_arglist *arg) if (!fsym) return true; + if (fsym->ts.type == BT_CLASS) + return false; + /* True if the dummy has the allocate or contiguous attribute. */ - if ((fsym->ts.type == BT_CLASS - && fsym->attr.class_ok - && (CLASS_DATA (fsym)->attr.allocatable - || CLASS_DATA (fsym)->attr.contiguous)) - || (fsym->ts.type != BT_CLASS - && (fsym->attr.allocatable - || fsym->attr.contiguous))) + if (fsym->ts.type != BT_CLASS + && (fsym->attr.allocatable + || fsym->attr.contiguous)) return true; /* False if the dummy is assumed-shape or assumed-rank. */ - if ((fsym->ts.type == BT_CLASS - && CLASS_DATA (fsym)->as - && (CLASS_DATA (fsym)->as->type == AS_ASSUMED_SHAPE - || CLASS_DATA (fsym)->as->type == AS_ASSUMED_RANK)) - || (fsym->ts.type != BT_CLASS - && fsym->as - && (fsym->as->type == AS_ASSUMED_SHAPE - || fsym->as->type == AS_ASSUMED_RANK))) + if (fsym->ts.type != BT_CLASS + && fsym->as + && (fsym->as->type == AS_ASSUMED_SHAPE + || fsym->as->type == AS_ASSUMED_RANK)) return false; /* By default, repacking is done. */
