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

Subversion Repositories openrisc

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

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 694 jeremybenn 
! { dg-do run }
2 
!
3 
! PR fortran/47339
4 
! PR fortran/43062
5 
!
6 
! Run-time test for Fortran 2003 NAMELISTS
7 
! Version for non-strings
8 
!
9 
program nml_test
10 
  implicit none
11 
 
12 
  character(len=1000) :: str
13 
 
14 
  integer, allocatable :: a(:)
15 
  integer, allocatable :: b
16 
  integer, pointer :: ap(:)
17 
  integer, pointer :: bp
18 
  integer :: c
19 
  integer :: d(3)
20 
 
21 
  type t
22 
    integer :: c1
23 
    integer :: c2(3)
24 
  end type t
25 
  type(t) :: e,f(2)
26 
  type(t),allocatable :: g,h(:)
27 
  type(t),pointer :: i,j(:)
28 
 
29 
  namelist /nml/ a, b, c, d, ap, bp,e,f,g,h,i,j
30 
 
31 
  a = [1,2]
32 
  allocate(b,ap(2),bp)
33 
  ap = [98, 99]
34 
  b = 7
35 
  bp = 101
36 
  c = 8
37 
  d = [-1, -2, -3]
38 
 
39 
  e%c1 = -701
40 
  e%c2 = [-702,-703,-704]
41 
  f(1)%c1 = 33001
42 
  f(2)%c1 = 33002
43 
  f(1)%c2 = [44001,44002,44003]
44 
  f(2)%c2 = [44011,44012,44013]
45 
 
46 
  allocate(g,h(2),i,j(2))
47 
 
48 
  g%c1 = -601
49 
  g%c2 = [-602,6703,-604]
50 
  h(1)%c1 = 35001
51 
  h(2)%c1 = 35002
52 
  h(1)%c2 = [45001,45002,45003]
53 
  h(2)%c2 = [45011,45012,45013]
54 
 
55 
  i%c1 = -501
56 
  i%c2 = [-502,-503,-504]
57 
  j(1)%c1 = 36001
58 
  j(2)%c1 = 36002
59 
  j(1)%c2 = [46001,46002,46003]
60 
  j(2)%c2 = [46011,46012,46013]
61 
 
62 
  ! SAVE NAMELIST
63 
  str = repeat('X', len(str))
64 
  write(str,nml=nml)
65 
 
66 
  ! RESET NAMELIST
67 
  a = [-1,-1]
68 
  ap = [-1, -1]
69 
  b = -1
70 
  bp = -1
71 
  c = -1
72 
  d = [-1, -1, -1]
73 
 
74 
  e%c1 = -1
75 
  e%c2 = [-1,-1,-1]
76 
  f(1)%c1 = -1
77 
  f(2)%c1 = -1
78 
  f(1)%c2 = [-1,-1,-1]
79 
  f(2)%c2 = [-1,-1,-1]
80 
 
81 
  g%c1 = -1
82 
  g%c2 = [-1,-1,-1]
83 
  h(1)%c1 = -1
84 
  h(2)%c1 = -1
85 
  h(1)%c2 = [-1,-1,-1]
86 
  h(2)%c2 = [-1,-1,-1]
87 
 
88 
  i%c1 = -1
89 
  i%c2 = [-1,-1,-1]
90 
  j(1)%c1 = -1
91 
  j(2)%c1 = -1
92 
  j(1)%c2 = [-1,-1,-1]
93 
  j(2)%c2 = [-1,-1,-1]
94 
 
95 
  ! Read back
96 
  read(str,nml=nml)
97 
 
98 
  ! Check result
99 
  if (any (a /= [1,2])) call abort()
100 
  if (any (ap /= [98, 99])) call abort()
101 
  if (b /= 7) call abort()
102 
  if (bp /= 101) call abort()
103 
  if (c /= 8) call abort()
104 
  if (any (d /= [-1, -2, -3])) call abort()
105 
 
106 
  if (e%c1 /= -701) call abort()
107 
  if (any (e%c2 /= [-702,-703,-704])) call abort()
108 
  if (f(1)%c1 /= 33001) call abort()
109 
  if (f(2)%c1 /= 33002) call abort()
110 
  if (any (f(1)%c2 /= [44001,44002,44003])) call abort()
111 
  if (any (f(2)%c2 /= [44011,44012,44013])) call abort()
112 
 
113 
  if (g%c1 /= -601) call abort()
114 
  if (any(g%c2 /= [-602,6703,-604])) call abort()
115 
  if (h(1)%c1 /= 35001) call abort()
116 
  if (h(2)%c1 /= 35002) call abort()
117 
  if (any (h(1)%c2 /= [45001,45002,45003])) call abort()
118 
  if (any (h(2)%c2 /= [45011,45012,45013])) call abort()
119 
 
120 
  if (i%c1 /= -501) call abort()
121 
  if (any (i%c2 /= [-502,-503,-504])) call abort()
122 
  if (j(1)%c1 /= 36001) call abort()
123 
  if (j(2)%c1 /= 36002) call abort()
124 
  if (any (j(1)%c2 /= [46001,46002,46003])) call abort()
125 
  if (any (j(2)%c2 /= [46011,46012,46013])) call abort()
126 
 
127 
  ! Check argument passing (dummy processing)
128 
  call test2(a,b,c,d,ap,bp,e,f,g,h,i,j,2)
129 
 
130 
contains
131 
  subroutine test2(x1,x2,x3,x4,x1p,x2p,x6,x7,x8,x9,x10,x11,n)
132 
    integer, allocatable :: x1(:)
133 
    integer, allocatable :: x2
134 
    integer, pointer :: x1p(:)
135 
    integer, pointer :: x2p
136 
    integer :: x3
137 
    integer :: x4(3)
138 
    integer :: n
139 
    integer :: x5(n)
140 
    type(t) :: x6,x7(2)
141 
    type(t),allocatable :: x8,x9(:)
142 
    type(t),pointer :: x10,x11(:)
143 
    type(t) :: x12(n)
144 
 
145 
    namelist /nml2/ x1, x2, x3, x4,x5,x1p,x2p,x6,x7,x8,x9,x10,x11,x12
146 
 
147 
    x5 = [ 42, 53 ]
148 
 
149 
    x12(1)%c1 = 37001
150 
    x12(2)%c1 = 37002
151 
    x12(1)%c2 = [47001,47002,47003]
152 
    x12(2)%c2 = [47011,47012,47013]
153 
 
154 
    ! SAVE NAMELIST
155 
    str = repeat('X', len(str))
156 
    write(str,nml=nml2)
157 
 
158 
    ! RESET NAMELIST
159 
    x1 = [-1,-1]
160 
    x1p = [-1, -1]
161 
    x2 = -1
162 
    x2p = -1
163 
    x3 = -1
164 
    x4 = [-1, -1, -1]
165 
 
166 
    x6%c1 = -1
167 
    x6%c2 = [-1,-1,-1]
168 
    x7(1)%c1 = -1
169 
    x7(2)%c1 = -1
170 
    x7(1)%c2 = [-1,-1,-1]
171 
    x7(2)%c2 = [-1,-1,-1]
172 
 
173 
    x8%c1 = -1
174 
    x8%c2 = [-1,-1,-1]
175 
    x9(1)%c1 = -1
176 
    x9(2)%c1 = -1
177 
    x9(1)%c2 = [-1,-1,-1]
178 
    x9(2)%c2 = [-1,-1,-1]
179 
 
180 
    x10%c1 = -1
181 
    x10%c2 = [-1,-1,-1]
182 
    x11(1)%c1 = -1
183 
    x11(2)%c1 = -1
184 
    x11(1)%c2 = [-1,-1,-1]
185 
    x11(2)%c2 = [-1,-1,-1]
186 
 
187 
    x5 = [ -1, -1 ]
188 
 
189 
    x12(1)%c1 = -1
190 
    x12(2)%c1 = -1
191 
    x12(1)%c2 = [-1,-1,-1]
192 
    x12(2)%c2 = [-1,-1,-1]
193 
 
194 
    ! Read back
195 
    read(str,nml=nml2)
196 
 
197 
    ! Check result
198 
    if (any (x1 /= [1,2])) call abort()
199 
    if (any (x1p /= [98, 99])) call abort()
200 
    if (x2 /= 7) call abort()
201 
    if (x2p /= 101) call abort()
202 
    if (x3 /= 8) call abort()
203 
    if (any (x4 /= [-1, -2, -3])) call abort()
204 
 
205 
    if (x6%c1 /= -701) call abort()
206 
    if (any (x6%c2 /= [-702,-703,-704])) call abort()
207 
    if (x7(1)%c1 /= 33001) call abort()
208 
    if (x7(2)%c1 /= 33002) call abort()
209 
    if (any (x7(1)%c2 /= [44001,44002,44003])) call abort()
210 
    if (any (x7(2)%c2 /= [44011,44012,44013])) call abort()
211 
 
212 
    if (x8%c1 /= -601) call abort()
213 
    if (any(x8%c2 /= [-602,6703,-604])) call abort()
214 
    if (x9(1)%c1 /= 35001) call abort()
215 
    if (x9(2)%c1 /= 35002) call abort()
216 
    if (any (x9(1)%c2 /= [45001,45002,45003])) call abort()
217 
    if (any (x9(2)%c2 /= [45011,45012,45013])) call abort()
218 
 
219 
    if (x10%c1 /= -501) call abort()
220 
    if (any (x10%c2 /= [-502,-503,-504])) call abort()
221 
    if (x11(1)%c1 /= 36001) call abort()
222 
    if (x11(2)%c1 /= 36002) call abort()
223 
    if (any (x11(1)%c2 /= [46001,46002,46003])) call abort()
224 
    if (any (x11(2)%c2 /= [46011,46012,46013])) call abort()
225 
 
226 
    if (any (x5 /= [ 42, 53 ])) call abort()
227 
 
228 
    if (x12(1)%c1 /= 37001) call abort()
229 
    if (x12(2)%c1 /= 37002) call abort()
230 
    if (any (x12(1)%c2 /= [47001,47002,47003])) call abort()
231 
    if (any (x12(2)%c2 /= [47011,47012,47013])) call abort()
232 
  end subroutine test2
233 
end program nml_test

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.