1! Test (non-scalar) pack for character arrays.
2! { dg-do run }
3program main
4  implicit none
5  integer, parameter :: n1 = 3, n2 = 4, nv = 10, slen = 9
6  character (len = slen), dimension (n1, n2) :: a
7  character (len = slen), dimension (nv) :: vector
8  logical, dimension (n1, n2) :: mask
9  integer :: i1, i2, i
10
11  do i2 = 1, n2
12    do i1 = 1, n1
13      a (i1, i2) = 'abc'(i1:i1) // 'defg'(i2:i2) // 'cantrip'
14    end do
15  end do
16  mask (1, :) = (/ .true., .false., .true., .true. /)
17  mask (2, :) = (/ .true., .false., .false., .false. /)
18  mask (3, :) = (/ .false., .true., .true., .true. /)
19
20  do i = 1, nv
21    vector (i) = 'crespo' // '0123456789'(i:i)
22  end do
23
24  call test1 (pack (a, mask))
25  call test2 (pack (a, mask, vector))
26contains
27  subroutine test1 (b)
28    character (len = slen), dimension (:) :: b
29
30    i = 0
31    do i2 = 1, n2
32      do i1 = 1, n1
33        if (mask (i1, i2)) then
34          i = i + 1
35          if (b (i) .ne. a (i1, i2)) call abort
36        end if
37      end do
38    end do
39    if (size (b, 1) .ne. i) call abort
40  end subroutine test1
41
42  subroutine test2 (b)
43    character (len = slen), dimension (:) :: b
44
45    if (size (b, 1) .ne. nv) call abort
46    i = 0
47    do i2 = 1, n2
48      do i1 = 1, n1
49        if (mask (i1, i2)) then
50          i = i + 1
51          if (b (i) .ne. a (i1, i2)) call abort
52        end if
53      end do
54    end do
55    do i = i + 1, nv
56      if (b (i) .ne. vector (i)) call abort
57    end do
58  end subroutine test2
59end program main
60