--- /dev/null
+! { 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
index_type count[GFC_MAX_DIMENSIONS];
index_type extent[GFC_MAX_DIMENSIONS];
+ bool zero_sized;
index_type n;
index_type dim;
index_type nelem;
else
runtime_error ("Funny sized logical array");
+ zero_sized = false;
for (n = 0; n < dim; n++)
{
count[n] = 0;
extent[n] = GFC_DESCRIPTOR_EXTENT(array,n);
+ if (extent[n] <= 0)
+ zero_sized = true;
sstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(array,n);
mstride[n] = GFC_DESCRIPTOR_STRIDE_BYTES(mask,n);
}
if (mstride[0] == 0)
mstride[0] = mask_kind;
+ if (zero_sized)
+ sptr = NULL;
+ else
+ sptr = array->base_addr;
+
if (ret->base_addr == NULL || unlikely (compile_options.bounds_check))
{
/* Count the elements, either for allocating memory or