gcc/testsuite/gfortran.dg/internal_pack_13.f90

   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
   7 implicit none
   8 type t
   9 integer :: i
  10 end type t
  11 type(t), target :: tgt(4,4)
  12 type(t), pointer :: p(:,:)
  13 integer :: i,j,k
  14
  15 k = 1
  16 do i = 1, 4
  17   do j = 1, 4
  18     tgt(i,j)%i = k
  19     k = k+1
  20   end do
  21 end do
  22
  23 p => tgt(::2,::2)
  24 print *,p%i
  25 call bar(p)
  26
  27 contains
  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])) STOP 1
  33   end subroutine
  34 end