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

Subversion Repositories openrisc

[/] [openrisc/] [trunk/] [gnu-dev/] [or1k-gcc/] [gcc/] [testsuite/] [gfortran.dg/] [g77/] [f90-intrinsic-bit.f] - Blame information for rev 801

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

Line No. Rev Author Line
1 694 jeremybenn 
c { dg-do run }
2 
c  f90-intrinsic-bit.f
3 
c
4 
c Test Fortran 90
5 
c  * intrinsic bit manipulation functions - Section 13.10.10
6 
c  * bitcopy subroutine - Section 13.9.3
7 
c David Billinghurst <David.Billinghurst@riotinto.com>
8 
c
9 
c Notes:
10 
c  * g77 only supports scalar arguments
11 
c  * third argument of ISHFTC is not optional in g77
12 
 
13 
      logical fail
14 
      integer   i, i2, ia, i3
15 
      integer(kind=2) j, j2, j3, ja
16 
      integer(kind=1) k, k2, k3, ka
17 
      integer(kind=8) m, m2, m3, ma
18 
 
19 
      common /flags/ fail
20 
      fail = .false.
21 
 
22 
c     BIT_SIZE - Section 13.13.16
23 
c     Determine BIT_SIZE by counting the bits
24 
      ia = 0
25 
      i = 0
26 
      i = not(i)
27 
      do while ( (i.ne.0) .and. (ia.lt.127) )
28 
         ia = ia + 1
29 
         i = ishft(i,-1)
30 
      end do
31 
      call c_i(BIT_SIZE(i),ia,'BIT_SIZE(integer)')
32 
      ja = 0
33 
      j = 0
34 
      j = not(j)
35 
      do while  ( (j.ne.0) .and. (ja.lt.127) )
36 
         ja = ja + 1
37 
         j = ishft(j,-1)
38 
      end do
39 
      call c_i2(BIT_SIZE(j),ja,'BIT_SIZE(integer(2))')
40 
      ka = 0
41 
      k = 0
42 
      k = not(k)
43 
      do while ( (k.ne.0) .and. (ka.lt.127) )
44 
         ka = ka + 1
45 
         k = ishft(k,-1)
46 
      end do
47 
      call c_i1(BIT_SIZE(k),ka,'BIT_SIZE(integer(1))')
48 
      ma = 0
49 
      m = 0
50 
      m = not(m)
51 
      do while ( (m.ne.0) .and. (ma.lt.127) )
52 
         ma = ma + 1
53 
         m = ishft(m,-1)
54 
      end do
55 
      call c_i8(BIT_SIZE(m),ma,'BIT_SIZE(integer(8))')
56 
 
57 
c     BTEST  - Section 13.13.17
58 
      j  = 7
59 
      j2 = 3
60 
      k  = 7
61 
      k2 = 3
62 
      m  = 7
63 
      m2 = 3
64 
      call c_l(BTEST(7,3),.true.,'BTEST(integer,integer)')
65 
      call c_l(BTEST(7,j2),.true.,'BTEST(integer,integer(2))')
66 
      call c_l(BTEST(7,k2),.true.,'BTEST(integer,integer(1))')
67 
      call c_l(BTEST(7,m2),.true.,'BTEST(integer,integer(8))')
68 
      call c_l(BTEST(j,3),.true.,'BTEST(integer(2),integer)')
69 
      call c_l(BTEST(j,j2),.true.,'BTEST(integer(2),integer(2))')
70 
      call c_l(BTEST(j,k2),.true.,'BTEST(integer(2),integer(1))')
71 
      call c_l(BTEST(j,m2),.true.,'BTEST(integer(2),integer(8))')
72 
      call c_l(BTEST(k,3),.true.,'BTEST(integer(1),integer)')
73 
      call c_l(BTEST(k,j2),.true.,'BTEST(integer(1),integer(2))')
74 
      call c_l(BTEST(k,k2),.true.,'BTEST(integer(1),integer(1))')
75 
      call c_l(BTEST(k,m2),.true.,'BTEST(integer(1),integer(8))')
76 
      call c_l(BTEST(m,3),.true.,'BTEST(integer(8),integer)')
77 
      call c_l(BTEST(m,j2),.true.,'BTEST(integer(8),integer(2))')
78 
      call c_l(BTEST(m,k2),.true.,'BTEST(integer(8),integer(1))')
79 
      call c_l(BTEST(m,m2),.true.,'BTEST(integer(8),integer(8))')
80 
 
81 
c     IAND   - Section 13.13.40
82 
      j  = 3
83 
      j2 = 1
84 
      ja = 1
85 
      k  = 3
86 
      k2 = 1
87 
      ka = 1
88 
      m  = 3
89 
      m2 = 1
90 
      ma = 1
91 
      call c_i(IAND(3,1),1,'IAND(integer,integer)')
92 
      call c_i2(IAND(j,j2),ja,'IAND(integer(2),integer(2)')
93 
      call c_i1(IAND(k,k2),ka,'IAND(integer(1),integer(1))')
94 
      call c_i8(IAND(m,m2),ma,'IAND(integer(8),integer(8))')
95 
 
96 
 
97 
c     IBCLR  - Section 13.13.41
98 
      j  = 14
99 
      j2 = 1
100 
      ja = 12
101 
      k  = 14
102 
      k2 = 1
103 
      ka = 12
104 
      m  = 14
105 
      m2 = 1
106 
      ma = 12
107 
      call c_i(IBCLR(14,1),12,'IBCLR(integer,integer)')
108 
      call c_i(IBCLR(14,j2),12,'IBCLR(integer,integer(2))')
109 
      call c_i(IBCLR(14,k2),12,'IBCLR(integer,integer(1))')
110 
      call c_i(IBCLR(14,m2),12,'IBCLR(integer,integer(8))')
111 
      call c_i2(IBCLR(j,1),ja,'IBCLR(integer(2),integer)')
112 
      call c_i2(IBCLR(j,j2),ja,'IBCLR(integer(2),integer(2))')
113 
      call c_i2(IBCLR(j,k2),ja,'IBCLR(integer(2),integer(1))')
114 
      call c_i2(IBCLR(j,m2),ja,'IBCLR(integer(2),integer(8))')
115 
      call c_i1(IBCLR(k,1),ka,'IBCLR(integer(1),integer)')
116 
      call c_i1(IBCLR(k,j2),ka,'IBCLR(integer(1),integer(2))')
117 
      call c_i1(IBCLR(k,k2),ka,'IBCLR(integer(1),integer(1))')
118 
      call c_i1(IBCLR(k,m2),ka,'IBCLR(integer(1),integer(8))')
119 
      call c_i8(IBCLR(m,1),ma,'IBCLR(integer(8),integer)')
120 
      call c_i8(IBCLR(m,j2),ma,'IBCLR(integer(8),integer(2))')
121 
      call c_i8(IBCLR(m,k2),ma,'IBCLR(integer(8),integer(1))')
122 
      call c_i8(IBCLR(m,m2),ma,'IBCLR(integer(8),integer(8))')
123 
 
124 
c     IBSET  - Section 13.13.43
125 
      j  = 12
126 
      j2 = 1
127 
      ja = 14
128 
      k  = 12
129 
      k2 = 1
130 
      ka = 14
131 
      m  = 12
132 
      m2 = 1
133 
      ma = 14
134 
      call c_i(IBSET(12,1),14,'IBSET(integer,integer)')
135 
      call c_i(IBSET(12,j2),14,'IBSET(integer,integer(2))')
136 
      call c_i(IBSET(12,k2),14,'IBSET(integer,integer(1))')
137 
      call c_i(IBSET(12,m2),14,'IBSET(integer,integer(8))')
138 
      call c_i2(IBSET(j,1),ja,'IBSET(integer(2),integer)')
139 
      call c_i2(IBSET(j,j2),ja,'IBSET(integer(2),integer(2))')
140 
      call c_i2(IBSET(j,k2),ja,'IBSET(integer(2),integer(1))')
141 
      call c_i2(IBSET(j,m2),ja,'IBSET(integer(2),integer(8))')
142 
      call c_i1(IBSET(k,1),ka,'IBSET(integer(1),integer)')
143 
      call c_i1(IBSET(k,j2),ka,'IBSET(integer(1),integer(2))')
144 
      call c_i1(IBSET(k,k2),ka,'IBSET(integer(1),integer(1))')
145 
      call c_i1(IBSET(k,m2),ka,'IBSET(integer(1),integer(8))')
146 
      call c_i8(IBSET(m,1),ma,'IBSET(integer(8),integer)')
147 
      call c_i8(IBSET(m,j2),ma,'IBSET(integer(8),integer(2))')
148 
      call c_i8(IBSET(m,k2),ma,'IBSET(integer(8),integer(1))')
149 
      call c_i8(IBSET(m,m2),ma,'IBSET(integer(8),integer(8))')
150 
 
151 
c     IEOR   - Section 13.13.45
152 
      j  = 3
153 
      j2 = 1
154 
      ja = 2
155 
      k  = 3
156 
      k2 = 1
157 
      ka = 2
158 
      m  = 3
159 
      m2 = 1
160 
      ma = 2
161 
      call c_i(IEOR(3,1),2,'IEOR(integer,integer)')
162 
      call c_i2(IEOR(j,j2),ja,'IEOR(integer(2),integer(2))')
163 
      call c_i1(IEOR(k,k2),ka,'IEOR(integer(1),integer(1))')
164 
      call c_i8(IEOR(m,m2),ma,'IEOR(integer(8),integer(8))')
165 
 
166 
c     ISHFT  - Section 13.13.49
167 
      i  = 3
168 
      i2 = 1
169 
      i3 = 0
170 
      ia = 6
171 
      j  = 3
172 
      j2 = 1
173 
      j3 = 0
174 
      ja = 6
175 
      k  = 3
176 
      k2 = 1
177 
      k3 = 0
178 
      ka = 6
179 
      m  = 3
180 
      m2 = 1
181 
      m3 = 0
182 
      ma = 6
183 
      call c_i(ISHFT(i,i2),ia,'ISHFT(integer,integer)')
184 
      call c_i(ISHFT(i,BIT_SIZE(i)),i3,'ISHFT(integer,integer) 2')
185 
      call c_i(ISHFT(i,-BIT_SIZE(i)),i3,'ISHFT(integer,integer) 3')
186 
      call c_i(ISHFT(i,0),i,'ISHFT(integer,integer) 4')
187 
      call c_i2(ISHFT(j,j2),ja,'ISHFT(integer(2),integer(2))')
188 
      call c_i2(ISHFT(j,BIT_SIZE(j)),j3,
189 
     $     'ISHFT(integer(2),integer(2)) 2')
190 
      call c_i2(ISHFT(j,-BIT_SIZE(j)),j3,
191 
     $     'ISHFT(integer(2),integer(2)) 3')
192 
      call c_i2(ISHFT(j,0),j,'ISHFT(integer(2),integer(2)) 4')
193 
      call c_i1(ISHFT(k,k2),ka,'ISHFT(integer(1),integer(1))')
194 
      call c_i1(ISHFT(k,BIT_SIZE(k)),k3,
195 
     $     'ISHFT(integer(1),integer(1)) 2')
196 
      call c_i1(ISHFT(k,-BIT_SIZE(k)),k3,
197 
     $     'ISHFT(integer(1),integer(1)) 3')
198 
      call c_i1(ISHFT(k,0),k,'ISHFT(integer(1),integer(1)) 4')
199 
      call c_i8(ISHFT(m,m2),ma,'ISHFT(integer(8),integer(8))')
200 
      call c_i8(ISHFT(m,BIT_SIZE(m)),m3,
201 
     $     'ISHFT(integer(8),integer(8)) 2')
202 
      call c_i8(ISHFT(m,-BIT_SIZE(m)),m3,
203 
     $     'ISHFT(integer(8),integer(8)) 3')
204 
      call c_i8(ISHFT(m,0),m,'ISHFT(integer(8),integer(8)) 4')
205 
 
206 
c     ISHFTC - Section 13.13.50
207 
c     The third argument is not optional in g77
208 
      i  = 3
209 
      i2 = 2
210 
      i3 = 3
211 
      ia = 5
212 
      j  = 3
213 
      j2 = 2
214 
      j3 = 3
215 
      ja = 5
216 
      k  = 3
217 
      k2 = 2
218 
      k3 = 3
219 
      ka = 5
220 
      m2 = 2
221 
      m3 = 3
222 
      ma = 5
223 
c     test all the combinations of arguments
224 
      call c_i(ISHFTC(i,i2,i3),5,'ISHFTC(integer,integer,integer)')
225 
      call c_i(ISHFTC(i,i2,j3),5,'ISHFTC(integer,integer,integer(2))')
226 
      call c_i(ISHFTC(i,i2,k3),5,'ISHFTC(integer,integer,integer(1))')
227 
      call c_i(ISHFTC(i,i2,m3),5,'ISHFTC(integer,integer,integer(8))')
228 
      call c_i(ISHFTC(i,j2,i3),5,'ISHFTC(integer,integer(2),integer)')
229 
      call c_i(ISHFTC(i,j2,j3),5,
230 
     &  'ISHFTC(integer,integer(2),integer(2))')
231 
      call c_i(ISHFTC(i,j2,k3),5,
232 
     &  'ISHFTC(integer,integer(2),integer(1))')
233 
      call c_i(ISHFTC(i,j2,m3),5,
234 
     &  'ISHFTC(integer,integer(2),integer(8))')
235 
      call c_i(ISHFTC(i,k2,i3),5,'ISHFTC(integer,integer(1),integer)')
236 
      call c_i(ISHFTC(i,k2,j3),5,
237 
     &  'ISHFTC(integer,integer(1),integer(2))')
238 
      call c_i(ISHFTC(i,k2,k3),5,
239 
     &  'ISHFTC(integer,integer(1),integer(1))')
240 
      call c_i(ISHFTC(i,k2,m3),5,
241 
     &  'ISHFTC(integer,integer(1),integer(8))')
242 
      call c_i(ISHFTC(i,m2,i3),5,'ISHFTC(integer,integer(8),integer)')
243 
      call c_i(ISHFTC(i,m2,j3),5,
244 
     &  'ISHFTC(integer,integer(8),integer(2))')
245 
      call c_i(ISHFTC(i,m2,k3),5,
246 
     &  'ISHFTC(integer,integer(8),integer(1))')
247 
      call c_i(ISHFTC(i,m2,m3),5,
248 
     &  'ISHFTC(integer,integer(8),integer(8))')
249 
 
250 
      call c_i2(ISHFTC(j,i2,i3),ja,'ISHFTC(integer(2),integer,integer)')
251 
      call c_i2(ISHFTC(j,i2,j3),ja,
252 
     $     'ISHFTC(integer(2),integer,integer(2))')
253 
      call c_i2(ISHFTC(j,i2,k3),ja,
254 
     $     'ISHFTC(integer(2),integer,integer(1))')
255 
      call c_i2(ISHFTC(j,i2,m3),ja,
256 
     $     'ISHFTC(integer(2),integer,integer(8))')
257 
      call c_i2(ISHFTC(j,j2,i3),ja,
258 
     $     'ISHFTC(integer(2),integer(2),integer)')
259 
      call c_i2(ISHFTC(j,j2,j3),ja,
260 
     $     'ISHFTC(integer(2),integer(2),integer(2))')
261 
      call c_i2(ISHFTC(j,j2,k3),ja,
262 
     $     'ISHFTC(integer(2),integer(2),integer(1))')
263 
      call c_i2(ISHFTC(j,j2,m3),ja,
264 
     $     'ISHFTC(integer(2),integer(2),integer(8))')
265 
      call c_i2(ISHFTC(j,k2,i3),ja,
266 
     $     'ISHFTC(integer(2),integer(1),integer)')
267 
      call c_i2(ISHFTC(j,k2,j3),ja,
268 
     $     'ISHFTC(integer(2),integer(1),integer(2))')
269 
      call c_i2(ISHFTC(j,k2,k3),ja,
270 
     $     'ISHFTC(integer(2),integer(1),integer(1))')
271 
      call c_i2(ISHFTC(j,k2,m3),ja,
272 
     $     'ISHFTC(integer(2),integer(1),integer(8))')
273 
      call c_i2(ISHFTC(j,m2,i3),ja,
274 
     $     'ISHFTC(integer(2),integer(8),integer)')
275 
      call c_i2(ISHFTC(j,m2,j3),ja,
276 
     $     'ISHFTC(integer(2),integer(8),integer(2))')
277 
      call c_i2(ISHFTC(j,m2,k3),ja,
278 
     $     'ISHFTC(integer(2),integer(8),integer(1))')
279 
      call c_i2(ISHFTC(j,m2,m3),ja,
280 
     $     'ISHFTC(integer(2),integer(8),integer(8))')
281 
 
282 
      call c_i1(ISHFTC(k,i2,i3),ka,'ISHFTC(integer(1),integer,integer)')
283 
      call c_i1(ISHFTC(k,i2,j3),ka,
284 
     $     'ISHFTC(integer(1),integer,integer(2))')
285 
      call c_i1(ISHFTC(k,i2,k3),ka,
286 
     $     'ISHFTC(integer(1),integer,integer(1))')
287 
      call c_i1(ISHFTC(k,i2,m3),ka,
288 
     $     'ISHFTC(integer(1),integer,integer(8))')
289 
      call c_i1(ISHFTC(k,j2,i3),ka,
290 
     $     'ISHFTC(integer(1),integer(2),integer)')
291 
      call c_i1(ISHFTC(k,j2,j3),ka,
292 
     $     'ISHFTC(integer(1),integer(2),integer(2))')
293 
      call c_i1(ISHFTC(k,j2,k3),ka,
294 
     $     'ISHFTC(integer(1),integer(2),integer(1))')
295 
      call c_i1(ISHFTC(k,j2,m3),ka,
296 
     $     'ISHFTC(integer(1),integer(2),integer(8))')
297 
      call c_i1(ISHFTC(k,k2,i3),ka,
298 
     $     'ISHFTC(integer(1),integer(1),integer)')
299 
      call c_i1(ISHFTC(k,k2,j3),ka,
300 
     $     'ISHFTC(integer(1),integer(1),integer(2))')
301 
      call c_i1(ISHFTC(k,k2,k3),ka,
302 
     $     'ISHFTC(integer(1),integer(1),integer(1))')
303 
      call c_i1(ISHFTC(k,k2,m3),ka,
304 
     $     'ISHFTC(integer(1),integer(1),integer(8))')
305 
      call c_i1(ISHFTC(k,m2,i3),ka,
306 
     $     'ISHFTC(integer(1),integer(8),integer)')
307 
      call c_i1(ISHFTC(k,m2,j3),ka,
308 
     $     'ISHFTC(integer(1),integer(8),integer(2))')
309 
      call c_i1(ISHFTC(k,m2,k3),ka,
310 
     $     'ISHFTC(integer(1),integer(8),integer(1))')
311 
      call c_i1(ISHFTC(k,m2,m3),ka,
312 
     $     'ISHFTC(integer(1),integer(8),integer(8))')
313 
 
314 
      call c_i8(ISHFTC(m,i2,i3),ma,'ISHFTC(integer(8),integer,integer)')
315 
      call c_i8(ISHFTC(m,i2,j3),ma,
316 
     $     'ISHFTC(integer(8),integer,integer(2))')
317 
      call c_i8(ISHFTC(m,i2,k3),ma,
318 
     $     'ISHFTC(integer(8),integer,integer(1))')
319 
      call c_i8(ISHFTC(m,i2,m3),ma,
320 
     $     'ISHFTC(integer(8),integer,integer(8))')
321 
      call c_i8(ISHFTC(m,j2,i3),ma,
322 
     $     'ISHFTC(integer(8),integer(2),integer)')
323 
      call c_i8(ISHFTC(m,j2,j3),ma,
324 
     $     'ISHFTC(integer(8),integer(2),integer(2))')
325 
      call c_i8(ISHFTC(m,j2,k3),ma,
326 
     $     'ISHFTC(integer(8),integer(2),integer(1))')
327 
      call c_i8(ISHFTC(m,j2,m3),ma,
328 
     $     'ISHFTC(integer(8),integer(2),integer(8))')
329 
      call c_i8(ISHFTC(m,k2,i3),ma,
330 
     $     'ISHFTC(integer(8),integer(1),integer)')
331 
      call c_i8(ISHFTC(m,k2,j3),ma,
332 
     $     'ISHFTC(integer(1),integer(8),integer(2))')
333 
      call c_i8(ISHFTC(m,k2,k3),ma,
334 
     $     'ISHFTC(integer(1),integer(8),integer(1))')
335 
      call c_i8(ISHFTC(m,k2,m3),ma,
336 
     $     'ISHFTC(integer(1),integer(8),integer(8))')
337 
      call c_i8(ISHFTC(m,m2,i3),ma,
338 
     $     'ISHFTC(integer(8),integer(8),integer)')
339 
      call c_i8(ISHFTC(m,m2,j3),ma,
340 
     $     'ISHFTC(integer(8),integer(8),integer(2))')
341 
      call c_i8(ISHFTC(m,m2,k3),ma,
342 
     $     'ISHFTC(integer(8),integer(8),integer(1))')
343 
      call c_i8(ISHFTC(m,m2,m3),ma,
344 
     $     'ISHFTC(integer(8),integer(8),integer(8))')
345 
 
346 
c     test the corner cases
347 
      call c_i(ISHFTC(i,BIT_SIZE(i),BIT_SIZE(i)),i,
348 
     $     'ISHFTC(i,BIT_SIZE(i),BIT_SIZE(i)) i = integer')
349 
      call c_i(ISHFTC(i,0,BIT_SIZE(i)),i,
350 
     $     'ISHFTC(i,0,BIT_SIZE(i)) i = integer')
351 
      call c_i(ISHFTC(i,-BIT_SIZE(i),BIT_SIZE(i)),i,
352 
     $     'ISHFTC(i,-BIT_SIZE(i),BIT_SIZE(i)) i = integer')
353 
      call c_i2(ISHFTC(j,BIT_SIZE(j),BIT_SIZE(j)),j,
354 
     $     'ISHFTC(j,BIT_SIZE(j),BIT_SIZE(j)) j = integer(2)')
355 
      call c_i2(ISHFTC(j,0,BIT_SIZE(j)),j,
356 
     $     'ISHFTC(j,0,BIT_SIZE(j)) j = integer(2)')
357 
      call c_i2(ISHFTC(j,-BIT_SIZE(j),BIT_SIZE(j)),j,
358 
     $     'ISHFTC(j,-BIT_SIZE(j),BIT_SIZE(j)) j = integer(2)')
359 
      call c_i1(ISHFTC(k,BIT_SIZE(k),BIT_SIZE(k)),k,
360 
     $     'ISHFTC(k,BIT_SIZE(k),BIT_SIZE(k)) k = integer(1)')
361 
      call c_i1(ISHFTC(k,0,BIT_SIZE(k)),k,
362 
     $     'ISHFTC(k,0,BIT_SIZE(k)) k = integer(1)')
363 
      call c_i1(ISHFTC(k,-BIT_SIZE(k),BIT_SIZE(k)),k,
364 
     $     'ISHFTC(k,-BIT_SIZE(k),BIT_SIZE(k)) k = integer(1)')
365 
      call c_i8(ISHFTC(m,BIT_SIZE(m),BIT_SIZE(m)),m,
366 
     $     'ISHFTC(m,BIT_SIZE(m),BIT_SIZE(m)) m = integer(8)')
367 
      call c_i8(ISHFTC(m,0,BIT_SIZE(m)),m,
368 
     $     'ISHFTC(m,0,BIT_SIZE(m)) m = integer(8)')
369 
      call c_i8(ISHFTC(m,-BIT_SIZE(m),BIT_SIZE(m)),m,
370 
     $     'ISHFTC(m,-BIT_SIZE(m),BIT_SIZE(m)) m = integer(8)')
371 
 
372 
c     MVBITS - Section 13.13.74
373 
      i = 6
374 
      call MVBITS(7,2,2,i,0)
375 
      call c_i(i,5,'MVBITS 1')
376 
      j = 6
377 
      j2 = 7
378 
      ja = 5
379 
      call MVBITS(j2,2,2,j,0)
380 
      call c_i2(j,ja,'MVBITS 2')
381 
      k = 6
382 
      k2 = 7
383 
      ka = 5
384 
      call MVBITS(k2,2,2,k,0)
385 
      call c_i1(k,ka,'MVBITS 3')
386 
      m = 6
387 
      m2 = 7
388 
      ma = 5
389 
      call MVBITS(m2,2,2,m,0)
390 
      call c_i8(m,ma,'MVBITS 4')
391 
 
392 
c     NOT    - Section 13.13.77
393 
c     Rather than assume integer sizes, mask off high bits
394 
      j  = 21
395 
      j2 = 31
396 
      ja = 10
397 
      k  = 21
398 
      k2 = 31
399 
      ka = 10
400 
      m  = 21
401 
      m2 = 31
402 
      ma = 10
403 
      call c_i(IAND(NOT(21),31),10,'NOT(integer)')
404 
      call c_i2(IAND(NOT(j),j2),ja,'NOT(integer(2))')
405 
      call c_i1(IAND(NOT(k),k2),ka,'NOT(integer(1))')
406 
      call c_i8(IAND(NOT(m),m2),ma,'NOT(integer(8))')
407 
 
408 
      if ( fail ) call abort()
409 
      end
410 
 
411 
      subroutine failure(label)
412 
c     Report failure and set flag
413 
      character*(*) label
414 
      logical fail
415 
      common /flags/ fail
416 
      write(6,'(a,a,a)') 'Test ',label,' FAILED'
417 
      fail = .true.
418 
      end
419 
 
420 
      subroutine c_l(i,j,label)
421 
c     Check if LOGICAL i equals j, and fail otherwise
422 
      logical i,j
423 
      character*(*) label
424 
      if ( i .eqv. j ) then
425 
         call failure(label)
426 
         write(6,*) 'Got ',i,' expected ', j
427 
      end if
428 
      end
429 
 
430 
      subroutine c_i(i,j,label)
431 
c     Check if INTEGER i equals j, and fail otherwise
432 
      integer i,j
433 
      character*(*) label
434 
      if ( i .ne. j ) then
435 
         call failure(label)
436 
         write(6,*) 'Got ',i,' expected ', j
437 
      end if
438 
      end
439 
 
440 
      subroutine c_i2(i,j,label)
441 
c     Check if INTEGER(kind=2) i equals j, and fail otherwise
442 
      integer(kind=2) i,j
443 
      character*(*) label
444 
      if ( i .ne. j ) then
445 
         call failure(label)
446 
         write(6,*) 'Got ',i,' expected ', j
447 
      end if
448 
      end
449 
 
450 
      subroutine c_i1(i,j,label)
451 
c     Check if INTEGER(kind=1) i equals j, and fail otherwise
452 
      integer(kind=1) i,j
453 
      character*(*) label
454 
      if ( i .ne. j ) then
455 
         call failure(label)
456 
         write(6,*) 'Got ',i,' expected ', j
457 
      end if
458 
      end
459 
 
460 
      subroutine c_i8(i,j,label)
461 
c     Check if INTEGER(kind=8) i equals j, and fail otherwise
462 
      integer(kind=8) i,j
463 
      character*(*) label
464 
      if ( i .ne. j ) then
465 
         call failure(label)
466 
         write(6,*) 'Got ',i,' expected ', j
467 
      end if
468 
      end

powered by: WebSVN 2.1.0

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