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