From ea0a374b2c55421c111b401ba73bd45230599c07 Mon Sep 17 00:00:00 2001 From: Paul Thomas Date: Mon, 6 Apr 2009 20:13:39 +0000 Subject: [PATCH] re PR fortran/38863 (WHERE with multiple elemental defined assignments gives wrong answer) 2009-04-06 Paul Thomas PR fortran/38863 * dependency.c (ref_same_as_full_array): New function. (gfc_dep_resolver): Call it. 2009-04-06 Paul Thomas PR fortran/38863 * gfortran.dg/dependency_23.f90: New test. From-SVN: r145621 --- gcc/fortran/ChangeLog | 6 +++ gcc/fortran/dependency.c | 72 +++++++++++++++++++++++++++++ gcc/testsuite/ChangeLog | 5 ++ gcc/testsuite/gfortran.dg/dependency_23.f90 | 56 ++++++++++++++++++++++ 4 files changed, 139 insertions(+) create mode 100644 gcc/testsuite/gfortran.dg/dependency_23.f90 diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog index 6db6c63..bba5fe5 100644 --- a/gcc/fortran/ChangeLog +++ b/gcc/fortran/ChangeLog @@ -1,3 +1,9 @@ +2009-04-06 Paul Thomas + + PR fortran/38863 + * dependency.c (ref_same_as_full_array): New function. + (gfc_dep_resolver): Call it. + 2009-04-06 Janus Weil PR fortran/39414 diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c index 265cf20..5f74c34 100644 --- a/gcc/fortran/dependency.c +++ b/gcc/fortran/dependency.c @@ -1244,6 +1244,71 @@ gfc_full_array_ref_p (gfc_ref *ref) } +/* 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 1 : array references are overlapping. @@ -1281,6 +1346,13 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref) 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) diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog index ffc5ad2..489ca5b 100644 --- a/gcc/testsuite/ChangeLog +++ b/gcc/testsuite/ChangeLog @@ -1,3 +1,8 @@ +2009-04-06 Paul Thomas + + PR fortran/38863 + * gfortran.dg/dependency_23.f90: New test. + 2009-04-06 Richard Guenther PR tree-optimization/28868 diff --git a/gcc/testsuite/gfortran.dg/dependency_23.f90 b/gcc/testsuite/gfortran.dg/dependency_23.f90 new file mode 100644 index 0000000..bdb1711 --- /dev/null +++ b/gcc/testsuite/gfortran.dg/dependency_23.f90 @@ -0,0 +1,56 @@ +! { dg-do run } +! Test the fix for PR38863, in which an unnecessary temporary +! generated results that are not consistent with other compilers. +! +! Contributed by Dick Hendrickson +! +module rg0045_stuff + type unseq + integer :: i + logical :: l + end type unseq + interface assignment(=) + module procedure l_to_t, i_to_t + end interface +contains + elemental subroutine l_to_t (arg1, arg2) + type(unseq), intent(inout) :: arg1 + logical, intent(in) :: arg2 + arg1%l = arg2 + end subroutine l_to_t + elemental subroutine i_to_t (arg1, arg2) + type(unseq), intent(inout) :: arg1 + integer, intent(in) :: arg2 + arg1%i = arg2 + end subroutine i_to_t + subroutine rg0045(nf1, nf2, nf3) + type(unseq) :: tla2l(nf3, nf2) + type(unseq) :: tda2l(3,2) + logical :: lda(nf3,nf2) + tda2l%l = reshape ([.true.,.false.,.true.,.false.,.true.,.false.],[3,2]) + tda2l%i = reshape ([1, -1, 3, -1, 5, -1],[3,2]) + lda = tda2l%l + tla2l%l = lda + tla2l%i = reshape ([1, 2, 3, 4, 5, 6], [3,2]) +! +! The problem occurred here: gfortran was producing a temporary for these +! assignments because the dependency checking was too restrictive. Since +! a temporary was used, the integer component was reset in the first assignment +! rather than being carried over. +! + where(lda) + tla2l = tla2l(1:3, 1:2)%l + tla2l = tla2l(1:3, 1:2)%i + elsewhere + tla2l = -1 + endwhere + if (any (tla2l%i .ne. tda2l%i)) call abort + if (any (tla2l%l .neqv. tda2l%l)) call abort + end subroutine +end module rg0045_stuff + + use rg0045_stuff + call rg0045(1, 2, 3) +end + + -- 2.7.4