1! Test eoshift0 for character arrays. 2! { dg-do run } 3program main 4 implicit none 5 integer, parameter :: n1 = 6, n2 = 5, n3 = 4, slen = 3 6 character (len = slen), dimension (n1, n2, n3) :: a 7 character (len = slen) :: 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 do i3 = 1, n3 15 do i2 = 1, n2 16 do i1 = 1, n1 17 a (i1, i2, i3) = 'abcdef'(i1:i1) // 'ghijk'(i2:i2) // 'lmno'(i3:i3) 18 end do 19 end do 20 end do 21 22 call test (eoshift (a, shift1, 'foo', 1), int (shift1), 0, 0, 'foo') 23 call test (eoshift (a, shift2, 'foo', 2), 0, int (shift2), 0, 'foo') 24 call test (eoshift (a, shift3, 'foo', 2), 0, int (shift3), 0, 'foo') 25 call test (eoshift (a, shift4, 'foo', 3), 0, 0, int (shift4), 'foo') 26 27 filler = '' 28 call test (eoshift (a, shift1, dim = 1), int (shift1), 0, 0, filler) 29 call test (eoshift (a, shift2, dim = 2), 0, int (shift2), 0, filler) 30 call test (eoshift (a, shift3, dim = 2), 0, int (shift3), 0, filler) 31 call test (eoshift (a, shift4, dim = 3), 0, 0, int (shift4), filler) 32contains 33 subroutine test (b, d1, d2, d3, filler) 34 character (len = slen), dimension (n1, n2, n3) :: b 35 character (len = slen) :: filler 36 integer :: d1, d2, d3 37 38 do i3 = 1, n3 39 do i2 = 1, n2 40 do i1 = 1, n1 41 if (i1 + d1 .gt. n1 .or. i2 + d2 .gt. n2 .or. i3 + d3 .gt. n3) then 42 if (b (i1, i2, i3) .ne. filler) call abort 43 else 44 if (b (i1, i2, i3) .ne. a (i1 + d1, i2 + d2, i3 + d3)) call abort 45 end if 46 end do 47 end do 48 end do 49 end subroutine test 50end program main 51