Correction régression class_dummy_7.f90

This commit is contained in:
Mikael Morin 2025-10-11 15:34:46 +02:00
parent 19d09086e6
commit 45b2938296
3 changed files with 25 additions and 22 deletions

View File

@ -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
@ -10855,6 +10858,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]);
}
}

View File

@ -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));

View File

@ -6615,25 +6615,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. */