int
gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical)
{
gfc_actual_arglist *actual;
gfc_constructor *c;
int n;
gcc_assert (expr1->expr_type == EXPR_VARIABLE);
switch (expr2->expr_type)
{
case EXPR_OP:
n = gfc_check_dependency (expr1, expr2->value.op.op1, identical);
if (n)
return n;
if (expr2->value.op.op2)
return gfc_check_dependency (expr1, expr2->value.op.op2, identical);
return 0;
case EXPR_VARIABLE:
/* The interesting cases are when the symbols don't match. */
if (expr1->symtree->n.sym != expr2->symtree->n.sym)
{
gfc_typespec *ts1 = &expr1->symtree->n.sym->ts;
gfc_typespec *ts2 = &expr2->symtree->n.sym->ts;
/* Return 1 if expr1 and expr2 are equivalenced arrays. */
if (gfc_are_equivalenced_arrays (expr1, expr2))
return 1;
/* Symbols can only alias if they have the same type. */
if (ts1->type != BT_UNKNOWN && ts2->type != BT_UNKNOWN
&& ts1->type != BT_DERIVED && ts2->type != BT_DERIVED)
{
if (ts1->type != ts2->type || ts1->kind != ts2->kind)
return 0;
}
/* If either variable is a pointer, assume the worst. */
/* TODO: -fassume-no-pointer-aliasing */
if (gfc_is_data_pointer (expr1) || gfc_is_data_pointer (expr2))
{
if (check_data_pointer_types (expr1, expr2)
&& check_data_pointer_types (expr2, expr1))
return 0;
return 1;
}
else
{
gfc_symbol *sym1 = expr1->symtree->n.sym;
gfc_symbol *sym2 = expr2->symtree->n.sym;
if (sym1->attr.target && sym2->attr.target
&& ((sym1->attr.dummy && !sym1->attr.contiguous
&& (!sym1->attr.dimension
|| sym2->as->type == AS_ASSUMED_SHAPE))
|| (sym2->attr.dummy && !sym2->attr.contiguous
&& (!sym2->attr.dimension
|| sym2->as->type == AS_ASSUMED_SHAPE))))
return 1;
}
/* Otherwise distinct symbols have no dependencies. */
return 0;
}
if (identical)
return 1;
/* Identical and disjoint ranges return 0,
overlapping ranges return 1. */
if (expr1->ref && expr2->ref)
return gfc_dep_resolver (expr1->ref, expr2->ref, NULL);
return 1;
case EXPR_FUNCTION:
if (expr2->inline_noncopying_intrinsic)
identical = 1;
/* Remember possible differences between elemental and
transformational functions. All functions inside a FORALL
will be pure. */
for (actual = expr2->value.function.actual;
actual; actual = actual->next)
{
if (!actual->expr)
continue;
n = gfc_check_dependency (expr1, actual->expr, identical);
if (n)
return n;
}
return 0;
case EXPR_CONSTANT:
case EXPR_NULL:
return 0;
case EXPR_ARRAY:
/* Loop through the array constructor's elements. */
for (c = gfc_constructor_first (expr2->value.constructor);
c; c = gfc_constructor_next (c))
{
/* If this is an iterator, assume the worst. */
if (c->iterator)
return 1;
/* Avoid recursion in the common case. */
if (c->expr->expr_type == EXPR_CONSTANT)
continue;
if (gfc_check_dependency (expr1, c->expr, 1))
return 1;
}
return 0;
default:
return 1;
}
}
int
gfc_check_dependency (gfc_expr * expr1, gfc_expr * expr2, bool identical)
{
gfc_ref *ref;
int n;
gfc_actual_arglist *actual;
gcc_assert (expr1->expr_type == EXPR_VARIABLE);
switch (expr2->expr_type)
{
case EXPR_OP:
n = gfc_check_dependency (expr1, expr2->value.op.op1, identical);
if (n)
return n;
if (expr2->value.op.op2)
return gfc_check_dependency (expr1, expr2->value.op.op2, identical);
return 0;
case EXPR_VARIABLE:
/* The interesting cases are when the symbols don't match. */
if (expr1->symtree->n.sym != expr2->symtree->n.sym)
{
gfc_typespec *ts1 = &expr1->symtree->n.sym->ts;
gfc_typespec *ts2 = &expr2->symtree->n.sym->ts;
/* Return 1 if expr1 and expr2 are equivalenced arrays. */
if (gfc_are_equivalenced_arrays (expr1, expr2))
return 1;
/* Symbols can only alias if they have the same type. */
if (ts1->type != BT_UNKNOWN
&& ts2->type != BT_UNKNOWN
&& ts1->type != BT_DERIVED
&& ts2->type != BT_DERIVED)
{
if (ts1->type != ts2->type
|| ts1->kind != ts2->kind)
return 0;
}
/* If either variable is a pointer, assume the worst. */
/* TODO: -fassume-no-pointer-aliasing */
if (expr1->symtree->n.sym->attr.pointer)
return 1;
for (ref = expr1->ref; ref; ref = ref->next)
if (ref->type == REF_COMPONENT && ref->u.c.component->pointer)
return 1;
if (expr2->symtree->n.sym->attr.pointer)
return 1;
for (ref = expr2->ref; ref; ref = ref->next)
if (ref->type == REF_COMPONENT && ref->u.c.component->pointer)
return 1;
/* Otherwise distinct symbols have no dependencies. */
return 0;
}
if (identical)
return 1;
/* Identical and disjoint ranges return 0,
overlapping ranges return 1. */
/* Return zero if we refer to the same full arrays. */
if (expr1->ref->type == REF_ARRAY && expr2->ref->type == REF_ARRAY)
return gfc_dep_resolver (expr1->ref, expr2->ref);
return 1;
case EXPR_FUNCTION:
if (expr2->inline_noncopying_intrinsic)
identical = 1;
/* Remember possible differences between elemental and
transformational functions. All functions inside a FORALL
will be pure. */
for (actual = expr2->value.function.actual;
actual; actual = actual->next)
{
if (!actual->expr)
continue;
n = gfc_check_dependency (expr1, actual->expr, identical);
if (n)
return n;
}
return 0;
case EXPR_CONSTANT:
case EXPR_NULL:
return 0;
case EXPR_ARRAY:
/* Probably ok in the majority of (constant) cases. */
return 1;
default:
return 1;
}
}