Mercurial > hg > CbC > CbC_gcc

comparison gcc/testsuite/gfortran.dg/char_eoshift_2.f90 @ 111:04ced10e8804

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
gcc 7
author kono
date Fri, 27 Oct 2017 22:46:09 +0900
parents
children 84e7813d76e9
comparison
equal deleted inserted replaced
68:561a7518be6b 111:04ced10e8804
1 ! Test eoshift1 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) :: 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)
38 contains
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) call abort
50 else
51 if (b (i1, i2, i3) .ne. a (i1, i2p, i3)) call abort
52 end if
53 end do
54 end do
55 end do
56 end subroutine test
57 end program main