1! { dg-do run }
2! { dg-options "-fdump-tree-original" }
3!
4! Test the fix for PR83567 in which the parameterized component 'foo' was
5! being deallocated before return from 'addw', with consequent segfault in
6! the main program.
7!
8! Contributed by Berke Durak  <berke.durak@gmail.com>
9! The function 'addvv' has been made elemental so that the test can check that
10! arrays are correctly treated and that no memory leaks occur.
11!
12module pdt_m
13  implicit none
14  type :: vec(k)
15     integer, len :: k=3
16     integer :: foo(k)=[1,2,3]
17  end type vec
18contains
19  elemental function addvv(a,b) result(c)
20    type(vec(k=*)), intent(in) :: a
21    type(vec(k=*)), intent(in) :: b
22    type(vec(k=a%k)) :: c
23
24    c%foo=a%foo+b%foo
25  end function
26end module pdt_m
27
28program test_pdt
29  use pdt_m
30  implicit none
31  type(vec) :: u,v,w, a(2), b(2), c(2)
32  integer :: i
33
34  u%foo=[1,2,3]
35  v%foo=[2,3,4]
36  w=addvv(u,v)
37  if (any (w%foo .ne. [3,5,7])) STOP 1
38  do i = 1 , a(1)%k
39    a%foo(i) = i + 4
40    b%foo(i) = i + 7
41  end do
42  c = addvv(a,b)
43  if (any (c(1)%foo .ne. [13,15,17])) STOP 2
44end program test_pdt
45! { dg-final { scan-tree-dump-times "__builtin_free" 8 "original" } }
46! { dg-final { scan-tree-dump-times "__builtin_malloc" 8 "original" } }
47