/* In case of elemental subroutines, there is no dependency
between two same-range array references. */
if (gfc_ref_needs_temporary_p (expr->ref)
- || gfc_check_dependency (var, expr, !elemental))
+ || gfc_check_dependency (var, expr, elemental == NOT_ELEMENTAL))
{
if (elemental == ELEM_DONT_CHECK_VARIABLE)
{
}
+/* Return true if there is no possibility of aliasing because of a type
+ mismatch between all the possible pointer references and the
+ potential target. Note that this function is asymmetric in the
+ arguments and so must be called twice with the arguments exchanged. */
+
+static bool
+check_data_pointer_types (gfc_expr *expr1, gfc_expr *expr2)
+{
+ gfc_component *cm1;
+ gfc_symbol *sym1;
+ gfc_symbol *sym2;
+ gfc_ref *ref1;
+ bool seen_component_ref;
+
+ if (expr1->expr_type != EXPR_VARIABLE
+ || expr1->expr_type != EXPR_VARIABLE)
+ return false;
+
+ sym1 = expr1->symtree->n.sym;
+ sym2 = expr2->symtree->n.sym;
+
+ /* Keep it simple for now. */
+ if (sym1->ts.type == BT_DERIVED && sym2->ts.type == BT_DERIVED)
+ return false;
+
+ if (sym1->attr.pointer)
+ {
+ if (gfc_compare_types (&sym1->ts, &sym2->ts))
+ return false;
+ }
+
+ /* This is a conservative check on the components of the derived type
+ if no component references have been seen. Since we will not dig
+ into the components of derived type components, we play it safe by
+ returning false. First we check the reference chain and then, if
+ no component references have been seen, the components. */
+ seen_component_ref = false;
+ if (sym1->ts.type == BT_DERIVED)
+ {
+ for (ref1 = expr1->ref; ref1; ref1 = ref1->next)
+ {
+ if (ref1->type != REF_COMPONENT)
+ continue;
+
+ if (ref1->u.c.component->ts.type == BT_DERIVED)
+ return false;
+
+ if ((sym2->attr.pointer || ref1->u.c.component->attr.pointer)
+ && gfc_compare_types (&ref1->u.c.component->ts, &sym2->ts))
+ return false;
+
+ seen_component_ref = true;
+ }
+ }
+
+ if (sym1->ts.type == BT_DERIVED && !seen_component_ref)
+ {
+ for (cm1 = sym1->ts.u.derived->components; cm1; cm1 = cm1->next)
+ {
+ if (cm1->ts.type == BT_DERIVED)
+ return false;
+
+ if ((sym2->attr.pointer || cm1->attr.pointer)
+ && gfc_compare_types (&cm1->ts, &sym2->ts))
+ return false;
+ }
+ }
+
+ return true;
+}
+
+
/* Return true if the statement body redefines the condition. Returns
true if expr2 depends on expr1. expr1 should be a single term
suitable for the lhs of an assignment. The IDENTICAL flag indicates
/* 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))
- return 1;
+ {
+ if (check_data_pointer_types (expr1, expr2)
+ && check_data_pointer_types (expr2, expr1))
+ return 0;
+
+ return 1;
+ }
/* Otherwise distinct symbols have no dependencies. */
return 0;
gfc_full_array_ref_p (gfc_ref *ref, bool *contiguous)
{
int i;
+ int n;
bool lbound_OK = true;
bool ubound_OK = true;
+ if (contiguous)
+ *contiguous = false;
+
if (ref->type != REF_ARRAY)
return false;
+
if (ref->u.ar.type == AR_FULL)
- return true;
+ {
+ if (contiguous)
+ *contiguous = true;
+ return true;
+ }
+
if (ref->u.ar.type != AR_SECTION)
return false;
if (ref->next)
for (i = 0; i < ref->u.ar.dimen; i++)
{
- /* If we have a single element in the reference, we need to check
- that the array has a single element and that we actually reference
- the correct element. */
+ /* If we have a single element in the reference, for the reference
+ to be full, we need to ascertain that the array has a single
+ element in this dimension and that we actually reference the
+ correct element. */
if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT)
{
- /* This is a contiguous reference. */
+ /* This is unconditionally a contiguous reference if all the
+ remaining dimensions are elements. */
if (contiguous)
- *contiguous = (i + 1 == ref->u.ar.dimen);
+ {
+ *contiguous = true;
+ for (n = i + 1; n < ref->u.ar.dimen; n++)
+ if (ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
+ *contiguous = false;
+ }
if (!ref->u.ar.as
|| !ref->u.ar.as->lower[i]
ref->u.ar.as->upper[i])))
ubound_OK = false;
/* Check the stride. */
- if (ref->u.ar.stride[i] && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
+ if (ref->u.ar.stride[i]
+ && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
return false;
- /* This is a contiguous reference. */
+ /* This is unconditionally a contiguous reference as long as all
+ the subsequent dimensions are elements. */
if (contiguous)
- *contiguous = (i + 1 == ref->u.ar.dimen);
+ {
+ *contiguous = true;
+ for (n = i + 1; n < ref->u.ar.dimen; n++)
+ if (ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
+ *contiguous = false;
+ }
if (!lbound_OK || !ubound_OK)
return false;