1! { dg-do run }
2!
3! PR 46174: [OOP] ALLOCATE with SOURCE: Deep copy missing
4!
5! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
6
7implicit none
8type t
9end type t
10
11type, extends(t) :: t2
12  integer, allocatable :: a(:)
13end type t2
14
15class(t), allocatable :: x, y
16integer :: i
17
18allocate(t2 :: x)
19select type(x)
20 type is (t2)
21   allocate(x%a(10))
22   x%a = [ (i, i = 1,10) ]
23   print '(*(i3))', x%a
24 class default
25   call abort()
26end select
27
28allocate(y, source=x)
29
30select type(x)
31 type is (t2)
32   x%a = [ (i, i = 11,20) ]
33   print '(*(i3))', x%a
34 class default
35   call abort()
36end select
37
38select type(y)
39 type is (t2)
40   print '(*(i3))', y%a
41   if (any (y%a /= [ (i, i = 1,10) ])) call abort()
42 class default
43   call abort()
44end select
45
46end
47