diff options
Diffstat (limited to 'gcc')
| -rw-r--r-- | gcc/testsuite/gfortran.dg/intrinsic_pack_6.f90 | 57 |
1 files changed, 57 insertions, 0 deletions
diff --git a/gcc/testsuite/gfortran.dg/intrinsic_pack_6.f90 b/gcc/testsuite/gfortran.dg/intrinsic_pack_6.f90 new file mode 100644 index 0000000..917944d --- /dev/null +++ b/gcc/testsuite/gfortran.dg/intrinsic_pack_6.f90 @@ -0,0 +1,57 @@ +! { 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 |