2006-02-24 Paul Thomas <pault@gcc.gnu.org>

	PR fortran/24519
	* dependency.c (gfc_is_same_range): Correct typo.
	(gfc_check_section_vs_section): Call gfc_is_same_range.

	PR fortran/25395
	* trans-common.c (add_equivalences): Add a new flag that is set when
	an equivalence is seen that prevents more from being reset until the
	start of a new traversal of the list, thus ensuring completion of
	all the equivalences.

2006-02-24  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/24519
	* gfortran.dg/dependency_3.f90: New test.
	* gfortran.fortran-torture/execute/vect-3.f90: Remove two of the
	XFAILs.

	PR fortran/25395
	* gfortran.dg/equiv_6.f90: New test.

git-svn-id: svn+ssh://gcc.gnu.org/svn/gcc/trunk@111416 138bc75d-0d04-0410-961f-82ee72b054a4

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index d78819f..f000725 100644 (file)
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,15 @@
+2006-02-24  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/24519
+       * dependency.c (gfc_is_same_range): Correct typo.
+       (gfc_check_section_vs_section): Call gfc_is_same_range.
+
+       PR fortran/25395
+       * trans-common.c (add_equivalences): Add a new flag that is set when
+       an equivalence is seen that prevents more from being reset until the
+       start of a new traversal of the list, thus ensuring completion of
+       all the equivalences.
+

 2006-02-23  Erik Edelmann  <eedelman@gcc.gnu.org>
 
        * module.c (read_module): Remove redundant code lines.
 2006-02-23  Erik Edelmann  <eedelman@gcc.gnu.org>
 
        * module.c (read_module): Remove redundant code lines.

diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index 62f3aa6..df6609b 100644 (file)
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -159,7 +159,7 @@ gfc_is_same_range (gfc_array_ref * ar1, gfc_array_ref * ar2, int n, int def)
     e1 = ar1->as->lower[n];
 
   if (ar2->as && !e2)
     e1 = ar1->as->lower[n];
 
   if (ar2->as && !e2)

-    e2 = ar2->as->upper[n];
+    e2 = ar2->as->lower[n];

 
   /* Check we have values for both.  */
   if (!(e1 && e2))
 
   /* Check we have values for both.  */
   if (!(e1 && e2))


@@ -538,15 +538,19 @@ gfc_check_section_vs_section (gfc_ref * lref, gfc_ref * rref, int n)
   gfc_expr *r_start;
   gfc_expr *r_stride;
 
   gfc_expr *r_start;
   gfc_expr *r_stride;
 

-  gfc_array_ref        l_ar;
-  gfc_array_ref        r_ar;
+  gfc_array_ref l_ar;
+  gfc_array_ref r_ar;

 
   mpz_t no_of_elements;
 
   mpz_t no_of_elements;

-  mpz_t        X1, X2;
+  mpz_t X1, X2;

   gfc_dependency dep;
 
   l_ar = lref->u.ar;
   r_ar = rref->u.ar;
   gfc_dependency dep;
 
   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_start = l_ar.start[n];
   l_end = l_ar.end[n];

diff --git a/gcc/fortran/trans-common.c b/gcc/fortran/trans-common.c
index f819b34..5d72a50 100644 (file)
--- a/gcc/fortran/trans-common.c
+++ b/gcc/fortran/trans-common.c
@@ -755,15 +755,20 @@ find_equivalence (segment_info *n)
 }
 
 
 }
 
 

-/* Add all symbols equivalenced within a segment.  We need to scan the
-   segment list multiple times to include indirect equivalences.  */
+  /* Add all symbols equivalenced within a segment.  We need to scan the
+   segment list multiple times to include indirect equivalences.  Since
+   a new segment_info can inserted at the beginning of the segment list,
+   depending on its offset, we have to force a final pass through the
+   loop by demanding that completion sees a pass with no matches; ie.
+   all symbols with equiv_built set and no new equivalences found.  */

 
 static void
 add_equivalences (bool *saw_equiv)
 {
   segment_info *f;
 
 static void
 add_equivalences (bool *saw_equiv)
 {
   segment_info *f;

-  bool more;
+  bool seen_one, more;

 
 

+  seen_one = false;

   more = TRUE;
   while (more)
     {
   more = TRUE;
   while (more)
     {


@@ -773,9 +778,12 @@ add_equivalences (bool *saw_equiv)
          if (!f->sym->equiv_built)
            {
              f->sym->equiv_built = 1;
          if (!f->sym->equiv_built)
            {
              f->sym->equiv_built = 1;

-             more = find_equivalence (f);
-             if (more)
-               *saw_equiv = true;
+             seen_one = find_equivalence (f);
+             if (seen_one)
+               {
+                 *saw_equiv = true;
+                 more = true;
+               }

            }
        }
     }
            }
        }
     }

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index b9efba3..63ce0aa 100644 (file)
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,13 @@
+2006-02-24  Paul Thomas  <pault@gcc.gnu.org>
+
+       PR fortran/24519
+       * gfortran.dg/dependency_3.f90: New test.
+       * gfortran.fortran-torture/execute/vect-3.f90: Remove two of the
+       XFAILs.
+
+       PR fortran/25395
+       * gfortran.dg/equiv_6.f90: New test.
+

 2006-02-23  Jeff Law  <law@redhat.com>
 
        * gcc.c-torture/compile/pr26425.c: New test.
 2006-02-23  Jeff Law  <law@redhat.com>
 
        * gcc.c-torture/compile/pr26425.c: New test.

diff --git a/gcc/testsuite/gfortran.dg/dependency_3.f90 b/gcc/testsuite/gfortran.dg/dependency_3.f90
new file mode 100644 (file)
index 0000000..a9dfe93
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/dependency_3.f90
@@ -0,0 +1,28 @@
+! { 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) > 1e-3) print *, sum (x)
+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

diff --git a/gcc/testsuite/gfortran.dg/equiv_6.f90 b/gcc/testsuite/gfortran.dg/equiv_6.f90
new file mode 100644 (file)
index 0000000..92ba769
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/equiv_6.f90
@@ -0,0 +1,63 @@
+! { dg-do run }
+! This checks the patch for PR25395, in which equivalences within one
+! segment were broken by indirect equivalences, depending on the
+! offset of the variable that bridges the indirect equivalence.
+!
+! This is a fortran95 version of the original testcase, which was
+! contributed by Harald Vogt  <harald.vogt@desy.de>
+program check_6
+  common /abc/ mwkx(80)
+  common /cde/ lischk(20)
+  dimension    listpr(20),lisbit(10),lispat(8)
+! This was badly compiled in the PR:
+  equivalence (listpr(10),lisbit(1),mwkx(10)), &
+              (lispat(1),listpr(10))
+  lischk = (/0, 0, 0, 0, 0, 0, 0, 0, 0, 1, &
+             2, 0, 0, 5, 6, 7, 8, 9,10, 0/)
+  call set_arrays (listpr, lisbit)
+  if (any (listpr.ne.lischk)) call abort ()
+  call sub1
+  call sub2
+  call sub3
+end
+subroutine sub1
+  common /abc/ mwkx(80)
+  common /cde/ lischk(20)
+  dimension    listpr(20),lisbit(10),lispat(8)
+!     This workaround was OK
+  equivalence (listpr(10),lisbit(1)), &
+              (listpr(10),mwkx(10)),  &
+              (listpr(10),lispat(1))
+  call set_arrays (listpr, lisbit)
+  if (any (listpr .ne. lischk)) call abort ()
+end
+!
+! Equivalences not in COMMON
+!___________________________
+! This gave incorrect results for the same reason as in MAIN.
+subroutine sub2
+  dimension   mwkx(80)
+  common /cde/ lischk(20)
+  dimension    listpr(20),lisbit(10),lispat(8)
+  equivalence (lispat(1),listpr(10)), &
+              (mwkx(10),lisbit(1),listpr(10))
+  call set_arrays (listpr, lisbit)
+  if (any (listpr .ne. lischk)) call abort ()
+end
+! This gave correct results because the order in which the
+! equivalences are taken is different and was given in the PR.
+subroutine sub3
+  dimension   mwkx(80)
+  common /cde/ lischk(20)
+  dimension    listpr(20),lisbit(10),lispat(8)
+  equivalence (listpr(10),lisbit(1),mwkx(10)), &
+              (lispat(1),listpr(10))
+  call set_arrays (listpr, lisbit)
+  if (any (listpr .ne. lischk)) call abort ()
+end
+subroutine set_arrays (listpr, lisbit)
+  dimension listpr(20),lisbit(10)
+  listpr = 0
+  lisbit = (/(i, i = 1, 10)/)
+  lisbit((/3,4/)) = 0
+end

diff --git a/gcc/testsuite/gfortran.dg/vect/vect-3.f90 b/gcc/testsuite/gfortran.dg/vect/vect-3.f90
index b899a79..734ed95 100644 (file)
--- a/gcc/testsuite/gfortran.dg/vect/vect-3.f90
+++ b/gcc/testsuite/gfortran.dg/vect/vect-3.f90
@@ -7,7 +7,5 @@ Y = Y + A * X
 END
 
 ! fail to vectorize due to failure to compute number of iterations (PR tree-optimization/18527)
 END
 
 ! fail to vectorize due to failure to compute number of iterations (PR tree-optimization/18527)

-! { dg-final { scan-tree-dump-times "vectorized 1 loops" 1 "vect" { xfail *-*-* } } } 
-! { dg-final { scan-tree-dump-times "Alignment of access forced using peeling" 1 "vect" { xfail *-*-* } } } 

 ! { dg-final { scan-tree-dump-times "Vectorizing an unaligned access" 2 "vect" { xfail *-*-* } } } 
 ! { dg-final { cleanup-tree-dump "vect" } }
 ! { dg-final { scan-tree-dump-times "Vectorizing an unaligned access" 2 "vect" { xfail *-*-* } } } 
 ! { dg-final { cleanup-tree-dump "vect" } }