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) STOP 1
25    if (e%b .ne. 1) STOP 2
26    if (f%b .ne. 99) STOP 3
27    allocate (g, source = greeting1("good day"))
28    if (g .ne. "good day") STOP 4
29    allocate (h, source = greeting2("hello"))
30    if (h .ne. "hello") STOP 5
31    allocate (i, source = greeting3("hiya!"))
32    if (i .ne. "hiya!") STOP 6
33    call greeting4 (j, "Goodbye ") ! Test that dummy arguments are OK
34    if (j .ne. "Goodbye ") STOP 7
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) STOP 8
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