! { dg-do run }
! PR libfortran/103634 - Runtime crash with PACK on zero-sized arrays
! Exercise PACK intrinsic for cases when it calls pack_internal

program p
  implicit none
  type t
     real :: r(24) = -99.
  end type
  type(t), allocatable :: new(:), old(:), vec(:)
  logical, allocatable :: mask(:)
  integer              :: n, m
! m = 1    ! works
  m = 0    ! failed with SIGSEGV in pack_internal
  do m = 0, 2
     print *, m
     allocate (old(m), mask(m), vec(m))
     if (m > 0) vec(m)% r(1) = 42
     mask(:) = .true.
     n = count (mask)
     allocate (new(n))

     mask(:) = .false.
     if (size (pack (old, mask)) /= 0) stop 1
     mask(:) = .true.
     if (size (pack (old, mask)) /= m) stop 2
     new(:) = pack (old, mask)              ! this used to segfault for m=0

     mask(:) = .false.
     if (size (pack (old, mask, vector=vec)) /= m) stop 3
     new(:) = t()
     new(:) = pack (old, mask, vector=vec)  ! this used to segfault for m=0
     if (m > 0) then
        if (     new( m  )% r(1) /=  42)  stop 4
        if (any (new(:m-1)% r(1) /= -99)) stop 5
     end if

     if (m > 0) mask(m) = .true.
     if (size (pack (old, mask, vector=vec)) /= m) stop 6
     new(:) = t()
     new(:) = pack (old, mask, vector=vec)  ! this used to segfault for m=0
     if (m > 0) then
        if (new(1)% r(1) /= -99) stop 7
     end if
     if (m > 1) then
        if (new(m)% r(1) /=  42) stop 8
     end if

     if (size (pack (old(:0), mask(:0), vector=vec)) /= m) stop 9
     new(:) = t()
     new(:) = pack (old(:0), mask(:0), vector=vec) ! did segfault for m=0
     if (m > 0) then
        if (new(m)% r(1) /= 42) stop 10
     end if
     deallocate (old, mask, new, vec)
  end do
end