1! { dg-do run }
2! Test the fix for PR34438, in which default initializers
3! forced the derived type to be static; ie. initialized once
4! during the lifetime of the programme.  Instead, they should
5! be initialized each time they come into scope.
6!
7! Contributed by Sven Buijssen <sven.buijssen@math.uni-dortmund.de>
8! Third test is from  Dominique Dhumieres <dominiq@lps.ens.fr>
9!
10module demo
11   type myint
12     integer :: bar = 42
13   end type myint
14end module demo
15
16! As the name implies, this was the original testcase
17! provided by the contributor....
18subroutine original
19  use demo
20  integer val1 (6)
21  integer val2 (6)
22  call recfunc (1)
23  if (any (val1 .ne. (/1, 2, 3, 1, 2, 3/))) STOP 1
24  if (any (val2 .ne. (/1, 2, 3, 4, 4, 4/))) STOP 2
25contains
26
27  recursive subroutine recfunc (ivalue)
28    integer, intent(in) :: ivalue
29    type(myint) :: foo1
30    type(myint) :: foo2 = myint (99)
31    foo1%bar = ivalue
32    foo2%bar = ivalue
33    if (ivalue .le. 3) then
34      val1(ivalue) = foo1%bar
35      val2(ivalue) = foo2%bar
36      call recfunc (ivalue + 1)
37      val1(ivalue + 3) = foo1%bar
38      val2(ivalue + 3) = foo2%bar
39    endif
40  end subroutine recfunc
41end subroutine original
42
43! ...who came up with this one too.
44subroutine func (ivalue, retval1, retval2)
45  use demo
46  integer, intent(in) :: ivalue
47  type(myint) :: foo1
48  type(myint) :: foo2 = myint (77)
49  type(myint) :: retval1
50  type(myint) :: retval2
51  retval1 = foo1
52  retval2 = foo2
53  foo1%bar = 999
54  foo2%bar = 999
55end subroutine func
56
57subroutine other
58  use demo
59  interface
60    subroutine func(ivalue, rv1, rv2)
61      use demo
62      integer, intent(in) :: ivalue
63      type(myint) :: foo, rv1, rv2
64   end subroutine func
65  end interface
66  type(myint) :: val1, val2
67  call func (1, val1, val2)
68  if ((val1%bar .ne. 42) .or. (val2%bar .ne. 77)) STOP 3
69  call func (2, val1, val2)
70  if ((val1%bar .ne. 42) .or. (val2%bar .ne. 999)) STOP 4
71
72end subroutine other
73
74MODULE M1
75  TYPE T1
76    INTEGER :: i=7
77  END TYPE T1
78CONTAINS
79  FUNCTION F1(d1) RESULT(res)
80    INTEGER :: res
81    TYPE(T1), INTENT(OUT) :: d1
82    TYPE(T1), INTENT(INOUT) :: d2
83    res=d1%i
84    d1%i=0
85    RETURN
86  ENTRY   E1(d2) RESULT(res)
87    res=d2%i
88    d2%i=0
89  END FUNCTION F1
90END MODULE M1
91
92! This tests the fix of a regression caused by the first version
93! of the patch.
94subroutine dominique ()
95  USE M1
96  TYPE(T1) :: D1
97  D1=T1(3)
98  if (F1(D1) .ne. 7) STOP 5
99  D1=T1(3)
100  if (E1(D1) .ne. 3) STOP 6
101END
102
103! Run both tests.
104  call original
105  call other
106  call dominique
107end
108