1! { dg-do run }
2!
3! Test that pr78356 is fixed.
4! Contributed by Janus Weil and Andrew Benson
5
6program p
7  implicit none
8  type ac
9  end type
10  type, extends(ac) :: a
11     integer, allocatable :: b
12  end type
13  type n
14     class(ac), allocatable :: acr(:)
15  end type
16  type(n) :: s,t
17  allocate(a :: s%acr(1))
18  call nncp(s,t)
19  select type (cl => t%acr(1))
20    class is (a)
21      if (allocated(cl%b)) error stop
22    class default
23      error stop
24  end select
25contains
26  subroutine nncp(self,tg)
27    type(n) :: self, tg
28    allocate(tg%acr(1),source=self%acr(1))
29  end
30end
31
32