dependency.c (gfc_is_inside_range): Delete.

	* dependency.c (gfc_is_inside_range): Delete.
	(gfc_check_element_vs_section): Significant rewrite.

	* gfortran.dg/dependencency_17.f90: New test case.

From-SVN: r112607

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index c6bed7875ffa5546de11df53e0fdff7a2a4fe3fe..bbcb33cb641d8cdf7a061a2eb8164ef1630d2a2e 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,8 @@
+2006-04-01  Roger Sayle  <roger@eyesopen.com>
+
+       * dependency.c (gfc_is_inside_range): Delete.
+       (gfc_check_element_vs_section): Significant rewrite.
+
 2006-04-01  Roger Sayle  <roger@eyesopen.com>
 
        * dependency.c (gfc_dep_compare_expr): Strip parentheses and unary

diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index c3762bdc4d8b8de0094d4f6a4b403fc82ec5fa3a..f664ec0d0f89aa7b63284058dac292ceefdf30fe 100644 (file)
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -858,70 +858,125 @@ gfc_check_section_vs_section (gfc_ref * lref, gfc_ref * rref, int n)
 }
 
 
-/* Checks if the expr chk is inside the range left-right.
-   Returns  GFC_DEP_NODEP if chk is outside the range,
-   GFC_DEP_OVERLAP otherwise.
-   Assumes left<=right.  */
+/* Determines overlapping for a single element and a section.  */
 
 static gfc_dependency
-gfc_is_inside_range (gfc_expr * chk, gfc_expr * left, gfc_expr * right)
+gfc_check_element_vs_section( gfc_ref * lref, gfc_ref * rref, int n)
 {
-  int l;
-  int r;
+  gfc_array_ref *ref;
+  gfc_expr *elem;
+  gfc_expr *start;
+  gfc_expr *end;
+  gfc_expr *stride;
   int s;
 
-  s = gfc_dep_compare_expr (left, right);
-  if (s == -2)
+  elem = lref->u.ar.start[n];
+  if (!elem)
     return GFC_DEP_OVERLAP;
 
-  l = gfc_dep_compare_expr (chk, left);
-  r = gfc_dep_compare_expr (chk, right);
+  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;
 
-  /* Check for indeterminate relationships.  */
-  if (l == -2 || r == -2 || s == -2)
+  /* Stride should never be zero.  */
+  if (s == 0)
     return GFC_DEP_OVERLAP;
 
+  /* Positive strides.  */
   if (s == 1)
     {
-      /* When left>right we want to check for right <= chk <= left.  */
-      if (l <= 0 || r >= 0)
-       return GFC_DEP_OVERLAP;
+      /* 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
     {
-      /* Otherwise check for left <= chk <= right.  */
-      if (l >= 0 || r <= 0)
+      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_NODEP;
-}
 
-
-/* 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 l_ar;
-  gfc_array_ref r_ar;
-  gfc_expr *l_start;
-  gfc_expr *r_start;
-  gfc_expr *r_end;
-
-  l_ar = lref->u.ar;
-  r_ar = rref->u.ar;
-  l_start = l_ar.start[n] ;
-  r_start = r_ar.start[n] ;
-  r_end = r_ar.end[n] ;
-  if (NULL == r_start && IS_ARRAY_EXPLICIT (r_ar.as))
-    r_start = r_ar.as->lower[n];
-  if (NULL == r_end && IS_ARRAY_EXPLICIT (r_ar.as))
-    r_end = r_ar.as->upper[n];
-  if (NULL == r_start || NULL == r_end || l_start == NULL)
-    return GFC_DEP_OVERLAP;
-
-  return gfc_is_inside_range (l_start, r_end, r_start);
+  return GFC_DEP_OVERLAP;
 }
 
 

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 6901373486866b79331675df2edcf3f1fe040df6..4c77dcb753c16012d5eb61febc019991afc94bf9 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,7 @@
+2006-04-01  Roger Sayle  <roger@eyesopen.com>
+
+       * gfortran.dg/dependencency_17.f90: New test case.
+
 2006-04-01  Roger Sayle  <roger@eyesopen.com>
 
        * gfortran.dg/dependency_14.f90: New test case.

diff --git a/gcc/testsuite/gfortran.dg/dependency_17.f90 b/gcc/testsuite/gfortran.dg/dependency_17.f90
new file mode 100644 (file)
index 0000000..06d1508
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_17.f90
@@ -0,0 +1,12 @@
+! { dg-do compile }
+! { dg-options "-O2 -fdump-tree-original" }
+subroutine foo(a,i)
+  integer, dimension (3,3,4) :: a
+  integer :: i
+
+  where (a(1,1:2,1:3) .ne. 0)
+    a(2:3,3,2:4) = 1
+  endwhere
+end subroutine
+! { dg-final { scan-tree-dump-times "malloc" 0 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }