git
/
gcc
mirror of git://gcc.gnu.org/git/gcc.git
1
0
Fork 0
Code Issues Packages Projects Releases Wiki Activity

Correction régression coarray_alloc_comp_7.f08

This commit is contained in:
Mikael Morin 2025-10-15 19:12:21 +02:00
parent d3aa492ac9
commit 14a9ed3a8c
1 changed files with 65 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

66
gcc/fortran/trans-intrinsic.cc
View File

@ -1264,6 +1264,70 @@ contiguous_coarray (gfc_expr *expr)
gcc_unreachable ();
}
static bool
contiguous_array (gfc_expr *expr)
{
gfc_ref *ref;
gcc_assert (expr && expr->expr_type == EXPR_VARIABLE);
bool contiguous = true;
if (expr->symtree->n.sym->ts.type == BT_CLASS
&& CLASS_DATA (expr->symtree->n.sym)->attr.dimension)
contiguous = false;
else if (expr->symtree->n.sym->attr.dimension)
{
gfc_symbol *sym = expr->symtree->n.sym;
if (sym->attr.pointer)
contiguous = false;
else if (sym->as
&& (sym->as->type == AS_ASSUMED_SHAPE
|| sym->as->type == AS_ASSUMED_RANK))
contiguous = false;
else if (!sym->assoc)
contiguous = true;
else if (sym->assoc->dangling)
contiguous = false;
else if (!sym->assoc->variable)
contiguous = true;
else
contiguous = contiguous_coarray (sym->assoc->target);
}
bool seen_array = false;
for (ref = expr->ref; ref; ref = ref->next)
{
if (ref->type == REF_ARRAY
&& ref->u.ar.type != AR_ELEMENT)
seen_array = true;
if (seen_array
&& (ref->type == REF_COMPONENT
|| ref->type == REF_SUBSTRING))
return false;
if (ref->type == REF_COMPONENT)
{
gfc_component *comp = ref->u.c.component;
if (comp->ts.type == BT_CLASS
&& CLASS_DATA (comp)->attr.dimension)
contiguous = false;
else if (comp->attr.codimension)
contiguous = !comp->attr.pointer;
}
}
return contiguous;
}
/* Get data from a remote coarray. */
static void
@ -1584,7 +1648,7 @@ conv_caf_send_to_remote (gfc_code *code)
{
rhs_se.force_tmp = rhs_expr->shape == NULL
|| !gfc_is_simply_contiguous (rhs_expr, false, false);
rhs_se.bytes_strided = 1;
rhs_se.bytes_strided = !contiguous_array (rhs_expr);
gfc_conv_expr_descriptor (&rhs_se, rhs_expr);
gfc_add_block_to_block (&block, &rhs_se.pre);
opt_rhs_desc = rhs_se.expr;