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