1! { dg-do run }
2! { dg-options "-fdump-tree-original" }
3!
4! Fix for PR......
5!
6! The 'to' components of 'mytemp' would remain allocated after the call to
7! MOVE_ALLOC, resulting in memory leaks.
8!
9! Contributed by Alberto Luaces.
10!
11! See https://groups.google.com/forum/#!topic/comp.lang.fortran/k3bkKUbOpFU
12!
13module alloctest
14  type myallocatable
15     integer, allocatable:: i(:)
16  end type myallocatable
17
18contains
19  subroutine f(num, array)
20    implicit none
21    integer, intent(in) :: num
22    integer :: i
23    type(myallocatable):: array(:)
24
25    do i = 1, num
26       allocate(array(i)%i(5), source = [1,2,3,4,5])
27    end do
28
29  end subroutine f
30end module alloctest
31
32program name
33  use alloctest
34  implicit none
35  type(myallocatable), allocatable:: myarray(:), mytemp(:)
36  integer, parameter:: OLDSIZE = 7, NEWSIZE = 20
37  logical :: flag
38
39  allocate(myarray(OLDSIZE))
40  call f(size(myarray), myarray)
41
42  allocate(mytemp(NEWSIZE))
43  mytemp(1:OLDSIZE) = myarray
44
45  flag = .false.
46  call foo
47  call bar
48
49  deallocate(myarray)
50  if (allocated (mytemp)) deallocate (mytemp)
51
52  allocate(myarray(OLDSIZE))
53  call f(size(myarray), myarray)
54
55  allocate(mytemp(NEWSIZE))
56  mytemp(1:OLDSIZE) = myarray
57
58! Verfify that there is no segfault if the allocatable components
59! are deallocated before the call to move_alloc
60  flag = .true.
61  call foo
62  call bar
63
64  deallocate(myarray)
65contains
66  subroutine foo
67    integer :: i
68    if (flag) then
69      do i = 1, OLDSIZE
70        deallocate (mytemp(i)%i)
71      end do
72    end if
73    call move_alloc(mytemp, myarray)
74  end subroutine
75
76  subroutine bar
77    integer :: i
78    do i = 1, OLDSIZE
79      if (.not.flag .and. allocated (myarray(i)%i)) then
80        if (any (myarray(i)%i .ne. [1,2,3,4,5])) call abort
81      else
82        if (.not.flag) call abort
83      end if
84    end do
85  end subroutine
86end program name
87! { dg-final { scan-tree-dump-times "__builtin_malloc" 11 "original" } }
88! { dg-final { scan-tree-dump-times "__builtin_free" 11 "original" } }
89