1! { dg-do run }
2!
3! PR 55072: [4.6/4.7/4.8 Regression] Missing internal_pack leads to wrong code with derived type
4!
5! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
6
7implicit none
8type t
9integer :: i
10end type t
11type(t), target :: tgt(4,4)
12type(t), pointer :: p(:,:)
13integer :: i,j,k
14
15k = 1
16do i = 1, 4
17  do j = 1, 4
18    tgt(i,j)%i = k
19    k = k+1
20  end do
21end do
22
23p => tgt(::2,::2)
24print *,p%i
25call bar(p)
26
27contains
28
29  subroutine bar(x)
30    type(t) :: x(*)
31    print *,x(1:4)%i
32    if (any (x(1:4)%i /= [1, 9, 3, 11])) call abort()
33  end subroutine
34end
35