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