gcc/testsuite/gfortran.dg/char_unpack_2.f90

   1 ! Test unpack1 for character arrays.
   2 ! { dg-do run }
   3 program main
   4   implicit none
   5   integer, parameter :: n1 = 3, n2 = 4, nv = 10, slen = 9
   6   character (len = slen) :: field
   7   character (len = slen), dimension (nv) :: vector
   8   logical, dimension (n1, n2) :: mask
   9   integer :: i1, i2, i
  10
  11   field = 'broadside'
  12   mask (1, :) = (/ .true., .false., .true., .true. /)
  13   mask (2, :) = (/ .true., .false., .false., .false. /)
  14   mask (3, :) = (/ .false., .true., .true., .true. /)
  15
  16   do i = 1, nv
  17     vector (i) = 'crespo' // '0123456789'(i:i)
  18   end do
  19
  20   call test (unpack (vector, mask, field))
  21 contains
  22   subroutine test (a)
  23     character (len = slen), dimension (:, :) :: a
  24
  25     if (size (a, 1) .ne. n1) call abort
  26     if (size (a, 2) .ne. n2) call abort
  27
  28     i = 0
  29     do i2 = 1, n2
  30       do i1 = 1, n1
  31         if (mask (i1, i2)) then
  32           i = i + 1
  33           if (a (i1, i2) .ne. vector (i)) call abort
  34         else
  35           if (a (i1, i2) .ne. field) call abort
  36         end if
  37       end do
  38     end do
  39   end subroutine test
  40 end program main