1! Test unpack0 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) :: field 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 field (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 test (unpack (vector, mask, field)) 25contains 26 subroutine test (a) 27 character (len = slen), dimension (:, :) :: a 28 29 if (size (a, 1) .ne. n1) call abort 30 if (size (a, 2) .ne. n2) call abort 31 32 i = 0 33 do i2 = 1, n2 34 do i1 = 1, n1 35 if (mask (i1, i2)) then 36 i = i + 1 37 if (a (i1, i2) .ne. vector (i)) call abort 38 else 39 if (a (i1, i2) .ne. field (i1, i2)) call abort 40 end if 41 end do 42 end do 43 end subroutine test 44end program main 45