2017-12-08 Richard Biener <rguenther@suse.de>
[official-gcc.git] / gcc / testsuite / gfortran.dg / char_eoshift_4.f90
blobb7c8670903453caf55c49c99975fa2c67b689bbc
1 ! Test eoshift3 for character arrays.
2 ! { dg-do run }
3 program 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), 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
14 filler (1, :) = (/ 'tic', 'tac', 'toe', 'tip' /)
15 filler (2, :) = (/ 'zzz', 'yyy', 'xxx', 'www' /)
17 shift1 (1, :) = (/ 1, 3, 2, 2 /)
18 shift1 (2, :) = (/ 2, 1, 1, 3 /)
19 shift2 = shift1
20 shift3 = shift1
21 shift4 = shift1
23 do i3 = 1, n3
24 do i2 = 1, n2
25 do i1 = 1, n1
26 a (i1, i2, i3) = 'ab'(i1:i1) // 'cdefg'(i2:i2) // 'hijk'(i3:i3)
27 end do
28 end do
29 end do
31 call test (eoshift (a, shift1, filler, 2), .true.)
32 call test (eoshift (a, shift2, filler, 2), .true.)
33 call test (eoshift (a, shift3, filler, 2), .true.)
34 call test (eoshift (a, shift4, filler, 2), .true.)
36 call test (eoshift (a, shift1, dim = 2), .false.)
37 call test (eoshift (a, shift2, dim = 2), .false.)
38 call test (eoshift (a, shift3, dim = 2), .false.)
39 call test (eoshift (a, shift4, dim = 2), .false.)
40 contains
41 subroutine test (b, has_filler)
42 character (len = slen), dimension (n1, n2, n3) :: b
43 logical :: has_filler
44 integer :: i2p
46 do i3 = 1, n3
47 do i2 = 1, n2
48 do i1 = 1, n1
49 i2p = i2 + shift1 (i1, i3)
50 if (i2p .le. n2) then
51 if (b (i1, i2, i3) .ne. a (i1, i2p, i3)) call abort
52 else if (has_filler) then
53 if (b (i1, i2, i3) .ne. filler (i1, i3)) call abort
54 else
55 if (b (i1, i2, i3) .ne. '') call abort
56 end if
57 end do
58 end do
59 end do
60 end subroutine test
61 end program main