1! { dg-do run }
2!
3! PR 41714: [OOP] ALLOCATE SOURCE= does not properly copy the value from SOURCE
4!
5! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
6
7type t
8  integer :: i
9end type t
10type, extends(t) :: t2
11  integer :: j
12end type t2
13
14class(t), allocatable :: a
15allocate(a, source=t2(1,2))
16print *,a%i
17if(a%i /= 1) STOP 1
18select type (a)
19  type is (t2)
20     print *,a%j
21     if(a%j /= 2) STOP 2
22end select
23end
24