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) STOP 1
  26     if (size (a, 2) .ne. n2) STOP 2
  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)) STOP 3
  34         else
  35           if (a (i1, i2) .ne. field) STOP 4
  36         end if
  37       end do
  38     end do
  39   end subroutine test
  40 end program main