1! { dg-do run } 2! { dg-options "-fdump-tree-original" } 3! 4! Test the fix for PR66079. The original problem was with the first 5! allocate statement. The rest of the testcase fixes problems found 6! whilst working on it but these have been commented out in 5 branch 7! since the pre-requisite patches in 6 branch have not been back 8! ported. 9! 10! Reported by Damian Rouson <damian@sourceryinstitute.org> 11! 12 type subdata 13 integer, allocatable :: b 14 endtype 15! block 16 call newRealVec 17! end block 18contains 19 subroutine newRealVec 20 type(subdata), allocatable :: d, e, f 21 character(:), allocatable :: g, h, i 22 character(8), allocatable :: j 23 allocate(d,source=subdata(1)) ! memory was lost, now OK 24 allocate(e,source=d) ! OK 25 allocate(f,source=create (99)) ! memory was lost, now OK 26 if (d%b .ne. 1) call abort 27 if (e%b .ne. 1) call abort 28 if (f%b .ne. 99) call abort 29 allocate (g, source = greeting1("good day")) 30 if (g .ne. "good day") call abort 31 allocate (h, source = greeting2("hello")) 32 if (h .ne. "hello") call abort 33! allocate (i, source = greeting3("hiya!")) 34! if (i .ne. "hiya!") call abort 35! call greeting4 (j, "Goodbye ") ! Test that dummy arguments are OK 36! if (j .ne. "Goodbye ") call abort 37 end subroutine 38 39 function create (arg) result(res) 40 integer :: arg 41 type(subdata), allocatable :: res, res1 42 allocate(res, res1, source = subdata(arg)) 43 end function 44 45 function greeting1 (arg) result(res) ! memory was lost, now OK 46 character(*) :: arg 47 Character(:), allocatable :: res 48 allocate(res, source = arg) 49 end function 50 51 function greeting2 (arg) result(res) 52 character(5) :: arg 53 Character(:), allocatable :: res 54 allocate(res, source = arg) 55 end function 56 57! function greeting3 (arg) result(res) 58! character(5) :: arg 59! Character(5), allocatable :: res, res1 60! allocate(res, res1, source = arg) ! Caused an ICE 61! if (res1 .ne. res) call abort 62! end function 63 64! subroutine greeting4 (res, arg) 65! character(8), intent(in) :: arg 66! Character(8), allocatable, intent(out) :: res 67! allocate(res, source = arg) ! Caused an ICE 68! end subroutine 69end 70! { dg-final { scan-tree-dump-times "builtin_malloc" 16 "original" } } 71! { dg-final { scan-tree-dump-times "builtin_free" 16 "original" } } 72! { dg-final { cleanup-tree-dump "original" } } 73