From 9ccab91c6fb6b96c77e1aafd5ef240b965c897b2 Mon Sep 17 00:00:00 2001 From: Roger Sayle Date: Sat, 1 Apr 2006 19:16:01 +0000 Subject: [PATCH] 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 --- gcc/fortran/ChangeLog | 5 + gcc/fortran/dependency.c | 147 ++++++++++++++------ gcc/testsuite/ChangeLog | 4 + gcc/testsuite/gfortran.dg/dependency_17.f90 | 12 ++ 4 files changed, 122 insertions(+), 46 deletions(-) create mode 100644 gcc/testsuite/gfortran.dg/dependency_17.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index c6bed7875ffa..bbcb33cb641d 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,8 @@ +2006-04-01 Roger Sayle + + * dependency.c (gfc_is_inside_range): Delete. + (gfc_check_element_vs_section): Significant rewrite. + 2006-04-01 Roger Sayle * dependency.c (gfc_dep_compare_expr): Strip parentheses and unary diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c index c3762bdc4d8b..f664ec0d0f89 100644 --- 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 690137348686..4c77dcb753c1 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,7 @@ +2006-04-01 Roger Sayle + + * gfortran.dg/dependencency_17.f90: New test case. + 2006-04-01 Roger Sayle * 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 index 000000000000..06d15082c78a --- /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" } } -- 2.43.5