1! { dg-do run }
2! Test the fix for PR47517
3!
4! Reported by Tobias Burnus  <burnus@gcc.gnu.org>
5! from a testcase by James Van Buskirk
6module mytypes
7   implicit none
8   type label
9      integer, allocatable :: parts(:)
10   end type label
11   type table
12      type(label), allocatable :: headers(:)
13   end type table
14end module mytypes
15
16program allocate_assign
17   use mytypes
18   implicit none
19   integer, parameter :: ik8 = selected_int_kind(18)
20   type(table) x1(2)
21   type(table) x2(3)
22   type(table), allocatable :: x(:)
23   integer i, j, k
24   integer(ik8) s
25   call foo
26   s = 0
27   do k = 1, 10000
28      x = x1
29      s = s+x(2)%headers(2)%parts(2)
30      x = x2
31      s = s+x(2)%headers(2)%parts(2)
32   end do
33   if (s .ne. 40000) call abort
34contains
35!
36! TODO - these assignments lose 1872 bytes on x86_64/FC17
37! This is PR38319
38!
39   subroutine foo
40       x1 = [table([(label([(j,j=1,3)]),i=1,3)]), &
41             table([(label([(j,j=1,4)]),i=1,4)])]
42
43       x2 = [table([(label([(j,j=1,4)]),i=1,4)]), &
44             table([(label([(j,j=1,5)]),i=1,5)]), &
45             table([(label([(j,j=1,6)]),i=1,6)])]
46   end subroutine
47end program allocate_assign
48