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.
7 ! Contributed by Sven Buijssen <sven.buijssen@math.uni-dortmund.de>
8 ! Third test is from Dominique Dhumieres <dominiq@lps.ens.fr>
16 ! As the name implies, this was the original testcase
17 ! provided by the contributor....
23 if (any (val1 .ne. (/1, 2, 3, 1, 2, 3/))) call abort ()
24 if (any (val2 .ne. (/1, 2, 3, 4, 4, 4/))) call abort ()
27 recursive subroutine recfunc (ivalue)
28 integer, intent(in) :: ivalue
30 type(myint) :: foo2 = myint (99)
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
40 end subroutine recfunc
41 end subroutine original
43 ! ...who came up with this one too.
44 subroutine func (ivalue, retval1, retval2)
46 integer, intent(in) :: ivalue
48 type(myint) :: foo2 = myint (77)
49 type(myint) :: retval1
50 type(myint) :: retval2
60 subroutine func(ivalue, rv1, rv2)
62 integer, intent(in) :: ivalue
63 type(myint) :: foo, rv1, rv2
66 type(myint) :: val1, val2
67 call func (1, val1, val2)
68 if ((val1%bar .ne. 42) .or. (val2%bar .ne. 77)) call abort ()
69 call func (2, val1, val2)
70 if ((val1%bar .ne. 42) .or. (val2%bar .ne. 999)) call abort ()
79 FUNCTION F1(d1) RESULT(res)
81 TYPE(T1), INTENT(OUT) :: d1
82 TYPE(T1), INTENT(INOUT) :: d2
86 ENTRY E1(d2) RESULT(res)
92 ! This tests the fix of a regression caused by the first version
94 subroutine dominique ()
98 if (F1(D1) .ne. 7) call abort ()
100 if (E1(D1) .ne. 3) call abort ()
108 ! { dg-final { cleanup-modules "demo M1" } }