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