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