1! { dg-do compile }
2! { dg-options "-fdump-tree-original" }
3!
4! Test the fix for PR43243, where unnecessary calls to internal_pack/unpack
5! were being produced below. These references are contiguous and so do not
6! need a temporary. In addition, the final call to 'bar' required a pack/unpack
7! which had been missing since r156680, at least.
8!
9! Contributed Tobias Burnus <burnus@gcc.gnu.org>
10!
11module m
12  type t
13    integer, allocatable :: a(:)
14    integer, pointer :: b(:)
15    integer :: c(5)
16  end type t
17end module m
18
19subroutine foo(a,d,e,n)
20  use m
21  implicit none
22  integer :: n
23  type(t) :: a
24  type(t), allocatable :: d(:)
25  type(t), pointer :: e(:)
26  call bar(   a%a) ! OK - no array temp needed
27  call bar(   a%c) ! OK - no array temp needed
28
29  call bar(   a%a(1:n)) ! Missed: No pack needed
30  call bar(   a%b(1:n)) ! OK: pack needed
31  call bar(   a%c(1:n)) ! Missed: No pack needed
32
33  call bar(d(1)%a(1:n)) ! Missed: No pack needed
34  call bar(d(1)%b(1:n)) ! OK: pack needed
35  call bar(d(1)%c(1:n)) ! Missed: No pack needed
36
37  call bar(e(1)%a(1:n)) ! Missed: No pack needed
38  call bar(e(1)%b(1:n)) ! OK: pack needed
39  call bar(e(1)%c(1:n)) ! Missed: No pack needed
40end subroutine foo
41
42use m
43implicit none
44integer :: i
45integer, target :: z(6)
46type(t) :: y
47
48z = [(i, i=1,6)]
49y%b => z(::2)
50call bar(y%b)  ! Missed: Pack needed
51end
52
53subroutine bar(x)
54  integer :: x(1:*)
55  print *, x(1:3)
56  if (any (x(1:3) /= [1,3,5])) call abort ()
57end subroutine bar
58! { dg-final { scan-tree-dump-times "unpack" 4 "original" } }
59! { dg-final { cleanup-tree-dump "original" } }
60