re PR fortran/52473 (CSHIFT slow - inline it?)

2017-06-18  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/52473
	* m4/cshift0.m4:  For arrays that are contiguous up to
	shift, implement blocked algorighm for cshift.
	* generated/cshift0_c10.c:  Regenerated.
	* generated/cshift0_c16.c:  Regenerated.
	* generated/cshift0_c4.c:  Regenerated.
	* generated/cshift0_c8.c:  Regenerated.
	* generated/cshift0_i1.c:  Regenerated.
	* generated/cshift0_i16.c:  Regenerated.
	* generated/cshift0_i2.c:  Regenerated.
	* generated/cshift0_i4.c:  Regenerated.
	* generated/cshift0_i8.c:  Regenerated.
	* generated/cshift0_r10.c:  Regenerated.
	* generated/cshift0_r16.c:  Regenerated.
	* generated/cshift0_r4.c:  Regenerated.
	* generated/cshift0_r8.c:  Regenerated.

2017-06-18  Thomas Koenig  <tkoenig@gcc.gnu.org>

	PR fortran/52473
	* gfortran.dg/cshift_1.f90:  New test.

From-SVN: r249350

2 files changed, 113 insertions, 0 deletions

diff --git a/gcc/testsuite/ChangeLog b/gcc/testsuite/ChangeLog
index ea83e35..9200ee8 100644
--- a/gcc/testsuite/ChangeLog
+++ b/gcc/testsuite/ChangeLog
@@ -1,3 +1,8 @@
+2017-06-18  Thomas Koenig  <tkoenig@gcc.gnu.org>
+
+	PR fortran/52473
+	* gfortran.dg/cshift_1.f90:  New test.
+
 2017-06-17  Rainer Orth  <ro@CeBiTec.Uni-Bielefeld.DE>
 
 	Remove dg-skip-if, dg-xfail-if, dg-xfail-run-if default args.
diff --git a/gcc/testsuite/gfortran.dg/cshift_1.f90 b/gcc/testsuite/gfortran.dg/cshift_1.f90
new file mode 100644
index 0000000..e2024ea
--- /dev/null
+++ b/gcc/testsuite/gfortran.dg/cshift_1.f90
@@ -0,0 +1,108 @@
+! { dg-do  run }
+! Take cshift through its paces to make sure no boundary
+! cases are wrong.
+
+module kinds
+  integer, parameter :: sp = selected_real_kind(6) ! Single precision
+end module kinds
+
+module replacements
+  use kinds
+contains
+  subroutine cshift_sp_3_v1 (array, shift, dim, res)
+    integer, parameter :: wp = sp
+    real(kind=wp), dimension(:,:,:), intent(in) :: array
+    integer, intent(in) :: shift, dim
+    real(kind=wp), dimension(:,:,:), intent(out) :: res
+    integer :: i,j,k
+    integer :: sh, rsh
+    integer :: n
+    integer :: n2, n3
+    res = 0
+    n3 = size(array,3)
+    n2 = size(array,2)
+    n1 = size(array,1)
+    if (dim == 1) then
+       n = n1
+       sh = modulo(shift, n)
+       rsh = n - sh
+       do k=1, n3
+          do j=1, n2
+             do i=1, rsh
+                res(i,j,k) = array(i+sh,j,k)
+             end do
+             do i=rsh+1,n
+                res(i,j,k) = array(i-rsh,j,k)
+             end do
+          end do
+       end do
+    else if (dim == 2) then
+       n = n2
+       sh = modulo(shift,n)
+       rsh = n - sh
+       do k=1, n3
+          do j=1, rsh
+             do i=1, n1
+                res(i,j,k) = array(i,j+sh, k)
+             end do
+          end do
+          do j=rsh+1, n
+             do i=1, n1
+                res(i,j,k) = array(i,j-rsh, k)
+             end do
+          end do
+       end do
+    else if (dim == 3) then
+       n = n3
+       sh = modulo(shift, n)
+       rsh = n - sh
+       do k=1, rsh
+          do j=1, n2
+             do i=1, n1
+                res(i,j,k) = array(i, j, k+sh)
+             end do
+          end do
+       end do
+       do k=rsh+1, n
+          do j=1, n2
+             do i=1, n1
+                res(i,j, k) = array(i, j, k-rsh)
+             end do
+          end do          
+       end do
+    else
+       stop "Wrong argument to dim"
+    end if
+  end subroutine cshift_sp_3_v1
+end module replacements
+
+program testme
+  use kinds
+  use replacements
+  implicit none
+  integer, parameter :: wp = sp  ! Working precision
+  INTEGER, PARAMETER :: n = 7
+  real(kind=wp), dimension(:,:,:), allocatable :: a,b,c
+  integer i, j, k
+  real:: t1, t2
+  integer, parameter :: nrep = 20
+
+  allocate (a(n,n,n), b(n,n,n),c(n,n,n))
+  call random_number(a)
+  do k = 1,3
+   do i=-3,3,2
+     call cshift_sp_3_v1 (a, i, k, b)
+     c = cshift(a,i,k)
+     if (any (c /= b)) call abort
+   end do
+  end do
+  deallocate (b,c)
+  allocate (b(n-1,n-1,n-1),c(n-1,n-1,n-1))
+  do k=1,3
+     do i=-3,3,2
+        call cshift_sp_3_v1 (a(1:n-1,1:n-1,1:n-1), i, k, b)
+        c = cshift(a(1:n-1,1:n-1,1:n-1), i, k)
+        if (any (c /= b)) call abort
+     end do
+  end do
+end program testme