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