This is the mail archive of the
fortran@gcc.gnu.org
mailing list for the GNU Fortran project.
[Patch, fortran] PR20938, PR24519 and where_19 - equivalence dependencies
- From: Paul Thomas <paulthomas2 at wanadoo dot fr>
- To: "'fortran at gcc dot gnu dot org'" <fortran at gcc dot gnu dot org>, patch <gcc-patches at gcc dot gnu dot org>
- Cc: Roger Sayle <roger at eyesopen dot com>, Brooks Moses <bmoses at stanford dot edu>
- Date: Sun, 19 Feb 2006 08:33:59 +0100
- Subject: [Patch, fortran] PR20938, PR24519 and where_19 - equivalence dependencies
:ADDPATCH fortran:
This patch fixes a problem that surfaced in the reviewing of Roger
Sayle's second round of patches for where. Dependencies involving
equivalenced arrays just were not being detected. This is also PR20938.
The fix involves a new function that detects a direct or an indirect
equivalence between two arrays. This is now called from
gfc_check_dependency and gfc_conv_resolve_dependencies so that
assignments and WHERE mask to destination dependencies are detected.
I propose to commit Brooks' contributions where_17.f90, where_18.f90 and
a corrected where_19.f90. A further test, where_20.f90 exercises the
dependency checking for where statements and blocks. PR20938 is checked
with dependency_2.f90.
Whilst working in dependency.c, I was reminded of a typo that I had seen
a long time ago in gfc_is_same_range and this permits a one line fix of
PR24519. An offshoot of this is that one of the XFAILs in vect-3.f90
can be removed. More sophisticated dependency checking, of simple
expressions for example, will have to wait. Similarly, the one
pre-existing reference to gfc_is_same_range is a section of deactivated
code to do loop shifting; this will also have to wait because there is
something awry with it. I will raise a PR on these issues, when
committing this patch.
I have added a test, dependency_3.f90, for PR24519 but this only checks
that the right arithmetical result is obtained; that it is speeded up is
not tested at all.
Regtested on FC3/Athlon. OK for trunk and, when it reopens, 4.1?
Paul
2005-02-19 Paul Thomas <pault@gcc.gnu.org>
PR fortran/20938
* dependency.c (gfc_are_equivalenced_arrays): New function.
(gfc_check_dependency): Call it.
* dependency.h: Prototype for gfc_are_equivalenced_arrays.
* trans-array.c (gfc_conv_resolve_dependencies): Call it.
PR fortran/24519
* dependency.c (gfc_is_same_range): Correct typo.
(gfc_check_section_vs_section): Call gfc_is_same_range.
2005-02-19 Paul Thomas <pault@gcc.gnu.org>
PR fortran/20938
* gfortran.dg/dependency_2.f90: New test.
* gfortran.fortran-torture/execute/where_17.f90: New test.
* gfortran.fortran-torture/execute/where_18.f90: New test.
* gfortran.fortran-torture/execute/where_19.f90: New test.
* gfortran.fortran-torture/execute/where_20.f90: New test.
PR fortran/24519
* gfortran.dg/dependency_3.f90: New test.
Index: gcc/fortran/dependency.c
===================================================================
*** gcc/fortran/dependency.c (revision 111175)
--- gcc/fortran/dependency.c (working copy)
*************** gfc_is_same_range (gfc_array_ref * ar1,
*** 159,165 ****
e1 = ar1->as->lower[n];
if (ar2->as && !e2)
! e2 = ar2->as->upper[n];
/* Check we have values for both. */
if (!(e1 && e2))
--- 159,165 ----
e1 = ar1->as->lower[n];
if (ar2->as && !e2)
! e2 = ar2->as->lower[n];
/* Check we have values for both. */
if (!(e1 && e2))
*************** gfc_check_fncall_dependency (gfc_expr *
*** 337,342 ****
--- 337,405 ----
}
+ /* Return 1 if expr1 and expr2 are equivalenced arrays, either
+ directly or indirectly; ie. equivalence (a,b) for a and b
+ or equivalence (a,c),(b,c). */
+
+ int
+ gfc_are_equivalenced_arrays (gfc_expr *expr1, gfc_expr *expr2)
+ {
+ gfc_equiv *e1, *e2, *e3, *e4;
+ int flag1, flag2;
+
+ gcc_assert (expr1->expr_type == EXPR_VARIABLE
+ && expr2->expr_type == EXPR_VARIABLE);
+
+ if (expr1->symtree->n.sym->attr.in_equivalence
+ && expr2->symtree->n.sym->attr.in_equivalence
+ && expr1->rank
+ && expr2->rank)
+ {
+ e3 = NULL;
+ e4 = NULL;
+ /* Go through the equivalence groups and return 1 if these
+ variables are members of the same group. */
+ for (e1 = gfc_current_ns->equiv; e1; e1 = e1->next)
+ {
+ flag1 = 0;
+ flag2 = 0;
+ for (e2 = e1; e2; e2 = e2->eq)
+ {
+ if (e2->expr->symtree->n.sym == expr1->symtree->n.sym)
+ flag1 = 1;
+ if (e2->expr->symtree->n.sym == expr2->symtree->n.sym)
+ flag2 = 1;
+ if (flag1 && flag2)
+ return 1;
+ }
+
+ /* If we have not found an equivalence by frontal attack,
+ gather together all the symbols that are equivalent to
+ each expression and look for a shared symbol. */
+ if (!flag1 && !flag2)
+ continue;
+ else if (flag1)
+ {
+ e2 = e3;
+ e3 = e1;
+ }
+ else
+ {
+ e2 = e4;
+ e4 = e1;
+ }
+ }
+
+ /* Return 1 if the lists have a shared symbol. */
+ for (e1 = e3; e1; e1 = e1->eq)
+ for (e2 = e4; e2; e2 = e2->eq)
+ if (e1->expr->symtree->n.sym == e2->expr->symtree->n.sym)
+ return 1;
+ }
+
+ return 0;
+ }
+
/* 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
*************** gfc_check_dependency (gfc_expr * expr1,
*** 383,388 ****
--- 446,455 ----
return 1;
}
+ /* Return 1 if expr1 and expr2 are equivalenced arrays. */
+ if (gfc_are_equivalenced_arrays (expr1, expr2))
+ return 1;
+
if (expr1->symtree->n.sym != expr2->symtree->n.sym)
return 0;
*************** gfc_check_section_vs_section (gfc_ref *
*** 538,545 ****
gfc_expr *r_start;
gfc_expr *r_stride;
! gfc_array_ref l_ar;
! gfc_array_ref r_ar;
mpz_t no_of_elements;
mpz_t X1, X2;
--- 605,612 ----
gfc_expr *r_start;
gfc_expr *r_stride;
! gfc_array_ref l_ar;
! gfc_array_ref r_ar;
mpz_t no_of_elements;
mpz_t X1, X2;
*************** gfc_check_section_vs_section (gfc_ref *
*** 548,553 ****
--- 615,624 ----
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))
+ return GFC_DEP_EQUAL;
+
l_start = l_ar.start[n];
l_end = l_ar.end[n];
l_stride = l_ar.stride[n];
Index: gcc/fortran/dependency.h
===================================================================
*** gcc/fortran/dependency.h (revision 111175)
--- gcc/fortran/dependency.h (working copy)
*************** int gfc_is_same_range (gfc_array_ref *,
*** 30,32 ****
--- 30,33 ----
int gfc_expr_is_one (gfc_expr *, int);
int gfc_dep_resolver(gfc_ref *, gfc_ref *);
+ int gfc_are_equivalenced_arrays (gfc_expr *, gfc_expr *);
Index: gcc/fortran/trans-array.c
===================================================================
*** gcc/fortran/trans-array.c (revision 111175)
--- gcc/fortran/trans-array.c (working copy)
*************** gfc_conv_resolve_dependencies (gfc_loopi
*** 2581,2587 ****
if (ss->type != GFC_SS_SECTION)
continue;
! if (gfc_could_be_alias (dest, ss))
{
nDepend = 1;
break;
--- 2581,2588 ----
if (ss->type != GFC_SS_SECTION)
continue;
! if (gfc_could_be_alias (dest, ss)
! || gfc_are_equivalenced_arrays (dest->expr, ss->expr))
{
nDepend = 1;
break;
! { dg-do run }
! Tests the fix for PR20938 in which dependencies between equivalenced
! arrays were not detected.
!
real, dimension (3) :: a = (/1., 2., 3./), b, c
equivalence (a(2), b), (a(1), c)
b = a;
if (any(b .ne. (/1., 2., 3./))) call abort ()
b = c
if (any(b .ne. (/1., 1., 2./))) call abort ()
end
! { dg-do run }
! Tests the fix for PR24519, in which assignments with the same
! range of an assumed shape array, on the lhs and rhs, would be
! treated as causing a dependency.
!
! Contributed by Paul.Thomas <pault@gcc.gnu.org>
!
integer, parameter :: n = 100
real :: x(n, n), v
x = 1
v = 0.1
call foo (x, v)
if (abs(sum (x) - 91.10847) > 2e-5) call abort ()
contains
subroutine foo (b, d)
real :: b(:, :)
real :: temp(n), c, d
integer :: j, k
do k = 1, n
temp = b(:,k)
do j = 1, n
c = b(k,j)*d
b(:,j) = b(:,j)-temp*c ! This was the offending assignment.
b(k,j) = c
end do
end do
end subroutine foo
end
! Test the dependency checking in simple where. This
! did not work and was fixed as part of the patch for
! pr24519.
!
program where_20
integer :: a(4)
integer :: b(3)
integer :: c(3)
integer :: d(3) = (/1, 2, 3/)
equivalence (a(1), b(1)), (a(2), c(1))
! This classic case worked before the patch.
a = (/1, 2, 3, 4/)
where (b .gt. 1) a(2:4) = a(1:3)
if (any(a .ne. (/1,2,2,3/))) call abort ()
! This is the original manifestation of the problem
! and is repeated in where_19.f90.
a = (/1, 2, 3, 4/)
where (b .gt. 1)
c = b
endwhere
if (any(a .ne. (/1,2,2,3/))) call abort ()
! Mask to.destination dependency.
a = (/1, 2, 3, 4/)
where (b .gt. 1)
c = d
endwhere
if (any(a .ne. (/1,2,2,3/))) call abort ()
! Source to.destination dependency.
a = (/1, 2, 3, 4/)
where (d .gt. 1)
c = b
endwhere
if (any(a .ne. (/1,2,2,3/))) call abort ()
! Check the simple where.
a = (/1, 2, 3, 4/)
where (b .gt. 1) c = b
if (any(a .ne. (/1,2,2,3/))) call abort ()
! This was OK before the patch.
a = (/1, 2, 3, 4/)
where (b .gt. 1)
where (d .gt. 1)
c = b
end where
endwhere
if (any(a .ne. (/1,2,2,3/))) call abort ()
end program
! Check to ensure only the first true clause in WHERE is
! executed.
program where_17
integer :: a(3)
a = (/1, 2, 3/)
where (a .eq. 1)
a = 2
elsewhere (a .le. 2)
a = 3
elsewhere (a .le. 3)
a = 4
endwhere
if (any (a .ne. (/2, 3, 4/))) call abort
end program
! Check to ensure mask is calculated first in WHERE
! statements.
program where_18
integer :: a(4)
integer :: b(3)
integer :: c(3)
equivalence (a(1), b(1)), (a(2), c(1))
a = (/1, 1, 1, 1/)
where (b .eq. 1)
c = 2
elsewhere (b .eq. 2)
c = 3
endwhere
if (any (a .ne. (/1, 2, 2, 2/))) &
call abort
a = (/1, 1, 1, 1/)
where (c .eq. 1)
b = 2
elsewhere (b .eq. 2)
b = 3
endwhere
if (any (a .ne. (/2, 2, 2, 1/))) &
call abort
end program
! Check to ensure result is calculated from unmodified
! version of the right-hand-side in WHERE statements.
program where_19
integer :: a(4)
integer :: b(3)
integer :: c(3)
equivalence (a(1), b(1)), (a(2), c(1))
a = (/1, 2, 3, 4/)
where (b .gt. 1)
c = b
endwhere
if (any (a .ne. (/1, 2, 2, 3/))) &
call abort ()
a = (/1, 2, 3, 4/)
where (c .gt. 1)
b = c
endwhere
if (any (a .ne. (/2, 3, 4, 4/))) &
call abort ()
end program