1! { dg-do compile }
2! { dg-options "-fdump-tree-original" }
3!
4!  Test the fix for PR86481
5!
6! Contributed by Rich Townsend  <townsend@astro.wisc.edu>
7!
8program simple_leak
9
10  implicit none
11
12  type, abstract :: foo_t
13  end type foo_t
14
15  type, extends(foo_t) :: foo_a_t
16     real(8), allocatable :: a(:)
17  end type foo_a_t
18
19  type, extends(foo_t) ::  bar_t
20     class(foo_t), allocatable :: f
21  end type bar_t
22
23  integer, parameter :: N = 2
24  integer, parameter :: D = 3
25
26  type(bar_t) :: b(N)
27  integer     :: i
28
29  do i = 1, N
30     b(i) = func_bar(D)
31  end do
32
33  do i = 1, N
34     deallocate (b(i)%f)
35  end do
36
37contains
38
39  function func_bar (D) result (b)
40
41    integer, intent(in) :: D
42    type(bar_t)         :: b
43
44    allocate(b%f, SOURCE=func_foo(D))
45
46  end function func_bar
47
48  !****
49
50  function func_foo (D) result (f)
51
52    integer, intent(in)       :: D
53    class(foo_t), allocatable :: f
54
55    allocate(f, SOURCE=func_foo_a(D)) ! Lose one of these for each allocation
56
57  end function func_foo
58
59  !****
60
61  function func_foo_a (D) result (f)
62
63    integer, intent(in) :: D
64    type(foo_a_t)       :: f
65
66    allocate(f%a(D))  ! Lose one of these for each allocation => N*D*elem_size(f%a)
67
68  end function func_foo_a
69
70end program simple_leak
71! { dg-final { scan-tree-dump-times "\>_final" 6 "original" } }
72