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