diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index a00ac81ee52..db64bff0596 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,17 @@ +2010-08-02 Thomas Koenig + + PR fortran/36854 + * dependency.h: Add prototype for gfc_are_identical_variables. + * frontend-passes.c: Include depencency.h. + (optimimize_equality): Use gfc_are_identical_variables. + * dependency.c (identical_array_ref): New function. + (gfc_are_identical_variables): New function. + (gfc_deb_compare_expr): Use gfc_are_identical_variables. + * dependency.c (gfc_check_section_vs_section). Rename gfc_ + prefix from statc function. + (check_section_vs_section): Change arguments to gfc_array_ref, + adjust function body accordingly. + 2010-08-02 Mikael Morin Janus Weil diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c index 9dd4d9c4672..b20b627b3f7 100644 --- a/gcc/fortran/dependency.c +++ b/gcc/fortran/dependency.c @@ -49,6 +49,10 @@ gfc_dependency; /* 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. */ @@ -67,6 +71,105 @@ gfc_expr_is_one (gfc_expr *expr, int 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) + { + gcc_assert (a1->dimen == a2->dimen); + 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. */ + +bool +gfc_are_identical_variables (gfc_expr *e1, gfc_expr *e2) +{ + gfc_ref *r1, *r2; + + if (e1->symtree->n.sym != e2->symtree->n.sym) + 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 + || gfc_dep_compare_expr (r1->u.ss.end, r2->u.ss.end) != 0) + return false; + break; + + default: + gfc_internal_error ("gfc_are_identical_variables: Bad type"); + } + r1 = r1->next; + r2 = r2->next; + } + return true; +} /* Compare two values. Returns 0 if e1 == e2, -1 if e1 < e2, +1 if e1 > e2, and -2 if the relationship could not be determined. */ @@ -191,11 +294,10 @@ gfc_dep_compare_expr (gfc_expr *e1, gfc_expr *e2) return 1; case EXPR_VARIABLE: - if (e1->ref || e2->ref) - return -2; - if (e1->symtree->n.sym == e2->symtree->n.sym) + if (gfc_are_identical_variables (e1, e2)) return 0; - return -2; + else + return -2; case EXPR_OP: /* Intrinsic operators are the same if their operands are the same. */ @@ -882,9 +984,8 @@ gfc_check_dependency (gfc_expr *expr1, gfc_expr *expr2, bool identical) /* Determines overlapping for two array sections. */ static gfc_dependency -gfc_check_section_vs_section (gfc_ref *lref, gfc_ref *rref, int n) +check_section_vs_section (gfc_array_ref *l_ar, gfc_array_ref *r_ar, int n) { - gfc_array_ref l_ar; gfc_expr *l_start; gfc_expr *l_end; gfc_expr *l_stride; @@ -892,7 +993,6 @@ gfc_check_section_vs_section (gfc_ref *lref, gfc_ref *rref, int n) gfc_expr *l_upper; int l_dir; - gfc_array_ref r_ar; gfc_expr *r_start; gfc_expr *r_end; gfc_expr *r_stride; @@ -900,34 +1000,31 @@ gfc_check_section_vs_section (gfc_ref *lref, gfc_ref *rref, int n) gfc_expr *r_upper; int r_dir; - l_ar = lref->u.ar; - r_ar = rref->u.ar; - /* If they are the same range, return without more ado. */ - if (gfc_is_same_range (&l_ar, &r_ar, n, 0)) + if (gfc_is_same_range (l_ar, r_ar, n, 0)) return GFC_DEP_EQUAL; - l_start = l_ar.start[n]; - l_end = l_ar.end[n]; - l_stride = l_ar.stride[n]; + 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]; + 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 (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 (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 (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]; + 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) @@ -1574,7 +1671,7 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse) if (lref->u.ar.dimen_type[n] == DIMEN_RANGE && rref->u.ar.dimen_type[n] == DIMEN_RANGE) - this_dep = gfc_check_section_vs_section (lref, rref, n); + 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); diff --git a/gcc/fortran/dependency.h b/gcc/fortran/dependency.h index bac2749093b..c2f7229390c 100644 --- a/gcc/fortran/dependency.h +++ b/gcc/fortran/dependency.h @@ -43,3 +43,5 @@ int gfc_expr_is_one (gfc_expr *, int); int gfc_dep_resolver(gfc_ref *, gfc_ref *, gfc_reverse *); int gfc_are_equivalenced_arrays (gfc_expr *, gfc_expr *); +bool gfc_are_identical_variables (gfc_expr *, gfc_expr *); + diff --git a/gcc/fortran/frontend-passes.c b/gcc/fortran/frontend-passes.c index 83251cc9e69..ce3ee9a2720 100644 --- a/gcc/fortran/frontend-passes.c +++ b/gcc/fortran/frontend-passes.c @@ -23,6 +23,7 @@ along with GCC; see the file COPYING3. If not see #include "gfortran.h" #include "arith.h" #include "flags.h" +#include "dependency.h" /* Forward declarations. */ @@ -398,14 +399,13 @@ optimize_equality (gfc_expr *e, bool equal) return true; } - /* Check for direct comparison between identical variables. - TODO: Handle cases with identical refs. */ + /* Check for direct comparison between identical variables. Don't compare + REAL or COMPLEX because of NaN checks. */ if (op1->expr_type == EXPR_VARIABLE && op2->expr_type == EXPR_VARIABLE - && op1->symtree == op2->symtree - && op1->ref == NULL && op2->ref == NULL && op1->ts.type != BT_REAL && op2->ts.type != BT_REAL - && op1->ts.type != BT_COMPLEX && op2->ts.type !=BT_COMPLEX) + && op1->ts.type != BT_COMPLEX && op2->ts.type !=BT_COMPLEX + && gfc_are_identical_variables (op1, op2)) { /* Replace the expression by a constant expression. The typespec and where remains the way it is. */ diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index 136a73961ee..1687f03d369 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,17 @@ +2010-08-02 Thomas Koenig + + PR fortran/36854 + * dependency.h: Add prototype for gfc_are_identical_variables. + * frontend-passes.c: Include depencency.h. + (optimimize_equality): Use gfc_are_identical_variables. + * dependency.c (identical_array_ref): New function. + (gfc_are_identical_variables): New function. + (gfc_deb_compare_expr): Use gfc_are_identical_variables. + * dependency.c (gfc_check_section_vs_section). Rename gfc_ + prefix from statc function. + (check_section_vs_section): Change arguments to gfc_array_ref, + adjust function body accordingly. + 2010-08-02 Bernd Schmidt PR target/40457 diff --git a/gcc/testsuite/gfortran.dg/character_comparison_2.f90 b/gcc/testsuite/gfortran.dg/character_comparison_2.f90 new file mode 100644 index 00000000000..d2736f874a6 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/character_comparison_2.f90 @@ -0,0 +1,40 @@ +! { dg-do run } +! { dg-options "-O -fdump-tree-original" } +program main + implicit none + character(len=4) :: c + integer :: n + integer :: i + integer :: k1, k2 + common /foo/ i + + n = 0 + i = 0 + k1 = 1 + k2 = 3 + c = 'abcd' + n = n + 1 ; if (c(1:2) == c(1:2)) call yes + n = n + 1 ; if (c(k1:k2) >= c(k1:k2)) call yes + n = n + 1 ; if (c(:2) <= c(1:2)) call yes + n = n + 1 ; if (c(k2:) .eq. c(k2:4)) call yes + n = n + 1 ; if (c(:) .ge. c) call yes + n = n + 1 ; if (c .le. c) call yes + if (c(1:2) /= c(1:2)) call abort + if (c(k1:k2) > c(k1:k2)) call abort + if (c(:2) < c(1:2)) call abort + if (c(:) .ne. c) call abort + if (c(:2) .gt. c(1:2)) call abort + if (c(1:2) .lt. c(:2)) call abort + if (n /= i) call abort +end program main + +subroutine yes + implicit none + common /foo/ i + integer :: i + i = i + 1 +end subroutine yes + +! { dg-final { scan-tree-dump-times "gfortran_compare_string" 0 "original" } } +! { dg-final { cleanup-tree-dump "original" } } + diff --git a/gcc/testsuite/gfortran.dg/character_comparison_3.f90 b/gcc/testsuite/gfortran.dg/character_comparison_3.f90 new file mode 100644 index 00000000000..dbcdbefb20a --- /dev/null +++ b/gcc/testsuite/gfortran.dg/character_comparison_3.f90 @@ -0,0 +1,30 @@ +! { dg-do run } +! { dg-options "-fdump-tree-original" } +program main + implicit none + character(len=4) :: c + integer :: i + integer :: k1, k2, k3, k4, k11, k22, k33, k44 + + k1 = 1 + k2 = 2 + k3 = 3 + k4 = 4 + k11 = 1 + k22 = 2 + k33 = 3 + k44 = 4 + c = 'abcd' + if (c(2:) /= c(k2:k4)) call abort + if (c(k2:k4) /= c(k22:)) call abort + if (c(2:3) == c(1:2)) call abort + if (c(1:2) == c(2:3)) call abort + if (c(k1:) == c(k2:)) call abort + if (c(:3) == c(:k4)) call abort + if (c(:k4) == c(:3)) call abort + if (c(:k3) == c(:k44)) call abort +end program main + +! { dg-final { scan-tree-dump-times "gfortran_compare_string" 8 "original" } } +! { dg-final { cleanup-tree-dump "original" } } + diff --git a/gcc/testsuite/gfortran.dg/dependency_28.f90 b/gcc/testsuite/gfortran.dg/dependency_28.f90 new file mode 100644 index 00000000000..5d70abe395e --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dependency_28.f90 @@ -0,0 +1,21 @@ +! { dg-do compile } +! { dg-options "-Warray-temporaries" } +module foobar + type baz + integer :: i + integer :: j + integer :: k + integer :: m + end type baz +contains + subroutine foo(a,b,c,i) + real, dimension(10) :: a,b + type(baz) :: c + integer, dimension(10) :: i + a(i(1):i(2)) = a(i(1):i(2)) + b(i(1):i(2)) + a(i(1):i(2)) = a(i(3):i(5)) ! { dg-warning "Creating array temporary" } + a(c%i:c%j) = a(c%i:c%j) + b(c%k:c%m) + a(c%k:c%m) = a(c%i:c%j) + b(c%k:c%m) ! { dg-warning "Creating array temporary" } + end subroutine foo +end module foobar +! { dg-final { cleanup-modules "foobar" } }