re PR fortran/43072 (unneeded temporary (s=s+f(a)))

2010-02-22  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/43072
	* dependency.c (gfc_full_array_ref_p): Check for contiguous by
	checking the rest of the dimensions for elements.

2010-02-22  Paul Thomas  <pault@gcc.gnu.org>

	PR fortran/43072
	* gfortran.dg/internal_pack_6.f90: Number of 'packs' now zero.
	* gfortran.dg/internal_pack_9.f90: New test.

From-SVN: r156949

5 files changed, 83 insertions, 11 deletions

diff --git a/gcc/fortran/ChangeLog b/gcc/fortran/ChangeLog
index fec057f..dc650fe 100644
--- a/gcc/fortran/ChangeLog
+++ b/gcc/fortran/ChangeLog
@@ -1,3 +1,9 @@
+2010-02-22  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/43072
+	* dependency.c (gfc_full_array_ref_p): Check for contiguous by
+	checking the rest of the dimensions for elements.
+
 2010-02-21  Tobias Burnus  <burnus@net-b.de>
 
 	PR fortran/35259
diff --git a/gcc/fortran/dependency.c b/gcc/fortran/dependency.c
index 1f3d0ed..524451c 100644
--- a/gcc/fortran/dependency.c
+++ b/gcc/fortran/dependency.c
@@ -1272,6 +1272,7 @@ bool
 gfc_full_array_ref_p (gfc_ref *ref, bool *contiguous)
 {
   int i;
+  int n;
   bool lbound_OK = true;
   bool ubound_OK = true;
 
@@ -1280,12 +1281,14 @@ gfc_full_array_ref_p (gfc_ref *ref, bool *contiguous)
 
   if (ref->type != REF_ARRAY)
     return false;
+
   if (ref->u.ar.type == AR_FULL)
     {
       if (contiguous)
 	*contiguous = true;
       return true;
     }
+
   if (ref->u.ar.type != AR_SECTION)
     return false;
   if (ref->next)
@@ -1293,14 +1296,21 @@ gfc_full_array_ref_p (gfc_ref *ref, bool *contiguous)
 
   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 we have a single element in the reference, for the reference
+	 to be full, we need to ascertain that the array has a single
+	 element in this dimension and that we actually reference the
+	 correct element.  */
       if (ref->u.ar.dimen_type[i] == DIMEN_ELEMENT)
 	{
-	  /* This is a contiguous reference.  */
+	  /* This is unconditionally a contiguous reference if all the
+	     remaining dimensions are elements.  */
 	  if (contiguous)
-	    *contiguous = (i + 1 == ref->u.ar.dimen);
+	    {
+	      *contiguous = true;
+	      for (n = i + 1; n < ref->u.ar.dimen; n++)
+		if (ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
+		  *contiguous = false;
+	    }
 
 	  if (!ref->u.ar.as
 	      || !ref->u.ar.as->lower[i]
@@ -1330,12 +1340,19 @@ gfc_full_array_ref_p (gfc_ref *ref, bool *contiguous)
 				       ref->u.ar.as->upper[i])))
 	ubound_OK = false;
       /* Check the stride.  */
-      if (ref->u.ar.stride[i] && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
+      if (ref->u.ar.stride[i]
+	    && !gfc_expr_is_one (ref->u.ar.stride[i], 0))
 	return false;
 
-      /* This is a contiguous reference.  */
+      /* This is unconditionally a contiguous reference as long as all
+	 the subsequent dimensions are elements.  */
       if (contiguous)
-	*contiguous = (i + 1 == ref->u.ar.dimen);
+	{
+	  *contiguous = true;
+	  for (n = i + 1; n < ref->u.ar.dimen; n++)
+	    if (ref->u.ar.dimen_type[n] != DIMEN_ELEMENT)
+	      *contiguous = false;
+	}
 
       if (!lbound_OK || !ubound_OK)
 	return false;
diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index 7db619e..466b065 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,9 @@
+2010-02-22  Paul Thomas  <pault@gcc.gnu.org>
+
+	PR fortran/43072
+	* gfortran.dg/internal_pack_6.f90: Number of 'packs' now zero.
+	* gfortran.dg/internal_pack_9.f90: New test.
+
 2010-02-21  Manuel López-Ibáñez  <manu@gcc.gnu.org>
 
 	PR c++/23510
diff --git a/gcc/testsuite/gfortran.dg/internal_pack_6.f90 b/gcc/testsuite/gfortran.dg/internal_pack_6.f90
index c02f7c9..51af726 100644
--- a/gcc/testsuite/gfortran.dg/internal_pack_6.f90
+++ b/gcc/testsuite/gfortran.dg/internal_pack_6.f90
@@ -5,7 +5,7 @@
 ! to internal_pack and internal_unpack were being generated.
 !
 ! Contributed by Joost VandeVondele <jv244@cam.ac.uk>
-!!
+!
 MODULE M1
  TYPE T1
    REAL :: data(10) = [(i, i = 1, 10)]
@@ -38,7 +38,9 @@ SUBROUTINE S2
  DO i=-4,5
     CALL S1(data(:,i), 10, sum (data(:,i)))
  ENDDO
-! Being non-contiguous, this is the only time that _internal_pack is called
+
+! With the fix for PR41113/7 this is the only time that _internal_pack
+! was called.  The final part of the fix for PR43072 put paid to it too.
  DO i=-4,5
     CALL S1(data(-2:,i), 8, sum (data(-2:,i)))
  ENDDO
@@ -53,5 +55,5 @@ END SUBROUTINE S2
  call s2
 end
 ! { dg-final { cleanup-modules "M1" } }
-! { dg-final { scan-tree-dump-times "_gfortran_internal_pack" 1 "original" } }
+! { dg-final { scan-tree-dump-times "_gfortran_internal_pack" 0 "original" } }
 ! { dg-final { cleanup-tree-dump "original" } }
diff --git a/gcc/testsuite/gfortran.dg/internal_pack_9.f90 b/gcc/testsuite/gfortran.dg/internal_pack_9.f90
new file mode 100644
index 0000000..6e69745
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/internal_pack_9.f90
@@ -0,0 +1,41 @@
+! { dg-do compile }
+! { dg-options "-fdump-tree-original" }
+!
+! During the discussion of the fix for PR43072, in which unnecessary
+! calls to internal PACK/UNPACK were being generated, the following,
+! further unnecessary temporaries or PACk/UNPACK were found.
+!
+! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
+!
+! Case 1: Substring encompassing the whole string
+subroutine foo2
+  implicit none
+  external foo
+  character(len=20) :: str(2) = '1234567890'
+  call foo(str(:)(1:20)) ! This is still not fixed.
+end
+
+! Case 2: Contiguous array section
+subroutine bar
+  implicit none
+  external foo
+  integer :: a(3,3,3)
+  call foo(a(:,:,:)) ! OK, no temporary
+  call foo(a(:,:,1)) ! OK, no temporary
+  call foo(a(:,2,2)) ! Used unnecessarily a temporary -FIXED
+  call foo(a(2,:,1)) ! OK, creates a temporary(1)
+end
+
+! Case 3: Stride 1 section.
+subroutine foobar
+  implicit none
+  external foo
+  integer :: A(10,10)
+  call foo(A(3:7,4)) ! Used unnecessarily a temporary - FIXED
+  call foo(A(:,3:7)) ! OK (no temporary)
+  call foo(A(1:10,3:7)) ! OK (no temporary)
+  call foo(A(4,3:7)) ! temporary OK(2)
+  call foo(A(:,3:7:-1)) ! temporary(3) OK because of stride
+end
+! { dg-final { scan-tree-dump-times "unpack" 3 "original" } }
+! { dg-final { cleanup-tree-dump "original" } }