1! { dg-do compile }
2! { dg-options "-fdump-tree-original" }
3!
4! PR 60922: [4.9/5 regression] Memory leak with allocatable CLASS components
5!
6! Contributed by Salvatore Filippone <sfilippone@uniroma2.it>
7
8program test_leak
9  implicit none
10
11  type d_base_vect_type
12  end type
13
14  type d_vect_type
15    class(d_base_vect_type), allocatable :: v
16  end type
17
18  call test()
19
20contains
21
22  subroutine test()
23    class(d_vect_type), allocatable :: x
24    allocate(x)
25    allocate(x%v)
26    print *,"allocated!"
27  end subroutine
28
29end
30
31! { dg-final { scan-tree-dump-times "fini_coarray" 1 "original" } }
32! { dg-final { cleanup-tree-dump "original" } }
33