URL https://opencores.org/ocsvn/openrisc/openrisc/trunk

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [default_initialization_3.f90] - Blame information for rev 694

Details | Compare with Previous | View Log


! { dg-do run }
! Test the fix for PR34438, in which default initializers
! forced the derived type to be static; ie. initialized once
! during the lifetime of the programme.  Instead, they should
! be initialized each time they come into scope.
!
! Contributed by Sven Buijssen 
! Third test is from  Dominique Dhumieres 
!
module demo
   type myint
     integer :: bar = 42
   end type myint
end module demo
 
! As the name implies, this was the original testcase
! provided by the contributor....
subroutine original
  use demo
  integer val1 (6)
  integer val2 (6)
  call recfunc (1)
  if (any (val1 .ne. (/1, 2, 3, 1, 2, 3/))) call abort ()
  if (any (val2 .ne. (/1, 2, 3, 4, 4, 4/))) call abort ()
contains
 
  recursive subroutine recfunc (ivalue)
    integer, intent(in) :: ivalue
    type(myint) :: foo1
    type(myint) :: foo2 = myint (99)
    foo1%bar = ivalue
    foo2%bar = ivalue
    if (ivalue .le. 3) then
      val1(ivalue) = foo1%bar
      val2(ivalue) = foo2%bar
      call recfunc (ivalue + 1)
      val1(ivalue + 3) = foo1%bar
      val2(ivalue + 3) = foo2%bar
    endif
  end subroutine recfunc
end subroutine original
 
! ...who came up with this one too.
subroutine func (ivalue, retval1, retval2)
  use demo
  integer, intent(in) :: ivalue
  type(myint) :: foo1
  type(myint) :: foo2 = myint (77)
  type(myint) :: retval1
  type(myint) :: retval2
  retval1 = foo1
  retval2 = foo2
  foo1%bar = 999
  foo2%bar = 999
end subroutine func
 
subroutine other
  use demo
  interface
    subroutine func(ivalue, rv1, rv2)
      use demo
      integer, intent(in) :: ivalue
      type(myint) :: foo, rv1, rv2
   end subroutine func
  end interface
  type(myint) :: val1, val2
  call func (1, val1, val2)
  if ((val1%bar .ne. 42) .or. (val2%bar .ne. 77)) call abort ()
  call func (2, val1, val2)
  if ((val1%bar .ne. 42) .or. (val2%bar .ne. 999)) call abort ()
 
end subroutine other
 
MODULE M1
  TYPE T1
    INTEGER :: i=7
  END TYPE T1
CONTAINS
  FUNCTION F1(d1) RESULT(res)
    INTEGER :: res
    TYPE(T1), INTENT(OUT) :: d1
    TYPE(T1), INTENT(INOUT) :: d2
    res=d1%i
    d1%i=0
    RETURN
  ENTRY   E1(d2) RESULT(res)
    res=d2%i
    d2%i=0
  END FUNCTION F1
END MODULE M1
 
! This tests the fix of a regression caused by the first version
! of the patch.
subroutine dominique ()
  USE M1
  TYPE(T1) :: D1
  D1=T1(3)
  if (F1(D1) .ne. 7) call abort ()
  D1=T1(3)
  if (E1(D1) .ne. 3) call abort ()
END
 
! Run both tests.
  call original
  call other
  call dominique
end
! { dg-final { cleanup-modules "demo m1" } }

Line No.	Rev	Author	Line
1	694	jeremybenn	`! { 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`
8			`! Third test is from Dominique Dhumieres`
9			`!`
10			`module demo`
11			`type myint`
12			`integer :: bar = 42`
13			`end type myint`
14			`end module demo`
15
16			`! As the name implies, this was the original testcase`
17			`! provided by the contributor....`
18			`subroutine 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/))) call abort ()`
24			`if (any (val2 .ne. (/1, 2, 3, 4, 4, 4/))) call abort ()`
25			`contains`
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`
41			`end subroutine original`
42
43			`! ...who came up with this one too.`
44			`subroutine 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`
55			`end subroutine func`
56
57			`subroutine 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)) call abort ()`
69			`call func (2, val1, val2)`
70			`if ((val1%bar .ne. 42) .or. (val2%bar .ne. 999)) call abort ()`
71
72			`end subroutine other`
73
74			`MODULE M1`
75			`TYPE T1`
76			`INTEGER :: i=7`
77			`END TYPE T1`
78			`CONTAINS`
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`
90			`END MODULE M1`
91
92			`! This tests the fix of a regression caused by the first version`
93			`! of the patch.`
94			`subroutine dominique ()`
95			`USE M1`
96			`TYPE(T1) :: D1`
97			`D1=T1(3)`
98			`if (F1(D1) .ne. 7) call abort ()`
99			`D1=T1(3)`
100			`if (E1(D1) .ne. 3) call abort ()`
101			`END`
102
103			`! Run both tests.`
104			`call original`
105			`call other`
106			`call dominique`
107			`end`
108			`! { dg-final { cleanup-modules "demo m1" } }`

Browse

Tools

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [default_initialization_3.f90] - Blame information for rev 694