1! Test eoshift2 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) :: shift1 = 4
9  integer (kind = 2) :: shift2 = 2
10  integer (kind = 4) :: shift3 = 3
11  integer (kind = 8) :: shift4 = 1
12  integer :: i1, i2, i3
13
14  filler (1, :) = (/ 'tic', 'tac', 'toe', 'tip' /)
15  filler (2, :) = (/ 'zzz', 'yyy', 'xxx', 'www' /)
16
17  do i3 = 1, n3
18    do i2 = 1, n2
19      do i1 = 1, n1
20        a (i1, i2, i3) = 'ab'(i1:i1) // 'cdefg'(i2:i2) // 'hijk'(i3:i3)
21      end do
22    end do
23  end do
24
25  call test (eoshift (a, shift1, filler, 2), int (shift1), .true.)
26  call test (eoshift (a, shift2, filler, 2), int (shift2), .true.)
27  call test (eoshift (a, shift3, filler, 2), int (shift3), .true.)
28  call test (eoshift (a, shift4, filler, 2), int (shift4), .true.)
29
30  call test (eoshift (a, shift1, dim = 2), int (shift1), .false.)
31  call test (eoshift (a, shift2, dim = 2), int (shift2), .false.)
32  call test (eoshift (a, shift3, dim = 2), int (shift3), .false.)
33  call test (eoshift (a, shift4, dim = 2), int (shift4), .false.)
34contains
35  subroutine test (b, d2, has_filler)
36    character (len = slen), dimension (n1, n2, n3) :: b
37    logical :: has_filler
38    integer :: d2
39
40    do i3 = 1, n3
41      do i2 = 1, n2
42        do i1 = 1, n1
43          if (i2 + d2 .le. n2) then
44            if (b (i1, i2, i3) .ne. a (i1, i2 + d2, i3)) call abort
45          else if (has_filler) then
46            if (b (i1, i2, i3) .ne. filler (i1, i3)) call abort
47          else
48            if (b (i1, i2, i3) .ne. '') call abort
49          end if
50        end do
51      end do
52    end do
53  end subroutine test
54end program main
55