1!{ dg-do run }
2!
3! Testcase for pr66927
4! Contributed by Juergen Reuter <juergen.reuter@desy.de>
5
6module processes
7  implicit none
8  private
9
10  type :: t1_t
11     real :: p = 0.0
12  end type t1_t
13
14  type :: t2_t
15     private
16     type(t1_t), dimension(:), allocatable :: p
17   contains
18     procedure :: func => t2_func
19  end type t2_t
20
21  type, public :: t3_t
22    type(t2_t), public :: int_born
23  end type t3_t
24
25  public :: evaluate
26
27contains
28
29  function t2_func (int) result (p)
30    class(t2_t), intent(in) :: int
31    type(t1_t), dimension(:), allocatable :: p
32    allocate(p(5))
33  end function t2_func
34
35  subroutine evaluate (t3)
36    class(t3_t), intent(inout) :: t3
37    type(t1_t), dimension(:), allocatable :: p_born
38    allocate (p_born(1:size(t3%int_born%func ())), &
39         source = t3%int_born%func ())
40    if (.not. allocated(p_born)) STOP 1
41    if (size(p_born) /= 5) STOP 2
42  end subroutine evaluate
43
44end module processes
45
46program pr66927
47use processes
48type(t3_t) :: o
49call evaluate(o)
50end
51
52