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