1! Test eoshift1 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) :: 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  shift1 (1, :) = (/ 1, 3, 2, 2 /)
15  shift1 (2, :) = (/ 2, 1, 1, 3 /)
16  shift2 = shift1
17  shift3 = shift1
18  shift4 = shift1
19
20  do i3 = 1, n3
21    do i2 = 1, n2
22      do i1 = 1, n1
23        a (i1, i2, i3) = 'ab'(i1:i1) // 'cdefg'(i2:i2) // 'hijk'(i3:i3)
24      end do
25    end do
26  end do
27
28  call test (eoshift (a, shift1, 'foo', 2), 'foo')
29  call test (eoshift (a, shift2, 'foo', 2), 'foo')
30  call test (eoshift (a, shift3, 'foo', 2), 'foo')
31  call test (eoshift (a, shift4, 'foo', 2), 'foo')
32
33  filler = ''
34  call test (eoshift (a, shift1, dim = 2), filler)
35  call test (eoshift (a, shift2, dim = 2), filler)
36  call test (eoshift (a, shift3, dim = 2), filler)
37  call test (eoshift (a, shift4, dim = 2), filler)
38contains
39  subroutine test (b, filler)
40    character (len = slen), dimension (n1, n2, n3) :: b
41    character (len = slen) :: filler
42    integer :: i2p
43
44    do i3 = 1, n3
45      do i2 = 1, n2
46        do i1 = 1, n1
47          i2p = i2 + shift1 (i1, i3)
48          if (i2p .gt. n2) then
49            if (b (i1, i2, i3) .ne. filler) STOP 1
50          else
51            if (b (i1, i2, i3) .ne. a (i1, i2p, i3)) STOP 2
52          end if
53        end do
54      end do
55    end do
56  end subroutine test
57end program main
58