1! Test eoshift3 for character arrays.
2! { dg-do run }
3program main
4  implicit none
5  integer, parameter :: n1 = 2, n2 = 5, n3 = 4, slen = 3
6  character (len = slen), dimension (n1, n2, n3) :: a
7  character (len = slen), dimension (n1, n3) :: filler
8  integer (kind = 1), dimension (n1, n3) :: shift1
9  integer (kind = 2), dimension (n1, n3) :: shift2
10  integer (kind = 4), dimension (n1, n3) :: shift3
11  integer (kind = 8), dimension (n1, n3) :: shift4
12  integer :: i1, i2, i3
13
14  filler (1, :) = (/ 'tic', 'tac', 'toe', 'tip' /)
15  filler (2, :) = (/ 'zzz', 'yyy', 'xxx', 'www' /)
16
17  shift1 (1, :) = (/ 1, 3, 2, 2 /)
18  shift1 (2, :) = (/ 2, 1, 1, 3 /)
19  shift2 = shift1
20  shift3 = shift1
21  shift4 = shift1
22
23  do i3 = 1, n3
24    do i2 = 1, n2
25      do i1 = 1, n1
26        a (i1, i2, i3) = 'ab'(i1:i1) // 'cdefg'(i2:i2) // 'hijk'(i3:i3)
27      end do
28    end do
29  end do
30
31  call test (eoshift (a, shift1, filler, 2), .true.)
32  call test (eoshift (a, shift2, filler, 2), .true.)
33  call test (eoshift (a, shift3, filler, 2), .true.)
34  call test (eoshift (a, shift4, filler, 2), .true.)
35
36  call test (eoshift (a, shift1, dim = 2), .false.)
37  call test (eoshift (a, shift2, dim = 2), .false.)
38  call test (eoshift (a, shift3, dim = 2), .false.)
39  call test (eoshift (a, shift4, dim = 2), .false.)
40contains
41  subroutine test (b, has_filler)
42    character (len = slen), dimension (n1, n2, n3) :: b
43    logical :: has_filler
44    integer :: i2p
45
46    do i3 = 1, n3
47      do i2 = 1, n2
48        do i1 = 1, n1
49          i2p = i2 + shift1 (i1, i3)
50          if (i2p .le. n2) then
51            if (b (i1, i2, i3) .ne. a (i1, i2p, i3)) STOP 1
52          else if (has_filler) then
53            if (b (i1, i2, i3) .ne. filler (i1, i3)) STOP 2
54          else
55            if (b (i1, i2, i3) .ne. '') STOP 3
56          end if
57        end do
58      end do
59    end do
60  end subroutine test
61end program main
62