mirror of git://gcc.gnu.org/git/gcc.git
Correction régression class_dummy_7.f90
This commit is contained in:
parent
19d09086e6
commit
45b2938296
|
@ -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]);
|
||||
}
|
||||
}
|
||||
|
||||
|
|
|
@ -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));
|
||||
|
|
|
@ -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. */
|
||||
|
|
Loading…
Reference in New Issue