Exemple #1
0
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;
    }
}
Exemple #2
0
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;
    }
}