--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/gcc/fortran/dependency.c	Fri Oct 27 22:46:09 2017 +0900
@@ -0,0 +1,2264 @@
+/* Dependency analysis
+   Copyright (C) 2000-2017 Free Software Foundation, Inc.
+   Contributed by Paul Brook <paul@nowt.org>
+
+This file is part of GCC.
+
+GCC is free software; you can redistribute it and/or modify it under
+the terms of the GNU General Public License as published by the Free
+Software Foundation; either version 3, or (at your option) any later
+version.
+
+GCC is distributed in the hope that it will be useful, but WITHOUT ANY
+WARRANTY; without even the implied warranty of MERCHANTABILITY or
+FITNESS FOR A PARTICULAR PURPOSE.  See the GNU General Public License
+for more details.
+
+You should have received a copy of the GNU General Public License
+along with GCC; see the file COPYING3.  If not see
+<http://www.gnu.org/licenses/>.  */
+
+/* dependency.c -- Expression dependency analysis code.  */
+/* There's probably quite a bit of duplication in this file.  We currently
+   have different dependency checking functions for different types
+   if dependencies.  Ideally these would probably be merged.  */
+
+#include "config.h"
+#include "system.h"
+#include "coretypes.h"
+#include "gfortran.h"
+#include "dependency.h"
+#include "constructor.h"
+#include "arith.h"
+
+/* static declarations */
+/* Enums  */
+enum range {LHS, RHS, MID};
+
+/* Dependency types.  These must be in reverse order of priority.  */
+enum gfc_dependency
+{
+  GFC_DEP_ERROR,
+  GFC_DEP_EQUAL,	/* Identical Ranges.  */
+  GFC_DEP_FORWARD,	/* e.g., a(1:3) = a(2:4).  */
+  GFC_DEP_BACKWARD,	/* e.g. a(2:4) = a(1:3).  */
+  GFC_DEP_OVERLAP,	/* May overlap in some other way.  */
+  GFC_DEP_NODEP		/* Distinct ranges.  */
+};
+
+/* Macros */
+#define IS_ARRAY_EXPLICIT(as) ((as->type == AS_EXPLICIT ? 1 : 0))
+
+/* Forward declarations */
+
+static gfc_dependency check_section_vs_section (gfc_array_ref *,
+						gfc_array_ref *, int);
+
+/* Returns 1 if the expr is an integer constant value 1, 0 if it is not or
+   def if the value could not be determined.  */
+
+int
+gfc_expr_is_one (gfc_expr *expr, int def)
+{
+  gcc_assert (expr != NULL);
+
+  if (expr->expr_type != EXPR_CONSTANT)
+    return def;
+
+  if (expr->ts.type != BT_INTEGER)
+    return def;
+
+  return mpz_cmp_si (expr->value.integer, 1) == 0;
+}
+
+/* Check if two array references are known to be identical.  Calls
+   gfc_dep_compare_expr if necessary for comparing array indices.  */
+
+static bool
+identical_array_ref (gfc_array_ref *a1, gfc_array_ref *a2)
+{
+  int i;
+
+  if (a1->type == AR_FULL && a2->type == AR_FULL)
+    return true;
+
+  if (a1->type == AR_SECTION && a2->type == AR_SECTION)
+    {
+      gcc_assert (a1->dimen == a2->dimen);
+
+      for ( i = 0; i < a1->dimen; i++)
+	{
+	  /* TODO: Currently, we punt on an integer array as an index.  */
+	  if (a1->dimen_type[i] != DIMEN_RANGE
+	      || a2->dimen_type[i] != DIMEN_RANGE)
+	    return false;
+
+	  if (check_section_vs_section (a1, a2, i) != GFC_DEP_EQUAL)
+	    return false;
+	}
+      return true;
+    }
+
+  if (a1->type == AR_ELEMENT && a2->type == AR_ELEMENT)
+    {
+      if (a1->dimen != a2->dimen)
+	gfc_internal_error ("identical_array_ref(): inconsistent dimensions");
+
+      for (i = 0; i < a1->dimen; i++)
+	{
+	  if (gfc_dep_compare_expr (a1->start[i], a2->start[i]) != 0)
+	    return false;
+	}
+      return true;
+    }
+  return false;
+}
+
+
+
+/* Return true for identical variables, checking for references if
+   necessary.  Calls identical_array_ref for checking array sections.  */
+
+static bool
+are_identical_variables (gfc_expr *e1, gfc_expr *e2)
+{
+  gfc_ref *r1, *r2;
+
+  if (e1->symtree->n.sym->attr.dummy && e2->symtree->n.sym->attr.dummy)
+    {
+      /* Dummy arguments: Only check for equal names.  */
+      if (e1->symtree->n.sym->name != e2->symtree->n.sym->name)
+	return false;
+    }
+  else
+    {
+      /* Check for equal symbols.  */
+      if (e1->symtree->n.sym != e2->symtree->n.sym)
+	return false;
+    }
+
+  /* Volatile variables should never compare equal to themselves.  */
+
+  if (e1->symtree->n.sym->attr.volatile_)
+    return false;
+
+  r1 = e1->ref;
+  r2 = e2->ref;
+
+  while (r1 != NULL || r2 != NULL)
+    {
+
+      /* Assume the variables are not equal if one has a reference and the
+	 other doesn't.
+	 TODO: Handle full references like comparing a(:) to a.
+      */
+
+      if (r1 == NULL || r2 == NULL)
+	return false;
+
+      if (r1->type != r2->type)
+	return false;
+
+      switch (r1->type)
+	{
+
+	case REF_ARRAY:
+	  if (!identical_array_ref (&r1->u.ar,  &r2->u.ar))
+	    return false;
+
+	  break;
+
+	case REF_COMPONENT:
+	  if (r1->u.c.component != r2->u.c.component)
+	    return false;
+	  break;
+
+	case REF_SUBSTRING:
+	  if (gfc_dep_compare_expr (r1->u.ss.start, r2->u.ss.start) != 0)
+	    return false;
+
+	  /* If both are NULL, the end length compares equal, because we
+	     are looking at the same variable. This can only happen for
+	     assumed- or deferred-length character arguments.  */
+
+	  if (r1->u.ss.end == NULL && r2->u.ss.end == NULL)
+	    break;
+
+	  if (gfc_dep_compare_expr (r1->u.ss.end, r2->u.ss.end) != 0)
+	    return false;
+
+	  break;
+
+	default:
+	  gfc_internal_error ("are_identical_variables: Bad type");
+	}
+      r1 = r1->next;
+      r2 = r2->next;
+    }
+  return true;
+}
+
+/* Compare two functions for equality.  Returns 0 if e1==e2, -2 otherwise.  If
+   impure_ok is false, only return 0 for pure functions.  */
+
+int
+gfc_dep_compare_functions (gfc_expr *e1, gfc_expr *e2, bool impure_ok)
+{
+
+  gfc_actual_arglist *args1;
+  gfc_actual_arglist *args2;
+
+  if (e1->expr_type != EXPR_FUNCTION || e2->expr_type != EXPR_FUNCTION)
+    return -2;
+
+  if ((e1->value.function.esym && e2->value.function.esym
+       && e1->value.function.esym == e2->value.function.esym
+       && (e1->value.function.esym->result->attr.pure || impure_ok))
+       || (e1->value.function.isym && e2->value.function.isym
+	   && e1->value.function.isym == e2->value.function.isym
+	   && (e1->value.function.isym->pure || impure_ok)))
+    {
+      args1 = e1->value.function.actual;
+      args2 = e2->value.function.actual;
+
+      /* Compare the argument lists for equality.  */
+      while (args1 && args2)
+	{
+	  /*  Bitwise xor, since C has no non-bitwise xor operator.  */
+	  if ((args1->expr == NULL) ^ (args2->expr == NULL))
+	    return -2;
+
+	  if (args1->expr != NULL && args2->expr != NULL)
+	    {
+	      gfc_expr *e1, *e2;
+	      e1 = args1->expr;
+	      e2 = args2->expr;
+
+	      if (gfc_dep_compare_expr (e1, e2) != 0)
+		return -2;
+
+	      /* Special case: String arguments which compare equal can have
+		 different lengths, which makes them different in calls to
+		 procedures.  */
+	      
+	      if (e1->expr_type == EXPR_CONSTANT
+		  && e1->ts.type == BT_CHARACTER
+		  && e2->expr_type == EXPR_CONSTANT
+		  && e2->ts.type == BT_CHARACTER
+		  && e1->value.character.length != e2->value.character.length)
+		return -2;
+	    }
+
+	  args1 = args1->next;
+	  args2 = args2->next;
+	}
+      return (args1 || args2) ? -2 : 0;
+    }
+      else
+	return -2;
+}
+
+/* Helper function to look through parens, unary plus and widening
+   integer conversions.  */
+
+gfc_expr *
+gfc_discard_nops (gfc_expr *e)
+{
+  gfc_actual_arglist *arglist;
+
+  if (e == NULL)
+    return NULL;
+
+  while (true)
+    {
+      if (e->expr_type == EXPR_OP
+	  && (e->value.op.op == INTRINSIC_UPLUS
+	      || e->value.op.op == INTRINSIC_PARENTHESES))
+	{
+	  e = e->value.op.op1;
+	  continue;
+	}
+
+      if (e->expr_type == EXPR_FUNCTION && e->value.function.isym
+	  && e->value.function.isym->id == GFC_ISYM_CONVERSION
+	  && e->ts.type == BT_INTEGER)
+	{
+	  arglist = e->value.function.actual;
+	  if (arglist->expr->ts.type == BT_INTEGER
+	      && e->ts.kind > arglist->expr->ts.kind)
+	    {
+	      e = arglist->expr;
+	      continue;
+	    }
+	}
+      break;
+    }
+
+  return e;
+}
+
+
+/* Compare two expressions.  Return values:
+   * +1 if e1 > e2
+   * 0 if e1 == e2
+   * -1 if e1 < e2
+   * -2 if the relationship could not be determined
+   * -3 if e1 /= e2, but we cannot tell which one is larger.
+   REAL and COMPLEX constants are only compared for equality
+   or inequality; if they are unequal, -2 is returned in all cases.  */
+
+int
+gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2)
+{
+  int i;
+
+  if (e1 == NULL && e2 == NULL)
+    return 0;
+
+  e1 = gfc_discard_nops (e1);
+  e2 = gfc_discard_nops (e2);
+
+  if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_PLUS)
+    {
+      /* Compare X+C vs. X, for INTEGER only.  */
+      if (e1->value.op.op2->expr_type == EXPR_CONSTANT
+	  && e1->value.op.op2->ts.type == BT_INTEGER
+	  && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
+	return mpz_sgn (e1->value.op.op2->value.integer);
+
+      /* Compare P+Q vs. R+S.  */
+      if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
+	{
+	  int l, r;
+
+	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
+	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
+	  if (l == 0 && r == 0)
+	    return 0;
+	  if (l == 0 && r > -2)
+	    return r;
+	  if (l > -2 && r == 0)
+	    return l;
+	  if (l == 1 && r == 1)
+	    return 1;
+	  if (l == -1 && r == -1)
+	    return -1;
+
+	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2);
+	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1);
+	  if (l == 0 && r == 0)
+	    return 0;
+	  if (l == 0 && r > -2)
+	    return r;
+	  if (l > -2 && r == 0)
+	    return l;
+	  if (l == 1 && r == 1)
+	    return 1;
+	  if (l == -1 && r == -1)
+	    return -1;
+	}
+    }
+
+  /* Compare X vs. X+C, for INTEGER only.  */
+  if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
+    {
+      if (e2->value.op.op2->expr_type == EXPR_CONSTANT
+	  && e2->value.op.op2->ts.type == BT_INTEGER
+	  && gfc_dep_compare_expr (e1, e2->value.op.op1) == 0)
+	return -mpz_sgn (e2->value.op.op2->value.integer);
+    }
+
+  /* Compare X-C vs. X, for INTEGER only.  */
+  if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_MINUS)
+    {
+      if (e1->value.op.op2->expr_type == EXPR_CONSTANT
+	  && e1->value.op.op2->ts.type == BT_INTEGER
+	  && gfc_dep_compare_expr (e1->value.op.op1, e2) == 0)
+	return -mpz_sgn (e1->value.op.op2->value.integer);
+
+      /* Compare P-Q vs. R-S.  */
+      if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
+	{
+	  int l, r;
+
+	  l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
+	  r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
+	  if (l == 0 && r == 0)
+	    return 0;
+	  if (l > -2 && r == 0)
+	    return l;
+	  if (l == 0 && r > -2)
+	    return -r;
+	  if (l == 1 && r == -1)
+	    return 1;
+	  if (l == -1 && r == 1)
+	    return -1;
+	}
+    }
+
+  /* Compare A // B vs. C // D.  */
+
+  if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_CONCAT
+      && e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_CONCAT)
+    {
+      int l, r;
+
+      l = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
+      r = gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2);
+
+      if (l != 0)
+	return l;
+
+      /* Left expressions of // compare equal, but
+	 watch out for 'A ' // x vs. 'A' // x.  */
+      gfc_expr *e1_left = e1->value.op.op1;
+      gfc_expr *e2_left = e2->value.op.op1;
+
+      if (e1_left->expr_type == EXPR_CONSTANT
+	  && e2_left->expr_type == EXPR_CONSTANT
+	  && e1_left->value.character.length
+	  != e2_left->value.character.length)
+	return -2;
+      else
+	return r;
+    }
+
+  /* Compare X vs. X-C, for INTEGER only.  */
+  if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
+    {
+      if (e2->value.op.op2->expr_type == EXPR_CONSTANT
+	  && e2->value.op.op2->ts.type == BT_INTEGER
+	  && gfc_dep_compare_expr (e1, e2->value.op.op1) == 0)
+	return mpz_sgn (e2->value.op.op2->value.integer);
+    }
+
+  if (e1->expr_type != e2->expr_type)
+    return -3;
+
+  switch (e1->expr_type)
+    {
+    case EXPR_CONSTANT:
+      /* Compare strings for equality.  */
+      if (e1->ts.type == BT_CHARACTER && e2->ts.type == BT_CHARACTER)
+	return gfc_compare_string (e1, e2);
+
+      /* Compare REAL and COMPLEX constants.  Because of the
+	 traps and pitfalls associated with comparing
+	 a + 1.0 with a + 0.5, check for equality only.  */
+      if (e2->expr_type == EXPR_CONSTANT)
+	{
+	  if (e1->ts.type == BT_REAL && e2->ts.type == BT_REAL)
+	    {
+	      if (mpfr_cmp (e1->value.real, e2->value.real) == 0)
+		return 0;
+	      else
+		return -2;
+	    }
+	  else if (e1->ts.type == BT_COMPLEX && e2->ts.type == BT_COMPLEX)
+	    {
+	      if (mpc_cmp (e1->value.complex, e2->value.complex) == 0)
+		return 0;
+	      else
+		return -2;
+	    }
+	}
+
+      if (e1->ts.type != BT_INTEGER || e2->ts.type != BT_INTEGER)
+	return -2;
+
+      /* For INTEGER, all cases where e2 is not constant should have
+	 been filtered out above.  */
+      gcc_assert (e2->expr_type == EXPR_CONSTANT);
+
+      i = mpz_cmp (e1->value.integer, e2->value.integer);
+      if (i == 0)
+	return 0;
+      else if (i < 0)
+	return -1;
+      return 1;
+
+    case EXPR_VARIABLE:
+      if (are_identical_variables (e1, e2))
+	return 0;
+      else
+	return -3;
+
+    case EXPR_OP:
+      /* Intrinsic operators are the same if their operands are the same.  */
+      if (e1->value.op.op != e2->value.op.op)
+	return -2;
+      if (e1->value.op.op2 == 0)
+	{
+	  i = gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1);
+	  return i == 0 ? 0 : -2;
+	}
+      if (gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op1) == 0
+	  && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op2) == 0)
+	return 0;
+      else if (e1->value.op.op == INTRINSIC_TIMES
+	       && gfc_dep_compare_expr (e1->value.op.op1, e2->value.op.op2) == 0
+	       && gfc_dep_compare_expr (e1->value.op.op2, e2->value.op.op1) == 0)
+	/* Commutativity of multiplication; addition is handled above.  */
+	return 0;
+
+      return -2;
+
+    case EXPR_FUNCTION:
+      return gfc_dep_compare_functions (e1, e2, false);
+
+    default:
+      return -2;
+    }
+}
+
+
+/* Return the difference between two expressions.  Integer expressions of
+   the form
+
+   X + constant, X - constant and constant + X
+
+   are handled.  Return true on success, false on failure. result is assumed
+   to be uninitialized on entry, and will be initialized on success.
+*/
+
+bool
+gfc_dep_difference (gfc_expr *e1, gfc_expr *e2, mpz_t *result)
+{
+  gfc_expr *e1_op1, *e1_op2, *e2_op1, *e2_op2;
+
+  if (e1 == NULL || e2 == NULL)
+    return false;
+
+  if (e1->ts.type != BT_INTEGER || e2->ts.type != BT_INTEGER)
+    return false;
+
+  e1 = gfc_discard_nops (e1);
+  e2 = gfc_discard_nops (e2);
+
+  /* Inizialize tentatively, clear if we don't return anything.  */
+  mpz_init (*result);
+
+  /* Case 1: c1 - c2 = c1 - c2, trivially.  */
+
+  if (e1->expr_type == EXPR_CONSTANT && e2->expr_type == EXPR_CONSTANT)
+    {
+      mpz_sub (*result, e1->value.integer, e2->value.integer);
+      return true;
+    }
+
+  if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_PLUS)
+    {
+      e1_op1 = gfc_discard_nops (e1->value.op.op1);
+      e1_op2 = gfc_discard_nops (e1->value.op.op2);
+
+      /* Case 2: (X + c1) - X = c1.  */
+      if (e1_op2->expr_type == EXPR_CONSTANT
+	  && gfc_dep_compare_expr (e1_op1, e2) == 0)
+	{
+	  mpz_set (*result, e1_op2->value.integer);
+	  return true;
+	}
+
+      /* Case 3: (c1 + X) - X = c1.  */
+      if (e1_op1->expr_type == EXPR_CONSTANT
+	  && gfc_dep_compare_expr (e1_op2, e2) == 0)
+	{
+	  mpz_set (*result, e1_op1->value.integer);
+	  return true;
+	}
+
+      if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
+	{
+	  e2_op1 = gfc_discard_nops (e2->value.op.op1);
+	  e2_op2 = gfc_discard_nops (e2->value.op.op2);
+
+	  if (e1_op2->expr_type == EXPR_CONSTANT)
+	    {
+	      /* Case 4: X + c1 - (X + c2) = c1 - c2.  */
+	      if (e2_op2->expr_type == EXPR_CONSTANT
+		  && gfc_dep_compare_expr (e1_op1, e2_op1) == 0)
+		{
+		  mpz_sub (*result, e1_op2->value.integer,
+			   e2_op2->value.integer);
+		  return true;
+		}
+	      /* Case 5: X + c1 - (c2 + X) = c1 - c2.  */
+	      if (e2_op1->expr_type == EXPR_CONSTANT
+		  && gfc_dep_compare_expr (e1_op1, e2_op2) == 0)
+		{
+		  mpz_sub (*result, e1_op2->value.integer,
+			   e2_op1->value.integer);
+		  return true;
+		}
+	    }
+	  else if (e1_op1->expr_type == EXPR_CONSTANT)
+	    {
+	      /* Case 6: c1 + X - (X + c2) = c1 - c2.  */
+	      if (e2_op2->expr_type == EXPR_CONSTANT
+		  && gfc_dep_compare_expr (e1_op2, e2_op1) == 0)
+		{
+		  mpz_sub (*result, e1_op1->value.integer,
+			   e2_op2->value.integer);
+		  return true;
+		}
+	      /* Case 7: c1 + X - (c2 + X) = c1 - c2.  */
+	      if (e2_op1->expr_type == EXPR_CONSTANT
+		  && gfc_dep_compare_expr (e1_op2, e2_op2) == 0)
+		{
+		  mpz_sub (*result, e1_op1->value.integer,
+			   e2_op1->value.integer);
+		  return true;
+		}
+	    }
+	}
+
+      if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
+	{
+	  e2_op1 = gfc_discard_nops (e2->value.op.op1);
+	  e2_op2 = gfc_discard_nops (e2->value.op.op2);
+
+	  if (e1_op2->expr_type == EXPR_CONSTANT)
+	    {
+	      /* Case 8: X + c1 - (X - c2) = c1 + c2.  */
+	      if (e2_op2->expr_type == EXPR_CONSTANT
+		  && gfc_dep_compare_expr (e1_op1, e2_op1) == 0)
+		{
+		  mpz_add (*result, e1_op2->value.integer,
+			   e2_op2->value.integer);
+		  return true;
+		}
+	    }
+	  if (e1_op1->expr_type == EXPR_CONSTANT)
+	    {
+	      /* Case 9: c1 + X - (X - c2) = c1 + c2.  */
+	      if (e2_op2->expr_type == EXPR_CONSTANT
+		  && gfc_dep_compare_expr (e1_op2, e2_op1) == 0)
+		{
+		  mpz_add (*result, e1_op1->value.integer,
+			   e2_op2->value.integer);
+		  return true;
+		}
+	    }
+	}
+    }
+
+  if (e1->expr_type == EXPR_OP && e1->value.op.op == INTRINSIC_MINUS)
+    {
+      e1_op1 = gfc_discard_nops (e1->value.op.op1);
+      e1_op2 = gfc_discard_nops (e1->value.op.op2);
+
+      if (e1_op2->expr_type == EXPR_CONSTANT)
+	{
+	  /* Case 10: (X - c1) - X = -c1  */
+
+	  if (gfc_dep_compare_expr (e1_op1, e2) == 0)
+	    {
+	      mpz_neg (*result, e1_op2->value.integer);
+	      return true;
+	    }
+
+	  if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
+	    {
+	      e2_op1 = gfc_discard_nops (e2->value.op.op1);
+	      e2_op2 = gfc_discard_nops (e2->value.op.op2);
+
+	      /* Case 11: (X - c1) - (X + c2) = -( c1 + c2).  */
+	      if (e2_op2->expr_type == EXPR_CONSTANT
+		  && gfc_dep_compare_expr (e1_op1, e2_op1) == 0)
+		{
+		  mpz_add (*result, e1_op2->value.integer,
+			   e2_op2->value.integer);
+		  mpz_neg (*result, *result);
+		  return true;
+		}
+
+	      /* Case 12: X - c1 - (c2 + X) = - (c1 + c2).  */
+	      if (e2_op1->expr_type == EXPR_CONSTANT
+		  && gfc_dep_compare_expr (e1_op1, e2_op2) == 0)
+		{
+		  mpz_add (*result, e1_op2->value.integer,
+			   e2_op1->value.integer);
+		  mpz_neg (*result, *result);
+		  return true;
+		}
+	    }
+
+	  if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
+	    {
+	      e2_op1 = gfc_discard_nops (e2->value.op.op1);
+	      e2_op2 = gfc_discard_nops (e2->value.op.op2);
+
+	      /* Case 13: (X - c1) - (X - c2) = c2 - c1.  */
+	      if (e2_op2->expr_type == EXPR_CONSTANT
+		  && gfc_dep_compare_expr (e1_op1, e2_op1) == 0)
+		{
+		  mpz_sub (*result, e2_op2->value.integer,
+			   e1_op2->value.integer);
+		  return true;
+		}
+	    }
+	}
+      if (e1_op1->expr_type == EXPR_CONSTANT)
+	{
+	  if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
+	    {
+	      e2_op1 = gfc_discard_nops (e2->value.op.op1);
+	      e2_op2 = gfc_discard_nops (e2->value.op.op2);
+
+	      /* Case 14: (c1 - X) - (c2 - X) == c1 - c2.  */
+	      if (gfc_dep_compare_expr (e1_op2, e2_op2) == 0)
+		{
+		  mpz_sub (*result, e1_op1->value.integer,
+			   e2_op1->value.integer);
+		    return true;
+		}
+	    }
+
+	}
+    }
+
+  if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_PLUS)
+    {
+      e2_op1 = gfc_discard_nops (e2->value.op.op1);
+      e2_op2 = gfc_discard_nops (e2->value.op.op2);
+
+      /* Case 15: X - (X + c2) = -c2.  */
+      if (e2_op2->expr_type == EXPR_CONSTANT
+	  && gfc_dep_compare_expr (e1, e2_op1) == 0)
+	{
+	  mpz_neg (*result, e2_op2->value.integer);
+	  return true;
+	}
+      /* Case 16: X - (c2 + X) = -c2.  */
+      if (e2_op1->expr_type == EXPR_CONSTANT
+	  && gfc_dep_compare_expr (e1, e2_op2) == 0)
+	{
+	  mpz_neg (*result, e2_op1->value.integer);
+	  return true;
+	}
+    }
+
+  if (e2->expr_type == EXPR_OP && e2->value.op.op == INTRINSIC_MINUS)
+    {
+      e2_op1 = gfc_discard_nops (e2->value.op.op1);
+      e2_op2 = gfc_discard_nops (e2->value.op.op2);
+
+      /* Case 17: X - (X - c2) = c2.  */
+      if (e2_op2->expr_type == EXPR_CONSTANT
+	  && gfc_dep_compare_expr (e1, e2_op1) == 0)
+	{
+	  mpz_set (*result, e2_op2->value.integer);
+	  return true;
+	}
+    }
+
+  if (gfc_dep_compare_expr (e1, e2) == 0)
+    {
+      /* Case 18: X - X = 0.  */
+      mpz_set_si (*result, 0);
+      return true;
+    }
+
+  mpz_clear (*result);
+  return false;
+}
+
+/* Returns 1 if the two ranges are the same and 0 if they are not (or if the
+   results are indeterminate). 'n' is the dimension to compare.  */
+
+static int
+is_same_range (gfc_array_ref *ar1, gfc_array_ref *ar2, int n)
+{
+  gfc_expr *e1;
+  gfc_expr *e2;
+  int i;
+
+  /* TODO: More sophisticated range comparison.  */
+  gcc_assert (ar1 && ar2);
+
+  gcc_assert (ar1->dimen_type[n] == ar2->dimen_type[n]);
+
+  e1 = ar1->stride[n];
+  e2 = ar2->stride[n];
+  /* Check for mismatching strides.  A NULL stride means a stride of 1.  */
+  if (e1 && !e2)
+    {
+      i = gfc_expr_is_one (e1, -1);
+      if (i == -1 || i == 0)
+	return 0;
+    }
+  else if (e2 && !e1)
+    {
+      i = gfc_expr_is_one (e2, -1);
+      if (i == -1 || i == 0)
+	return 0;
+    }
+  else if (e1 && e2)
+    {
+      i = gfc_dep_compare_expr (e1, e2);
+      if (i != 0)
+	return 0;
+    }
+  /* The strides match.  */
+
+  /* Check the range start.  */
+  e1 = ar1->start[n];
+  e2 = ar2->start[n];
+  if (e1 || e2)
+    {
+      /* Use the bound of the array if no bound is specified.  */
+      if (ar1->as && !e1)
+	e1 = ar1->as->lower[n];
+
+      if (ar2->as && !e2)
+	e2 = ar2->as->lower[n];
+
+      /* Check we have values for both.  */
+      if (!(e1 && e2))
+	return 0;
+
+      i = gfc_dep_compare_expr (e1, e2);
+      if (i != 0)
+	return 0;
+    }
+
+  /* Check the range end.  */
+  e1 = ar1->end[n];
+  e2 = ar2->end[n];
+  if (e1 || e2)
+    {
+      /* Use the bound of the array if no bound is specified.  */
+      if (ar1->as && !e1)
+	e1 = ar1->as->upper[n];
+
+      if (ar2->as && !e2)
+	e2 = ar2->as->upper[n];
+
+      /* Check we have values for both.  */
+      if (!(e1 && e2))
+	return 0;
+
+      i = gfc_dep_compare_expr (e1, e2);
+      if (i != 0)
+	return 0;
+    }
+
+  return 1;
+}
+
+
+/* Some array-returning intrinsics can be implemented by reusing the
+   data from one of the array arguments.  For example, TRANSPOSE does
+   not necessarily need to allocate new data: it can be implemented
+   by copying the original array's descriptor and simply swapping the
+   two dimension specifications.
+
+   If EXPR is a call to such an intrinsic, return the argument
+   whose data can be reused, otherwise return NULL.  */
+
+gfc_expr *
+gfc_get_noncopying_intrinsic_argument (gfc_expr *expr)
+{
+  if (expr->expr_type != EXPR_FUNCTION || !expr->value.function.isym)
+    return NULL;
+
+  switch (expr->value.function.isym->id)
+    {
+    case GFC_ISYM_TRANSPOSE:
+      return expr->value.function.actual->expr;
+
+    default:
+      return NULL;
+    }
+}
+
+
+/* Return true if the result of reference REF can only be constructed
+   using a temporary array.  */
+
+bool
+gfc_ref_needs_temporary_p (gfc_ref *ref)
+{
+  int n;
+  bool subarray_p;
+
+  subarray_p = false;
+  for (; ref; ref = ref->next)
+    switch (ref->type)
+      {
+      case REF_ARRAY:
+	/* Vector dimensions are generally not monotonic and must be
+	   handled using a temporary.  */
+	if (ref->u.ar.type == AR_SECTION)
+	  for (n = 0; n < ref->u.ar.dimen; n++)
+	    if (ref->u.ar.dimen_type[n] == DIMEN_VECTOR)
+	      return true;
+
+	subarray_p = true;
+	break;
+
+      case REF_SUBSTRING:
+	/* Within an array reference, character substrings generally
+	   need a temporary.  Character array strides are expressed as
+	   multiples of the element size (consistent with other array
+	   types), not in characters.  */
+	return subarray_p;
+
+      case REF_COMPONENT:
+	break;
+      }
+
+  return false;
+}
+
+
+static int
+gfc_is_data_pointer (gfc_expr *e)
+{
+  gfc_ref *ref;
+
+  if (e->expr_type != EXPR_VARIABLE && e->expr_type != EXPR_FUNCTION)
+    return 0;
+
+  /* No subreference if it is a function  */
+  gcc_assert (e->expr_type == EXPR_VARIABLE || !e->ref);
+
+  if (e->symtree->n.sym->attr.pointer)
+    return 1;
+
+  for (ref = e->ref; ref; ref = ref->next)
+    if (ref->type == REF_COMPONENT && ref->u.c.component->attr.pointer)
+      return 1;
+
+  return 0;
+}
+
+
+/* Return true if array variable VAR could be passed to the same function
+   as argument EXPR without interfering with EXPR.  INTENT is the intent
+   of VAR.
+
+   This is considerably less conservative than other dependencies
+   because many function arguments will already be copied into a
+   temporary.  */
+
+static int
+gfc_check_argument_var_dependency (gfc_expr *var, sym_intent intent,
+				   gfc_expr *expr, gfc_dep_check elemental)
+{
+  gfc_expr *arg;
+
+  gcc_assert (var->expr_type == EXPR_VARIABLE);
+  gcc_assert (var->rank > 0);
+
+  switch (expr->expr_type)
+    {
+    case EXPR_VARIABLE:
+      /* 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 == NOT_ELEMENTAL))
+	{
+	  if (elemental == ELEM_DONT_CHECK_VARIABLE)
+	    {
+	      /* Too many false positive with pointers.  */
+	      if (!gfc_is_data_pointer (var) && !gfc_is_data_pointer (expr))
+		{
+		  /* Elemental procedures forbid unspecified intents,
+		     and we don't check dependencies for INTENT_IN args.  */
+		  gcc_assert (intent == INTENT_OUT || intent == INTENT_INOUT);
+
+		  /* We are told not to check dependencies.
+		     We do it, however, and issue a warning in case we find one.
+		     If a dependency is found in the case
+		     elemental == ELEM_CHECK_VARIABLE, we will generate
+		     a temporary, so we don't need to bother the user.  */
+		  gfc_warning (0, "INTENT(%s) actual argument at %L might "
+			       "interfere with actual argument at %L.",
+		   	       intent == INTENT_OUT ? "OUT" : "INOUT",
+		   	       &var->where, &expr->where);
+		}
+	      return 0;
+	    }
+	  else
+	    return 1;
+	}
+      return 0;
+
+    case EXPR_ARRAY:
+      /* the scalarizer always generates a temporary for array constructors,
+	 so there is no dependency.  */
+      return 0;
+
+    case EXPR_FUNCTION:
+      if (intent != INTENT_IN)
+	{
+	  arg = gfc_get_noncopying_intrinsic_argument (expr);
+	  if (arg != NULL)
+	    return gfc_check_argument_var_dependency (var, intent, arg,
+						      NOT_ELEMENTAL);
+	}
+
+      if (elemental != NOT_ELEMENTAL)
+	{
+	  if ((expr->value.function.esym
+	       && expr->value.function.esym->attr.elemental)
+	      || (expr->value.function.isym
+		  && expr->value.function.isym->elemental))
+	    return gfc_check_fncall_dependency (var, intent, NULL,
+						expr->value.function.actual,
+						ELEM_CHECK_VARIABLE);
+
+	  if (gfc_inline_intrinsic_function_p (expr))
+	    {
+	      /* The TRANSPOSE case should have been caught in the
+		 noncopying intrinsic case above.  */
+	      gcc_assert (expr->value.function.isym->id != GFC_ISYM_TRANSPOSE);
+
+	      return gfc_check_fncall_dependency (var, intent, NULL,
+						  expr->value.function.actual,
+						  ELEM_CHECK_VARIABLE);
+	    }
+	}
+      return 0;
+
+    case EXPR_OP:
+      /* In case of non-elemental procedures, there is no need to catch
+	 dependencies, as we will make a temporary anyway.  */
+      if (elemental)
+	{
+	  /* If the actual arg EXPR is an expression, we need to catch
+	     a dependency between variables in EXPR and VAR,
+	     an intent((IN)OUT) variable.  */
+	  if (expr->value.op.op1
+	      && gfc_check_argument_var_dependency (var, intent,
+						    expr->value.op.op1,
+						    ELEM_CHECK_VARIABLE))
+	    return 1;
+	  else if (expr->value.op.op2
+		   && gfc_check_argument_var_dependency (var, intent,
+							 expr->value.op.op2,
+							 ELEM_CHECK_VARIABLE))
+	    return 1;
+	}
+      return 0;
+
+    default:
+      return 0;
+    }
+}
+
+
+/* Like gfc_check_argument_var_dependency, but extended to any
+   array expression OTHER, not just variables.  */
+
+static int
+gfc_check_argument_dependency (gfc_expr *other, sym_intent intent,
+			       gfc_expr *expr, gfc_dep_check elemental)
+{
+  switch (other->expr_type)
+    {
+    case EXPR_VARIABLE:
+      return gfc_check_argument_var_dependency (other, intent, expr, elemental);
+
+    case EXPR_FUNCTION:
+      other = gfc_get_noncopying_intrinsic_argument (other);
+      if (other != NULL)
+	return gfc_check_argument_dependency (other, INTENT_IN, expr,
+					      NOT_ELEMENTAL);
+
+      return 0;
+
+    default:
+      return 0;
+    }
+}
+
+
+/* Like gfc_check_argument_dependency, but check all the arguments in ACTUAL.
+   FNSYM is the function being called, or NULL if not known.  */
+
+int
+gfc_check_fncall_dependency (gfc_expr *other, sym_intent intent,
+			     gfc_symbol *fnsym, gfc_actual_arglist *actual,
+			     gfc_dep_check elemental)
+{
+  gfc_formal_arglist *formal;
+  gfc_expr *expr;
+
+  formal = fnsym ? gfc_sym_get_dummy_args (fnsym) : NULL;
+  for (; actual; actual = actual->next, formal = formal ? formal->next : NULL)
+    {
+      expr = actual->expr;
+
+      /* Skip args which are not present.  */
+      if (!expr)
+	continue;
+
+      /* Skip other itself.  */
+      if (expr == other)
+	continue;
+
+      /* Skip intent(in) arguments if OTHER itself is intent(in).  */
+      if (formal && intent == INTENT_IN
+	  && formal->sym->attr.intent == INTENT_IN)
+	continue;
+
+      if (gfc_check_argument_dependency (other, intent, expr, elemental))
+	return 1;
+    }
+
+  return 0;
+}
+
+
+/* Return 1 if e1 and e2 are equivalenced arrays, either
+   directly or indirectly; i.e., equivalence (a,b) for a and b
+   or equivalence (a,c),(b,c).  This function uses the equiv_
+   lists, generated in trans-common(add_equivalences), that are
+   guaranteed to pick up indirect equivalences.  We explicitly
+   check for overlap using the offset and length of the equivalence.
+   This function is symmetric.
+   TODO: This function only checks whether the full top-level
+   symbols overlap.  An improved implementation could inspect
+   e1->ref and e2->ref to determine whether the actually accessed
+   portions of these variables/arrays potentially overlap.  */
+
+int
+gfc_are_equivalenced_arrays (gfc_expr *e1, gfc_expr *e2)
+{
+  gfc_equiv_list *l;
+  gfc_equiv_info *s, *fl1, *fl2;
+
+  gcc_assert (e1->expr_type == EXPR_VARIABLE
+	      && e2->expr_type == EXPR_VARIABLE);
+
+  if (!e1->symtree->n.sym->attr.in_equivalence
+      || !e2->symtree->n.sym->attr.in_equivalence|| !e1->rank || !e2->rank)
+    return 0;
+
+  if (e1->symtree->n.sym->ns
+	&& e1->symtree->n.sym->ns != gfc_current_ns)
+    l = e1->symtree->n.sym->ns->equiv_lists;
+  else
+    l = gfc_current_ns->equiv_lists;
+
+  /* Go through the equiv_lists and return 1 if the variables
+     e1 and e2 are members of the same group and satisfy the
+     requirement on their relative offsets.  */
+  for (; l; l = l->next)
+    {
+      fl1 = NULL;
+      fl2 = NULL;
+      for (s = l->equiv; s; s = s->next)
+	{
+	  if (s->sym == e1->symtree->n.sym)
+	    {
+	      fl1 = s;
+	      if (fl2)
+		break;
+	    }
+	  if (s->sym == e2->symtree->n.sym)
+	    {
+	      fl2 = s;
+	      if (fl1)
+		break;
+	    }
+	}
+
+      if (s)
+	{
+	  /* Can these lengths be zero?  */
+	  if (fl1->length <= 0 || fl2->length <= 0)
+	    return 1;
+	  /* These can't overlap if [f11,fl1+length] is before
+	     [fl2,fl2+length], or [fl2,fl2+length] is before
+	     [fl1,fl1+length], otherwise they do overlap.  */
+	  if (fl1->offset + fl1->length > fl2->offset
+	      && fl2->offset + fl2->length > fl1->offset)
+	    return 1;
+	}
+    }
+  return 0;
+}
+
+
+/* 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
+	|| expr2->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
+   whether array references to the same symbol with identical range
+   references count as a dependency or not.  Used for forall and where
+   statements.  Also used with functions returning arrays without a
+   temporary.  */
+
+int
+gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical)
+{
+  gfc_actual_arglist *actual;
+  gfc_constructor *c;
+  int n;
+
+  /* -fcoarray=lib can end up here with expr1->expr_type set to EXPR_FUNCTION
+     and a reference to _F.caf_get, so skip the assert.  */
+  if (expr1->expr_type == EXPR_FUNCTION
+      && strcmp (expr1->value.function.name, "_F.caf_get") == 0)
+    return 0;
+
+  if (expr1->expr_type != EXPR_VARIABLE)
+    gfc_internal_error ("gfc_check_dependency: expecting an 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)
+	{
+	  symbol_attribute attr1, attr2;
+	  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;
+	    }
+
+	  /* We have to also include target-target as ptr%comp is not a
+	     pointer but it still alias with "dt%comp" for "ptr => dt".  As
+	     subcomponents and array access to pointers retains the target
+	     attribute, that's sufficient.  */
+	  attr1 = gfc_expr_attr (expr1);
+	  attr2 = gfc_expr_attr (expr2);
+	  if ((attr1.pointer || attr1.target) && (attr2.pointer || attr2.target))
+	    {
+	      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 (gfc_get_noncopying_intrinsic_argument (expr2) != NULL)
+	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;
+    }
+}
+
+
+/* Determines overlapping for two array sections.  */
+
+static gfc_dependency
+check_section_vs_section (gfc_array_ref *l_ar, gfc_array_ref *r_ar, int n)
+{
+  gfc_expr *l_start;
+  gfc_expr *l_end;
+  gfc_expr *l_stride;
+  gfc_expr *l_lower;
+  gfc_expr *l_upper;
+  int l_dir;
+
+  gfc_expr *r_start;
+  gfc_expr *r_end;
+  gfc_expr *r_stride;
+  gfc_expr *r_lower;
+  gfc_expr *r_upper;
+  gfc_expr *one_expr;
+  int r_dir;
+  int stride_comparison;
+  int start_comparison;
+  mpz_t tmp;
+
+  /* If they are the same range, return without more ado.  */
+  if (is_same_range (l_ar, r_ar, n))
+    return GFC_DEP_EQUAL;
+
+  l_start = l_ar->start[n];
+  l_end = l_ar->end[n];
+  l_stride = l_ar->stride[n];
+
+  r_start = r_ar->start[n];
+  r_end = r_ar->end[n];
+  r_stride = r_ar->stride[n];
+
+  /* If l_start is NULL take it from array specifier.  */
+  if (NULL == l_start && IS_ARRAY_EXPLICIT (l_ar->as))
+    l_start = l_ar->as->lower[n];
+  /* If l_end is NULL take it from array specifier.  */
+  if (NULL == l_end && IS_ARRAY_EXPLICIT (l_ar->as))
+    l_end = l_ar->as->upper[n];
+
+  /* If r_start is NULL take it from array specifier.  */
+  if (NULL == r_start && IS_ARRAY_EXPLICIT (r_ar->as))
+    r_start = r_ar->as->lower[n];
+  /* If r_end is NULL take it from array specifier.  */
+  if (NULL == r_end && IS_ARRAY_EXPLICIT (r_ar->as))
+    r_end = r_ar->as->upper[n];
+
+  /* Determine whether the l_stride is positive or negative.  */
+  if (!l_stride)
+    l_dir = 1;
+  else if (l_stride->expr_type == EXPR_CONSTANT
+	   && l_stride->ts.type == BT_INTEGER)
+    l_dir = mpz_sgn (l_stride->value.integer);
+  else if (l_start && l_end)
+    l_dir = gfc_dep_compare_expr (l_end, l_start);
+  else
+    l_dir = -2;
+
+  /* Determine whether the r_stride is positive or negative.  */
+  if (!r_stride)
+    r_dir = 1;
+  else if (r_stride->expr_type == EXPR_CONSTANT
+	   && r_stride->ts.type == BT_INTEGER)
+    r_dir = mpz_sgn (r_stride->value.integer);
+  else if (r_start && r_end)
+    r_dir = gfc_dep_compare_expr (r_end, r_start);
+  else
+    r_dir = -2;
+
+  /* The strides should never be zero.  */
+  if (l_dir == 0 || r_dir == 0)
+    return GFC_DEP_OVERLAP;
+
+  /* Determine the relationship between the strides.  Set stride_comparison to
+     -2 if the dependency cannot be determined
+     -1 if l_stride < r_stride
+      0 if l_stride == r_stride
+      1 if l_stride > r_stride
+     as determined by gfc_dep_compare_expr.  */
+
+  one_expr = gfc_get_int_expr (gfc_index_integer_kind, NULL, 1);
+
+  stride_comparison = gfc_dep_compare_expr (l_stride ? l_stride : one_expr,
+					    r_stride ? r_stride : one_expr);
+
+  if (l_start && r_start)
+    start_comparison = gfc_dep_compare_expr (l_start, r_start);
+  else
+    start_comparison = -2;
+
+  gfc_free_expr (one_expr);
+
+  /* Determine LHS upper and lower bounds.  */
+  if (l_dir == 1)
+    {
+      l_lower = l_start;
+      l_upper = l_end;
+    }
+  else if (l_dir == -1)
+    {
+      l_lower = l_end;
+      l_upper = l_start;
+    }
+  else
+    {
+      l_lower = NULL;
+      l_upper = NULL;
+    }
+
+  /* Determine RHS upper and lower bounds.  */
+  if (r_dir == 1)
+    {
+      r_lower = r_start;
+      r_upper = r_end;
+    }
+  else if (r_dir == -1)
+    {
+      r_lower = r_end;
+      r_upper = r_start;
+    }
+  else
+    {
+      r_lower = NULL;
+      r_upper = NULL;
+    }
+
+  /* Check whether the ranges are disjoint.  */
+  if (l_upper && r_lower && gfc_dep_compare_expr (l_upper, r_lower) == -1)
+    return GFC_DEP_NODEP;
+  if (r_upper && l_lower && gfc_dep_compare_expr (r_upper, l_lower) == -1)
+    return GFC_DEP_NODEP;
+
+  /* Handle cases like x:y:1 vs. x:z:-1 as GFC_DEP_EQUAL.  */
+  if (l_start && r_start && gfc_dep_compare_expr (l_start, r_start) == 0)
+    {
+      if (l_dir == 1 && r_dir == -1)
+	return GFC_DEP_EQUAL;
+      if (l_dir == -1 && r_dir == 1)
+	return GFC_DEP_EQUAL;
+    }
+
+  /* Handle cases like x:y:1 vs. z:y:-1 as GFC_DEP_EQUAL.  */
+  if (l_end && r_end && gfc_dep_compare_expr (l_end, r_end) == 0)
+    {
+      if (l_dir == 1 && r_dir == -1)
+	return GFC_DEP_EQUAL;
+      if (l_dir == -1 && r_dir == 1)
+	return GFC_DEP_EQUAL;
+    }
+
+  /* Handle cases like x:y:2 vs. x+1:z:4 as GFC_DEP_NODEP.
+     There is no dependency if the remainder of
+     (l_start - r_start) / gcd(l_stride, r_stride) is
+     nonzero.
+     TODO:
+       - Cases like a(1:4:2) = a(2:3) are still not handled.
+  */
+
+#define IS_CONSTANT_INTEGER(a) ((a) && ((a)->expr_type == EXPR_CONSTANT) \
+			      && (a)->ts.type == BT_INTEGER)
+
+  if (IS_CONSTANT_INTEGER (l_stride) && IS_CONSTANT_INTEGER (r_stride)
+      && gfc_dep_difference (l_start, r_start, &tmp))
+    {
+      mpz_t gcd;
+      int result;
+
+      mpz_init (gcd);
+      mpz_gcd (gcd, l_stride->value.integer, r_stride->value.integer);
+
+      mpz_fdiv_r (tmp, tmp, gcd);
+      result = mpz_cmp_si (tmp, 0L);
+
+      mpz_clear (gcd);
+      mpz_clear (tmp);
+
+      if (result != 0)
+	return GFC_DEP_NODEP;
+    }
+
+#undef IS_CONSTANT_INTEGER
+
+  /* Check for forward dependencies x:y vs. x+1:z and x:y:z vs. x:y:z+1.  */
+
+  if (l_dir == 1 && r_dir == 1 &&
+      (start_comparison == 0 || start_comparison == -1)
+      && (stride_comparison == 0 || stride_comparison == -1))
+	  return GFC_DEP_FORWARD;
+
+  /* Check for forward dependencies x:y:-1 vs. x-1:z:-1 and
+     x:y:-1 vs. x:y:-2.  */
+  if (l_dir == -1 && r_dir == -1 &&
+      (start_comparison == 0 || start_comparison == 1)
+      && (stride_comparison == 0 || stride_comparison == 1))
+    return GFC_DEP_FORWARD;
+
+  if (stride_comparison == 0 || stride_comparison == -1)
+    {
+      if (l_start && IS_ARRAY_EXPLICIT (l_ar->as))
+	{
+
+	  /* Check for a(low:y:s) vs. a(z:x:s) or
+	     a(low:y:s) vs. a(z:x:s+1) where a has a lower bound
+	     of low, which is always at least a forward dependence.  */
+
+	  if (r_dir == 1
+	      && gfc_dep_compare_expr (l_start, l_ar->as->lower[n]) == 0)
+	    return GFC_DEP_FORWARD;
+	}
+    }
+
+  if (stride_comparison == 0 || stride_comparison == 1)
+    {
+      if (l_start && IS_ARRAY_EXPLICIT (l_ar->as))
+	{
+
+	  /* Check for a(high:y:-s) vs. a(z:x:-s) or
+	     a(high:y:-s vs. a(z:x:-s-1) where a has a higher bound
+	     of high, which is always at least a forward dependence.  */
+
+	  if (r_dir == -1
+	      && gfc_dep_compare_expr (l_start, l_ar->as->upper[n]) == 0)
+	    return GFC_DEP_FORWARD;
+	}
+    }
+
+
+  if (stride_comparison == 0)
+    {
+      /* From here, check for backwards dependencies.  */
+      /* x+1:y vs. x:z.  */
+      if (l_dir == 1 && r_dir == 1  && start_comparison == 1)
+	return GFC_DEP_BACKWARD;
+
+      /* x-1:y:-1 vs. x:z:-1.  */
+      if (l_dir == -1 && r_dir == -1 && start_comparison == -1)
+	return GFC_DEP_BACKWARD;
+    }
+
+  return GFC_DEP_OVERLAP;
+}
+
+
+/* Determines overlapping for a single element and a section.  */
+
+static gfc_dependency
+gfc_check_element_vs_section( gfc_ref *lref, gfc_ref *rref, int n)
+{
+  gfc_array_ref *ref;
+  gfc_expr *elem;
+  gfc_expr *start;
+  gfc_expr *end;
+  gfc_expr *stride;
+  int s;
+
+  elem = lref->u.ar.start[n];
+  if (!elem)
+    return GFC_DEP_OVERLAP;
+
+  ref = &rref->u.ar;
+  start = ref->start[n] ;
+  end = ref->end[n] ;
+  stride = ref->stride[n];
+
+  if (!start && IS_ARRAY_EXPLICIT (ref->as))
+    start = ref->as->lower[n];
+  if (!end && IS_ARRAY_EXPLICIT (ref->as))
+    end = ref->as->upper[n];
+
+  /* Determine whether the stride is positive or negative.  */
+  if (!stride)
+    s = 1;
+  else if (stride->expr_type == EXPR_CONSTANT
+	   && stride->ts.type == BT_INTEGER)
+    s = mpz_sgn (stride->value.integer);
+  else
+    s = -2;
+
+  /* Stride should never be zero.  */
+  if (s == 0)
+    return GFC_DEP_OVERLAP;
+
+  /* Positive strides.  */
+  if (s == 1)
+    {
+      /* Check for elem < lower.  */
+      if (start && gfc_dep_compare_expr (elem, start) == -1)
+	return GFC_DEP_NODEP;
+      /* Check for elem > upper.  */
+      if (end && gfc_dep_compare_expr (elem, end) == 1)
+	return GFC_DEP_NODEP;
+
+      if (start && end)
+	{
+	  s = gfc_dep_compare_expr (start, end);
+	  /* Check for an empty range.  */
+	  if (s == 1)
+	    return GFC_DEP_NODEP;
+	  if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
+	    return GFC_DEP_EQUAL;
+	}
+    }
+  /* Negative strides.  */
+  else if (s == -1)
+    {
+      /* Check for elem > upper.  */
+      if (end && gfc_dep_compare_expr (elem, start) == 1)
+	return GFC_DEP_NODEP;
+      /* Check for elem < lower.  */
+      if (start && gfc_dep_compare_expr (elem, end) == -1)
+	return GFC_DEP_NODEP;
+
+      if (start && end)
+	{
+	  s = gfc_dep_compare_expr (start, end);
+	  /* Check for an empty range.  */
+	  if (s == -1)
+	    return GFC_DEP_NODEP;
+	  if (s == 0 && gfc_dep_compare_expr (elem, start) == 0)
+	    return GFC_DEP_EQUAL;
+	}
+    }
+  /* Unknown strides.  */
+  else
+    {
+      if (!start || !end)
+	return GFC_DEP_OVERLAP;
+      s = gfc_dep_compare_expr (start, end);
+      if (s <= -2)
+	return GFC_DEP_OVERLAP;
+      /* Assume positive stride.  */
+      if (s == -1)
+	{
+	  /* Check for elem < lower.  */
+	  if (gfc_dep_compare_expr (elem, start) == -1)
+	    return GFC_DEP_NODEP;
+	  /* Check for elem > upper.  */
+	  if (gfc_dep_compare_expr (elem, end) == 1)
+	    return GFC_DEP_NODEP;
+	}
+      /* Assume negative stride.  */
+      else if (s == 1)
+	{
+	  /* Check for elem > upper.  */
+	  if (gfc_dep_compare_expr (elem, start) == 1)
+	    return GFC_DEP_NODEP;
+	  /* Check for elem < lower.  */
+	  if (gfc_dep_compare_expr (elem, end) == -1)
+	    return GFC_DEP_NODEP;
+	}
+      /* Equal bounds.  */
+      else if (s == 0)
+	{
+	  s = gfc_dep_compare_expr (elem, start);
+	  if (s == 0)
+	    return GFC_DEP_EQUAL;
+	  if (s == 1 || s == -1)
+	    return GFC_DEP_NODEP;
+	}
+    }
+
+  return GFC_DEP_OVERLAP;
+}
+
+
+/* Traverse expr, checking all EXPR_VARIABLE symbols for their
+   forall_index attribute.  Return true if any variable may be
+   being used as a FORALL index.  Its safe to pessimistically
+   return true, and assume a dependency.  */
+
+static bool
+contains_forall_index_p (gfc_expr *expr)
+{
+  gfc_actual_arglist *arg;
+  gfc_constructor *c;
+  gfc_ref *ref;
+  int i;
+
+  if (!expr)
+    return false;
+
+  switch (expr->expr_type)
+    {
+    case EXPR_VARIABLE:
+      if (expr->symtree->n.sym->forall_index)
+	return true;
+      break;
+
+    case EXPR_OP:
+      if (contains_forall_index_p (expr->value.op.op1)
+	  || contains_forall_index_p (expr->value.op.op2))
+	return true;
+      break;
+
+    case EXPR_FUNCTION:
+      for (arg = expr->value.function.actual; arg; arg = arg->next)
+	if (contains_forall_index_p (arg->expr))
+	  return true;
+      break;
+
+    case EXPR_CONSTANT:
+    case EXPR_NULL:
+    case EXPR_SUBSTRING:
+      break;
+
+    case EXPR_STRUCTURE:
+    case EXPR_ARRAY:
+      for (c = gfc_constructor_first (expr->value.constructor);
+	   c; gfc_constructor_next (c))
+	if (contains_forall_index_p (c->expr))
+	  return true;
+      break;
+
+    default:
+      gcc_unreachable ();
+    }
+
+  for (ref = expr->ref; ref; ref = ref->next)
+    switch (ref->type)
+      {
+      case REF_ARRAY:
+	for (i = 0; i < ref->u.ar.dimen; i++)
+	  if (contains_forall_index_p (ref->u.ar.start[i])
+	      || contains_forall_index_p (ref->u.ar.end[i])
+	      || contains_forall_index_p (ref->u.ar.stride[i]))
+	    return true;
+	break;
+
+      case REF_COMPONENT:
+	break;
+
+      case REF_SUBSTRING:
+	if (contains_forall_index_p (ref->u.ss.start)
+	    || contains_forall_index_p (ref->u.ss.end))
+	  return true;
+	break;
+
+      default:
+	gcc_unreachable ();
+      }
+
+  return false;
+}
+
+/* Determines overlapping for two single element array references.  */
+
+static gfc_dependency
+gfc_check_element_vs_element (gfc_ref *lref, gfc_ref *rref, int n)
+{
+  gfc_array_ref l_ar;
+  gfc_array_ref r_ar;
+  gfc_expr *l_start;
+  gfc_expr *r_start;
+  int i;
+
+  l_ar = lref->u.ar;
+  r_ar = rref->u.ar;
+  l_start = l_ar.start[n] ;
+  r_start = r_ar.start[n] ;
+  i = gfc_dep_compare_expr (r_start, l_start);
+  if (i == 0)
+    return GFC_DEP_EQUAL;
+
+  /* Treat two scalar variables as potentially equal.  This allows
+     us to prove that a(i,:) and a(j,:) have no dependency.  See
+     Gerald Roth, "Evaluation of Array Syntax Dependence Analysis",
+     Proceedings of the International Conference on Parallel and
+     Distributed Processing Techniques and Applications (PDPTA2001),
+     Las Vegas, Nevada, June 2001.  */
+  /* However, we need to be careful when either scalar expression
+     contains a FORALL index, as these can potentially change value
+     during the scalarization/traversal of this array reference.  */
+  if (contains_forall_index_p (r_start) || contains_forall_index_p (l_start))
+    return GFC_DEP_OVERLAP;
+
+  if (i > -2)
+    return GFC_DEP_NODEP;
+  return GFC_DEP_EQUAL;
+}
+
+/* Callback function for checking if an expression depends on a
+   dummy variable which is any other than INTENT(IN).  */
+
+static int
+callback_dummy_intent_not_in (gfc_expr **ep,
+			      int *walk_subtrees ATTRIBUTE_UNUSED,
+			      void *data ATTRIBUTE_UNUSED)
+{
+  gfc_expr *e = *ep;
+
+  if (e->expr_type == EXPR_VARIABLE && e->symtree
+      && e->symtree->n.sym->attr.dummy)
+    return e->symtree->n.sym->attr.intent != INTENT_IN;
+  else
+    return 0;
+}
+
+/* Auxiliary function to check if subexpressions have dummy variables which
+   are not intent(in).
+*/
+
+static bool
+dummy_intent_not_in (gfc_expr **ep)
+{
+  return gfc_expr_walker (ep, callback_dummy_intent_not_in, NULL);
+}
+
+/* Determine if an array ref, usually an array section specifies the
+   entire array.  In addition, if the second, pointer argument is
+   provided, the function will return true if the reference is
+   contiguous; eg. (:, 1) gives true but (1,:) gives false. 
+   If one of the bounds depends on a dummy variable which is
+   not INTENT(IN), also return false, because the user may
+   have changed the variable.  */
+
+bool
+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)
+    {
+      if (contiguous)
+	*contiguous = true;
+      return true;
+    }
+
+  if (ref->u.ar.type != AR_SECTION)
+    return false;
+  if (ref->next)
+    return false;
+
+  for (i = 0; i < ref->u.ar.dimen; i++)
+    {
+      /* 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 unconditionally a contiguous reference if all the
+	     remaining dimensions are elements.  */
+	  if (contiguous)
+	    {
+	      *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]
+	      || gfc_dep_compare_expr (ref->u.ar.as->lower[i],
+				       ref->u.ar.as->upper[i])
+	      || !ref->u.ar.start[i]
+	      || gfc_dep_compare_expr (ref->u.ar.start[i],
+				       ref->u.ar.as->lower[i]))
+	    return false;
+	  else
+	    continue;
+	}
+
+      /* Check the lower bound.  */
+      if (ref->u.ar.start[i]
+	  && (!ref->u.ar.as
+	      || !ref->u.ar.as->lower[i]
+	      || gfc_dep_compare_expr (ref->u.ar.start[i],
+				       ref->u.ar.as->lower[i])
+	      || dummy_intent_not_in (&ref->u.ar.start[i])))
+	lbound_OK = false;
+      /* Check the upper bound.  */
+      if (ref->u.ar.end[i]
+	  && (!ref->u.ar.as
+	      || !ref->u.ar.as->upper[i]
+	      || gfc_dep_compare_expr (ref->u.ar.end[i],
+				       ref->u.ar.as->upper[i])
+	      || dummy_intent_not_in (&ref->u.ar.end[i])))
+	ubound_OK = false;
+      /* Check the stride.  */
+      if (ref->u.ar.stride[i]
+	    && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
+	return false;
+
+      /* This is unconditionally a contiguous reference as long as all
+	 the subsequent dimensions are elements.  */
+      if (contiguous)
+	{
+	  *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;
+    }
+  return true;
+}
+
+
+/* Determine if a full array is the same as an array section with one
+   variable limit.  For this to be so, the strides must both be unity
+   and one of either start == lower or end == upper must be true.  */
+
+static bool
+ref_same_as_full_array (gfc_ref *full_ref, gfc_ref *ref)
+{
+  int i;
+  bool upper_or_lower;
+
+  if (full_ref->type != REF_ARRAY)
+    return false;
+  if (full_ref->u.ar.type != AR_FULL)
+    return false;
+  if (ref->type != REF_ARRAY)
+    return false;
+  if (ref->u.ar.type != AR_SECTION)
+    return false;
+
+  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 (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT)
+	{
+	  if (!full_ref->u.ar.as
+	      || !full_ref->u.ar.as->lower[i]
+	      || !full_ref->u.ar.as->upper[i]
+	      || gfc_dep_compare_expr (full_ref->u.ar.as->lower[i],
+				       full_ref->u.ar.as->upper[i])
+	      || !ref->u.ar.start[i]
+	      || gfc_dep_compare_expr (ref->u.ar.start[i],
+				       full_ref->u.ar.as->lower[i]))
+	    return false;
+	}
+
+      /* Check the strides.  */
+      if (full_ref->u.ar.stride[i] && !gfc_expr_is_one (full_ref->u.ar.stride[i], 0))
+	return false;
+      if (ref->u.ar.stride[i] && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
+	return false;
+
+      upper_or_lower = false;
+      /* Check the lower bound.  */
+      if (ref->u.ar.start[i]
+	  && (ref->u.ar.as
+	        && full_ref->u.ar.as->lower[i]
+	        && gfc_dep_compare_expr (ref->u.ar.start[i],
+				         full_ref->u.ar.as->lower[i]) == 0))
+	upper_or_lower =  true;
+      /* Check the upper bound.  */
+      if (ref->u.ar.end[i]
+	  && (ref->u.ar.as
+	        && full_ref->u.ar.as->upper[i]
+	        && gfc_dep_compare_expr (ref->u.ar.end[i],
+				         full_ref->u.ar.as->upper[i]) == 0))
+	upper_or_lower =  true;
+      if (!upper_or_lower)
+	return false;
+    }
+  return true;
+}
+
+
+/* Finds if two array references are overlapping or not.
+   Return value
+   	2 : array references are overlapping but reversal of one or
+	    more dimensions will clear the dependency.
+   	1 : array references are overlapping.
+   	0 : array references are identical or not overlapping.  */
+
+int
+gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
+{
+  int n;
+  int m;
+  gfc_dependency fin_dep;
+  gfc_dependency this_dep;
+
+  this_dep = GFC_DEP_ERROR;
+  fin_dep = GFC_DEP_ERROR;
+  /* Dependencies due to pointers should already have been identified.
+     We only need to check for overlapping array references.  */
+
+  while (lref && rref)
+    {
+      /* We're resolving from the same base symbol, so both refs should be
+	 the same type.  We traverse the reference chain until we find ranges
+	 that are not equal.  */
+      gcc_assert (lref->type == rref->type);
+      switch (lref->type)
+	{
+	case REF_COMPONENT:
+	  /* The two ranges can't overlap if they are from different
+	     components.  */
+	  if (lref->u.c.component != rref->u.c.component)
+	    return 0;
+	  break;
+
+	case REF_SUBSTRING:
+	  /* Substring overlaps are handled by the string assignment code
+	     if there is not an underlying dependency.  */
+	  return (fin_dep == GFC_DEP_OVERLAP) ? 1 : 0;
+
+	case REF_ARRAY:
+
+	  if (ref_same_as_full_array (lref, rref))
+	    return 0;
+
+	  if (ref_same_as_full_array (rref, lref))
+	    return 0;
+
+	  if (lref->u.ar.dimen != rref->u.ar.dimen)
+	    {
+	      if (lref->u.ar.type == AR_FULL)
+		fin_dep = gfc_full_array_ref_p (rref, NULL) ? GFC_DEP_EQUAL
+							    : GFC_DEP_OVERLAP;
+	      else if (rref->u.ar.type == AR_FULL)
+		fin_dep = gfc_full_array_ref_p (lref, NULL) ? GFC_DEP_EQUAL
+							    : GFC_DEP_OVERLAP;
+	      else
+		return 1;
+	      break;
+	    }
+
+	  /* Index for the reverse array.  */
+	  m = -1;
+	  for (n=0; n < lref->u.ar.dimen; n++)
+	    {
+	      /* Handle dependency when either of array reference is vector
+		 subscript. There is no dependency if the vector indices
+		 are equal or if indices are known to be different in a
+		 different dimension.  */
+	      if (lref->u.ar.dimen_type[n] == DIMEN_VECTOR
+		  || rref->u.ar.dimen_type[n] == DIMEN_VECTOR)
+		{
+		  if (lref->u.ar.dimen_type[n] == DIMEN_VECTOR
+		      && rref->u.ar.dimen_type[n] == DIMEN_VECTOR
+		      && gfc_dep_compare_expr (lref->u.ar.start[n],
+					       rref->u.ar.start[n]) == 0)
+		    this_dep = GFC_DEP_EQUAL;
+		  else
+		    this_dep = GFC_DEP_OVERLAP;
+
+		  goto update_fin_dep;
+		}
+
+	      if (lref->u.ar.dimen_type[n] == DIMEN_RANGE
+		  && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
+		this_dep = check_section_vs_section (&lref->u.ar, &rref->u.ar, n);
+	      else if (lref->u.ar.dimen_type[n] == DIMEN_ELEMENT
+		       && rref->u.ar.dimen_type[n] == DIMEN_RANGE)
+		this_dep = gfc_check_element_vs_section (lref, rref, n);
+	      else if (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
+		       && lref->u.ar.dimen_type[n] == DIMEN_RANGE)
+		this_dep = gfc_check_element_vs_section (rref, lref, n);
+	      else
+		{
+		  gcc_assert (rref->u.ar.dimen_type[n] == DIMEN_ELEMENT
+			      && lref->u.ar.dimen_type[n] == DIMEN_ELEMENT);
+		  this_dep = gfc_check_element_vs_element (rref, lref, n);
+		}
+
+	      /* If any dimension doesn't overlap, we have no dependency.  */
+	      if (this_dep == GFC_DEP_NODEP)
+		return 0;
+
+	      /* Now deal with the loop reversal logic:  This only works on
+		 ranges and is activated by setting
+				reverse[n] == GFC_ENABLE_REVERSE
+		 The ability to reverse or not is set by previous conditions
+		 in this dimension.  If reversal is not activated, the
+		 value GFC_DEP_BACKWARD is reset to GFC_DEP_OVERLAP.  */
+
+	      /* Get the indexing right for the scalarizing loop. If this
+		 is an element, there is no corresponding loop.  */
+	      if (lref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
+		m++;
+
+	      if (rref->u.ar.dimen_type[n] == DIMEN_RANGE
+		    && lref->u.ar.dimen_type[n] == DIMEN_RANGE)
+		{
+		  /* Set reverse if backward dependence and not inhibited.  */
+		  if (reverse && reverse[m] == GFC_ENABLE_REVERSE)
+		    reverse[m] = (this_dep == GFC_DEP_BACKWARD) ?
+			         GFC_REVERSE_SET : reverse[m];
+
+		  /* Set forward if forward dependence and not inhibited.  */
+		  if (reverse && reverse[m] == GFC_ENABLE_REVERSE)
+		    reverse[m] = (this_dep == GFC_DEP_FORWARD) ?
+			         GFC_FORWARD_SET : reverse[m];
+
+		  /* Flag up overlap if dependence not compatible with
+		     the overall state of the expression.  */
+		  if (reverse && reverse[m] == GFC_REVERSE_SET
+		        && this_dep == GFC_DEP_FORWARD)
+		    {
+	              reverse[m] = GFC_INHIBIT_REVERSE;
+		      this_dep = GFC_DEP_OVERLAP;
+		    }
+		  else if (reverse && reverse[m] == GFC_FORWARD_SET
+		        && this_dep == GFC_DEP_BACKWARD)
+		    {
+	              reverse[m] = GFC_INHIBIT_REVERSE;
+		      this_dep = GFC_DEP_OVERLAP;
+		    }
+
+		  /* If no intention of reversing or reversing is explicitly
+		     inhibited, convert backward dependence to overlap.  */
+		  if ((reverse == NULL && this_dep == GFC_DEP_BACKWARD)
+		      || (reverse != NULL && reverse[m] == GFC_INHIBIT_REVERSE))
+		    this_dep = GFC_DEP_OVERLAP;
+		}
+
+	      /* Overlap codes are in order of priority.  We only need to
+		 know the worst one.*/
+
+	    update_fin_dep:
+	      if (this_dep > fin_dep)
+		fin_dep = this_dep;
+	    }
+
+	  /* If this is an equal element, we have to keep going until we find
+	     the "real" array reference.  */
+	  if (lref->u.ar.type == AR_ELEMENT
+		&& rref->u.ar.type == AR_ELEMENT
+		&& fin_dep == GFC_DEP_EQUAL)
+	    break;
+
+	  /* Exactly matching and forward overlapping ranges don't cause a
+	     dependency.  */
+	  if (fin_dep < GFC_DEP_BACKWARD)
+	    return 0;
+
+	  /* Keep checking.  We only have a dependency if
+	     subsequent references also overlap.  */
+	  break;
+
+	default:
+	  gcc_unreachable ();
+	}
+      lref = lref->next;
+      rref = rref->next;
+    }
+
+  /* If we haven't seen any array refs then something went wrong.  */
+  gcc_assert (fin_dep != GFC_DEP_ERROR);
+
+  /* Assume the worst if we nest to different depths.  */
+  if (lref || rref)
+    return 1;
+
+  return fin_dep == GFC_DEP_OVERLAP;
+}