1! { dg-do run }
2!
3! PR 41581: [OOP] Allocation of a CLASS with SOURCE=<class> does not work
4!
5! Contributed by Tobias Burnus <burnus@gcc.gnu.org>
6
7 type t
8 end type t
9
10 type,extends(t) :: t2
11   integer :: i = 54
12   real :: r = 384.02
13 end type t2
14
15 class(t), allocatable :: m1, m2
16
17 allocate(t2 :: m2)
18 select type(m2)
19 type is (t2)
20   print *, m2%i, m2%r
21   if (m2%i/=54) call abort()
22   if (abs(m2%r-384.02)>1E-3) call abort()
23   m2%i = 42
24   m2%r = -4.0
25 class default
26   call abort()
27 end select
28
29 allocate(m1, source=m2)
30 select type(m1)
31 type is (t2)
32   print *, m1%i, m1%r
33   if (m1%i/=42) call abort()
34   if (abs(m1%r+4.0)>1E-3) call abort()
35 class default
36   call abort()
37 end select
38
39end
40