annotate gcc/testsuite/gfortran.dg/char_eoshift_2.f90 @ 158:494b0b89df80 default tip

...
author Shinji KONO <kono@ie.u-ryukyu.ac.jp>
date Mon, 25 May 2020 18:13:55 +0900
parents 84e7813d76e9
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ! Test eoshift1 for character arrays.
kono
parents:
diff changeset
2 ! { dg-do run }
kono
parents:
diff changeset
3 program main
kono
parents:
diff changeset
4 implicit none
kono
parents:
diff changeset
5 integer, parameter :: n1 = 2, n2 = 5, n3 = 4, slen = 3
kono
parents:
diff changeset
6 character (len = slen), dimension (n1, n2, n3) :: a
kono
parents:
diff changeset
7 character (len = slen) :: filler
kono
parents:
diff changeset
8 integer (kind = 1), dimension (n1, n3) :: shift1
kono
parents:
diff changeset
9 integer (kind = 2), dimension (n1, n3) :: shift2
kono
parents:
diff changeset
10 integer (kind = 4), dimension (n1, n3) :: shift3
kono
parents:
diff changeset
11 integer (kind = 8), dimension (n1, n3) :: shift4
kono
parents:
diff changeset
12 integer :: i1, i2, i3
kono
parents:
diff changeset
13
kono
parents:
diff changeset
14 shift1 (1, :) = (/ 1, 3, 2, 2 /)
kono
parents:
diff changeset
15 shift1 (2, :) = (/ 2, 1, 1, 3 /)
kono
parents:
diff changeset
16 shift2 = shift1
kono
parents:
diff changeset
17 shift3 = shift1
kono
parents:
diff changeset
18 shift4 = shift1
kono
parents:
diff changeset
19
kono
parents:
diff changeset
20 do i3 = 1, n3
kono
parents:
diff changeset
21 do i2 = 1, n2
kono
parents:
diff changeset
22 do i1 = 1, n1
kono
parents:
diff changeset
23 a (i1, i2, i3) = 'ab'(i1:i1) // 'cdefg'(i2:i2) // 'hijk'(i3:i3)
kono
parents:
diff changeset
24 end do
kono
parents:
diff changeset
25 end do
kono
parents:
diff changeset
26 end do
kono
parents:
diff changeset
27
kono
parents:
diff changeset
28 call test (eoshift (a, shift1, 'foo', 2), 'foo')
kono
parents:
diff changeset
29 call test (eoshift (a, shift2, 'foo', 2), 'foo')
kono
parents:
diff changeset
30 call test (eoshift (a, shift3, 'foo', 2), 'foo')
kono
parents:
diff changeset
31 call test (eoshift (a, shift4, 'foo', 2), 'foo')
kono
parents:
diff changeset
32
kono
parents:
diff changeset
33 filler = ''
kono
parents:
diff changeset
34 call test (eoshift (a, shift1, dim = 2), filler)
kono
parents:
diff changeset
35 call test (eoshift (a, shift2, dim = 2), filler)
kono
parents:
diff changeset
36 call test (eoshift (a, shift3, dim = 2), filler)
kono
parents:
diff changeset
37 call test (eoshift (a, shift4, dim = 2), filler)
kono
parents:
diff changeset
38 contains
kono
parents:
diff changeset
39 subroutine test (b, filler)
kono
parents:
diff changeset
40 character (len = slen), dimension (n1, n2, n3) :: b
kono
parents:
diff changeset
41 character (len = slen) :: filler
kono
parents:
diff changeset
42 integer :: i2p
kono
parents:
diff changeset
43
kono
parents:
diff changeset
44 do i3 = 1, n3
kono
parents:
diff changeset
45 do i2 = 1, n2
kono
parents:
diff changeset
46 do i1 = 1, n1
kono
parents:
diff changeset
47 i2p = i2 + shift1 (i1, i3)
kono
parents:
diff changeset
48 if (i2p .gt. n2) then
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
49 if (b (i1, i2, i3) .ne. filler) STOP 1
111
kono
parents:
diff changeset
50 else
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
51 if (b (i1, i2, i3) .ne. a (i1, i2p, i3)) STOP 2
111
kono
parents:
diff changeset
52 end if
kono
parents:
diff changeset
53 end do
kono
parents:
diff changeset
54 end do
kono
parents:
diff changeset
55 end do
kono
parents:
diff changeset
56 end subroutine test
kono
parents:
diff changeset
57 end program main