Mercurial > hg > CbC > CbC_gcc

annotate gcc/testsuite/gfortran.dg/char_unpack_2.f90 @ 132:d34655255c78

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
update gcc-8.2
author mir3636
date Thu, 25 Oct 2018 10:21:07 +0900
parents 84e7813d76e9
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
111
kono
parents:
diff changeset
1 ! Test unpack1 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 = 3, n2 = 4, nv = 10, slen = 9
kono
parents:
diff changeset
6 character (len = slen) :: field
kono
parents:
diff changeset
7 character (len = slen), dimension (nv) :: vector
kono
parents:
diff changeset
8 logical, dimension (n1, n2) :: mask
kono
parents:
diff changeset
9 integer :: i1, i2, i
kono
parents:
diff changeset
10
kono
parents:
diff changeset
11 field = 'broadside'
kono
parents:
diff changeset
12 mask (1, :) = (/ .true., .false., .true., .true. /)
kono
parents:
diff changeset
13 mask (2, :) = (/ .true., .false., .false., .false. /)
kono
parents:
diff changeset
14 mask (3, :) = (/ .false., .true., .true., .true. /)
kono
parents:
diff changeset
15
kono
parents:
diff changeset
16 do i = 1, nv
kono
parents:
diff changeset
17 vector (i) = 'crespo' // '0123456789'(i:i)
kono
parents:
diff changeset
18 end do
kono
parents:
diff changeset
19
kono
parents:
diff changeset
20 call test (unpack (vector, mask, field))
kono
parents:
diff changeset
21 contains
kono
parents:
diff changeset
22 subroutine test (a)
kono
parents:
diff changeset
23 character (len = slen), dimension (:, :) :: a
kono
parents:
diff changeset
24
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
25 if (size (a, 1) .ne. n1) STOP 1
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
26 if (size (a, 2) .ne. n2) STOP 2
111
kono
parents:
diff changeset
27
kono
parents:
diff changeset
28 i = 0
kono
parents:
diff changeset
29 do i2 = 1, n2
kono
parents:
diff changeset
30 do i1 = 1, n1
kono
parents:
diff changeset
31 if (mask (i1, i2)) then
kono
parents:
diff changeset
32 i = i + 1
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
33 if (a (i1, i2) .ne. vector (i)) STOP 3
111
kono
parents:
diff changeset
34 else
131
84e7813d76e9 gcc-8.2
mir3636
parents: 111
diff changeset
35 if (a (i1, i2) .ne. field) STOP 4
111
kono
parents:
diff changeset
36 end if
kono
parents:
diff changeset
37 end do
kono
parents:
diff changeset
38 end do
kono
parents:
diff changeset
39 end subroutine test
kono
parents:
diff changeset
40 end program main