re PR fortran/61780 (Wrong code when shifting elements of a multidimensional array)

2014-07-12  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/61780
	* dependency.c (gfc_dep_resolver): Index the 'reverse' array so
	that elements are skipped. This then correctly aligns 'reverse'
	with the scalarizer loops.

2014-07-12  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/61780
	* gfortran.dg/dependency_44.f90 : New test

From-SVN: r212486
This commit is contained in:
Paul Thomas 2014-07-12 19:09:11 +00:00
parent fae3018dcd
commit f8ec056116
4 changed files with 100 additions and 43 deletions

View File

@ -1,3 +1,10 @@
2014-07-12 Paul Thomas <pault@gcc.gnu.org>
PR fortran/61780
* dependency.c (gfc_dep_resolver): Index the 'reverse' array so
that elements are skipped. This then correctly aligns 'reverse'
with the scalarizer loops.
2014-07-12 Tobias Burnus <burnus@net-b.de>
PR fortran/61628

View File

@ -2023,6 +2023,7 @@ int
gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
{
int n;
int m;
gfc_dependency fin_dep;
gfc_dependency this_dep;
@ -2072,6 +2073,8 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
break;
}
/* Index for the reverse array. */
m = -1;
for (n=0; n < lref->u.ar.dimen; n++)
{
/* Handle dependency when either of array reference is vector
@ -2118,38 +2121,44 @@ gfc_dep_resolver (gfc_ref *lref, gfc_ref *rref, gfc_reverse *reverse)
The ability to reverse or not is set by previous conditions
in this dimension. If reversal is not activated, the
value GFC_DEP_BACKWARD is reset to GFC_DEP_OVERLAP. */
/* Get the indexing right for the scalarizing loop. If this
is an element, there is no corresponding loop. */
if (lref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
m++;
if (rref->u.ar.dimen_type[n] == DIMEN_RANGE
&& lref->u.ar.dimen_type[n] == DIMEN_RANGE)
{
/* Set reverse if backward dependence and not inhibited. */
if (reverse && reverse[n] == GFC_ENABLE_REVERSE)
reverse[n] = (this_dep == GFC_DEP_BACKWARD) ?
GFC_REVERSE_SET : reverse[n];
if (reverse && reverse[m] == GFC_ENABLE_REVERSE)
reverse[m] = (this_dep == GFC_DEP_BACKWARD) ?
GFC_REVERSE_SET : reverse[m];
/* Set forward if forward dependence and not inhibited. */
if (reverse && reverse[n] == GFC_ENABLE_REVERSE)
reverse[n] = (this_dep == GFC_DEP_FORWARD) ?
GFC_FORWARD_SET : reverse[n];
if (reverse && reverse[m] == GFC_ENABLE_REVERSE)
reverse[m] = (this_dep == GFC_DEP_FORWARD) ?
GFC_FORWARD_SET : reverse[m];
/* Flag up overlap if dependence not compatible with
the overall state of the expression. */
if (reverse && reverse[n] == GFC_REVERSE_SET
if (reverse && reverse[m] == GFC_REVERSE_SET
&& this_dep == GFC_DEP_FORWARD)
{
reverse[n] = GFC_INHIBIT_REVERSE;
reverse[m] = GFC_INHIBIT_REVERSE;
this_dep = GFC_DEP_OVERLAP;
}
else if (reverse && reverse[n] == GFC_FORWARD_SET
else if (reverse && reverse[m] == GFC_FORWARD_SET
&& this_dep == GFC_DEP_BACKWARD)
{
reverse[n] = GFC_INHIBIT_REVERSE;
reverse[m] = GFC_INHIBIT_REVERSE;
this_dep = GFC_DEP_OVERLAP;
}
/* If no intention of reversing or reversing is explicitly
inhibited, convert backward dependence to overlap. */
if ((reverse == NULL && this_dep == GFC_DEP_BACKWARD)
|| (reverse != NULL && reverse[n] == GFC_INHIBIT_REVERSE))
|| (reverse != NULL && reverse[m] == GFC_INHIBIT_REVERSE))
this_dep = GFC_DEP_OVERLAP;
}

View File

@ -1,3 +1,8 @@
2014-07-12 Paul Thomas <pault@gcc.gnu.org>
PR fortran/61780
* gfortran.dg/dependency_44.f90 : New test
2014-07-12 Tobias Burnus <burnus@net-b.de>
* gfortran.dg/coarray_atomic_1.f90: Update dg-error.

View File

@ -0,0 +1,36 @@
! { dg-do run }
! Tests fix for PR61780 in which the loop reversal mechanism was
! not accounting for the first index being an element so that no
! loop in this dimension is created.
!
! Contributed by Manfred Tietze on clf.
!
program prgm3
implicit none
integer, parameter :: n = 10, k = 3
integer :: i, j
integer, dimension(n,n) :: y
integer :: res1(n), res2(n)
1 format(10i5)
!initialize
do i=1,n
do j=1,n
y(i,j) = n*i + j
end do
end do
res2 = y(k,:)
!shift right
y(k,4:n) = y(k,3:n-1)
y(k,3) = 0
res1 = y(k,:)
y(k,:) = res2
y(k,n:4:-1) = y(k,n-1:3:-1)
y(k,3) = 0
res2 = y(k,:)
! print *, res1
! print *, res2
if (any(res1 /= res2)) call abort ()
end program prgm3