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