1! { dg-do run }
2!
3! PR fortran/51970
4! PR fortran/51977
5!
6type t
7end type t
8type, extends(t) :: t2
9  integer :: a
10end type t2
11
12class(t), allocatable :: y(:), z(:)
13
14allocate(y(2), source=[t2(2), t2(3)])
15call func2(y,z)
16
17select type(z)
18  type is(t2)
19    if (any (z(:)%a /= [2, 3])) call abort()
20  class default
21    call abort()
22end select
23
24contains
25  function func(x)
26   class (t), allocatable :: x(:), func(:)
27   call move_alloc (x, func)
28  end function
29
30  function func1(x)
31   class (t), allocatable :: x(:), func1(:)
32   call move_alloc (func1, x)
33  end function
34
35  subroutine func2(x, y)
36   class (t), allocatable :: x(:), y(:)
37   call move_alloc (x, y)
38  end subroutine
39end
40