HCoop / bpt / guile.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Change Guile license to LGPLv3+
[bpt/guile.git] / test-suite / tests / srfi-60.test
CommitLineData
17e69f21
KR		 1;;;; srfi-60.test --- Test suite for Guile's SRFI-60 functions. -*- scheme -*-
2;;;;
6e7d5622 3;;;; Copyright 2005, 2006 Free Software Foundation, Inc.
17e69f21 4;;;;
53befeb7
NJ		 5;;;; This library is free software; you can redistribute it and/or
6;;;; modify it under the terms of the GNU Lesser General Public
7;;;; License as published by the Free Software Foundation; either
8;;;; version 3 of the License, or (at your option) any later version.
9;;;;
10;;;; This library is distributed in the hope that it will be useful,
17e69f21 11;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
53befeb7
NJ		 12;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
13;;;; Lesser General Public License for more details.
14;;;;
15;;;; You should have received a copy of the GNU Lesser General Public
16;;;; License along with this library; if not, write to the Free Software
17;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
17e69f21
KR		 18
19(define-module (test-srfi-60)
23f2b9a3 20 #:duplicates (last) ;; avoid warning about srfi-60 replacing `bit-count'
17e69f21
KR		 21 #:use-module (test-suite lib)
22 #:use-module (srfi srfi-60))
23
24
25(pass-if "cond-expand srfi-60"
26 (cond-expand (srfi-60 #t)
27 (else #f)))
28
29;;
30;; logand
31;;
32
33(with-test-prefix "logand"
34 (pass-if (eqv? 6 (logand 14 6))))
35
36;;
37;; bitwise-and
38;;
39
40(with-test-prefix "bitwise-and"
41 (pass-if (eqv? 6 (bitwise-and 14 6))))
42
43;;
44;; logior
45;;
46
47(with-test-prefix "logior"
48 (pass-if (eqv? 14 (logior 10 12))))
49
50;;
51;; bitwise-ior
52;;
53
54(with-test-prefix "bitwise-ior"
55 (pass-if (eqv? 14 (bitwise-ior 10 12))))
56
57;;
58;; logxor
59;;
60
61(with-test-prefix "logxor"
62 (pass-if (eqv? 6 (logxor 10 12))))
63
64;;
65;; bitwise-xor
66;;
67
68(with-test-prefix "bitwise-xor"
69 (pass-if (eqv? 6 (bitwise-xor 10 12))))
70
71;;
72;; lognot
73;;
74
75(with-test-prefix "lognot"
76 (pass-if (eqv? -1 (lognot 0)))
77 (pass-if (eqv? 0 (lognot -1))))
78
79;;
80;; bitwise-not
81;;
82
83(with-test-prefix "bitwise-not"
84 (pass-if (eqv? -1 (bitwise-not 0)))
85 (pass-if (eqv? 0 (bitwise-not -1))))
86
87;;
88;; bitwise-if
89;;
90
91(with-test-prefix "bitwise-if"
92 (pass-if (eqv? 9 (bitwise-if 3 1 8)))
93 (pass-if (eqv? 0 (bitwise-if 3 8 1))))
94
95;;
96;; bitwise-merge
97;;
98
99(with-test-prefix "bitwise-merge"
100 (pass-if (eqv? 9 (bitwise-merge 3 1 8)))
101 (pass-if (eqv? 0 (bitwise-merge 3 8 1))))
102
103;;
104;; logtest
105;;
106
107(with-test-prefix "logtest"
108 (pass-if (eq? #t (logtest 3 6)))
109 (pass-if (eq? #f (logtest 3 12))))
110
111;;
112;; any-bits-set?
113;;
114
115(with-test-prefix "any-bits-set?"
116 (pass-if (eq? #t (any-bits-set? 3 6)))
117 (pass-if (eq? #f (any-bits-set? 3 12))))
118
119;;
120;; logcount
121;;
122
123(with-test-prefix "logcount"
124 (pass-if (eqv? 2 (logcount 12))))
125
126;;
127;; bit-count
128;;
129
130(with-test-prefix "bit-count"
131 (pass-if (eqv? 2 (bit-count 12))))
132
133;;
134;; integer-length
135;;
136
137(with-test-prefix "integer-length"
138 (pass-if (eqv? 0 (integer-length 0)))
139 (pass-if (eqv? 8 (integer-length 128)))
140 (pass-if (eqv? 8 (integer-length 255)))
141 (pass-if (eqv? 9 (integer-length 256))))
142
143;;
144;; log2-binary-factors
145;;
146
147(with-test-prefix "log2-binary-factors"
148 (pass-if (eqv? -1 (log2-binary-factors 0)))
149 (pass-if (eqv? 0 (log2-binary-factors 1)))
150 (pass-if (eqv? 0 (log2-binary-factors 3)))
151 (pass-if (eqv? 2 (log2-binary-factors 4)))
152 (pass-if (eqv? 1 (log2-binary-factors 6)))
153 (pass-if (eqv? 0 (log2-binary-factors -1)))
154 (pass-if (eqv? 1 (log2-binary-factors -2)))
155 (pass-if (eqv? 0 (log2-binary-factors -3)))
156 (pass-if (eqv? 2 (log2-binary-factors -4)))
157 (pass-if (eqv? 128 (log2-binary-factors #x100000000000000000000000000000000))))
158
159;;
160;; first-set-bit
161;;
162
163(with-test-prefix "first-set-bit"
164 (pass-if (eqv? -1 (first-set-bit 0)))
165 (pass-if (eqv? 0 (first-set-bit 1)))
166 (pass-if (eqv? 0 (first-set-bit 3)))
167 (pass-if (eqv? 2 (first-set-bit 4)))
168 (pass-if (eqv? 1 (first-set-bit 6)))
169 (pass-if (eqv? 0 (first-set-bit -1)))
170 (pass-if (eqv? 1 (first-set-bit -2)))
171 (pass-if (eqv? 0 (first-set-bit -3)))
172 (pass-if (eqv? 2 (first-set-bit -4))))
173
174;;
175;; logbit?
176;;
177
178(with-test-prefix "logbit?"
179 (pass-if (eq? #t (logbit? 0 1)))
180 (pass-if (eq? #f (logbit? 1 1)))
181 (pass-if (eq? #f (logbit? 1 8)))
182 (pass-if (eq? #t (logbit? 1000 -1))))
183
184;;
185;; bit-set?
186;;
187
188(with-test-prefix "bit-set?"
189 (pass-if (eq? #t (bit-set? 0 1)))
190 (pass-if (eq? #f (bit-set? 1 1)))
191 (pass-if (eq? #f (bit-set? 1 8)))
192 (pass-if (eq? #t (bit-set? 1000 -1))))
193
194;;
195;; copy-bit
196;;
197
198(with-test-prefix "copy-bit"
199 (pass-if (eqv? 0 (copy-bit 0 0 #f)))
200 (pass-if (eqv? 0 (copy-bit 30 0 #f)))
201 (pass-if (eqv? 0 (copy-bit 31 0 #f)))
202 (pass-if (eqv? 0 (copy-bit 62 0 #f)))
203 (pass-if (eqv? 0 (copy-bit 63 0 #f)))
204 (pass-if (eqv? 0 (copy-bit 128 0 #f)))
205
206 (pass-if (eqv? -1 (copy-bit 0 -1 #t)))
207 (pass-if (eqv? -1 (copy-bit 30 -1 #t)))
208 (pass-if (eqv? -1 (copy-bit 31 -1 #t)))
209 (pass-if (eqv? -1 (copy-bit 62 -1 #t)))
210 (pass-if (eqv? -1 (copy-bit 63 -1 #t)))
211 (pass-if (eqv? -1 (copy-bit 128 -1 #t)))
212
213 (pass-if (eqv? 1 (copy-bit 0 0 #t)))
214 (pass-if (eqv? #x106 (copy-bit 8 6 #t)))
215 (pass-if (eqv? 6 (copy-bit 8 6 #f)))
216 (pass-if (eqv? -2 (copy-bit 0 -1 #f)))
217
218 (pass-if "bignum becomes inum"
219 (eqv? 0 (copy-bit 128 #x100000000000000000000000000000000 #f)))
220
221 ;; bignums unchanged
222 (pass-if (eqv? #x100000000000000000000000000000000
223 (copy-bit 128 #x100000000000000000000000000000000 #t)))
224 (pass-if (eqv? #x100000000000000000000000000000000
225 (copy-bit 64 #x100000000000000000000000000000000 #f)))
226 (pass-if (eqv? #x-100000000000000000000000000000000
227 (copy-bit 64 #x-100000000000000000000000000000000 #f)))
228 (pass-if (eqv? #x-100000000000000000000000000000000
229 (copy-bit 256 #x-100000000000000000000000000000000 #t))))
230
231;;
232;; bit-field
233;;
234
235(with-test-prefix "bit-field"
236 (pass-if (eqv? 0 (bit-field 6 0 1)))
237 (pass-if (eqv? 3 (bit-field 6 1 3)))
238 (pass-if (eqv? 1 (bit-field 6 2 999)))
239 (pass-if (eqv? 1 (bit-field #x100000000000000000000000000000000 128 129))))
240
241;;
242;; copy-bit-field
243;;
244
245(with-test-prefix "copy-bit-field"
246 (pass-if (eqv? #b111 (copy-bit-field #b110 1 0 1)))
247 (pass-if (eqv? #b110 (copy-bit-field #b110 1 1 2)))
248 (pass-if (eqv? #b010 (copy-bit-field #b110 1 1 3))))
249
250;;
251;; ash
252;;
253
254(with-test-prefix "ash"
255 (pass-if (eqv? 2 (ash 1 1)))
256 (pass-if (eqv? 0 (ash 1 -1))))
257
258;;
259;; arithmetic-shift
260;;
261
262(with-test-prefix "arithmetic-shift"
263 (pass-if (eqv? 2 (arithmetic-shift 1 1)))
264 (pass-if (eqv? 0 (arithmetic-shift 1 -1))))
265
266;;
267;; rotate-bit-field
268;;
269
270(with-test-prefix "rotate-bit-field"
271 (pass-if (eqv? #b110 (rotate-bit-field #b110 1 1 2)))
272 (pass-if (eqv? #b1010 (rotate-bit-field #b110 1 2 4)))
273 (pass-if (eqv? #b1011 (rotate-bit-field #b0111 -1 1 4)))
274
275 (pass-if (eqv? #b0 (rotate-bit-field #b0 128 0 256)))
276 (pass-if (eqv? #b1 (rotate-bit-field #b1 128 1 256)))
277 (pass-if
278 (eqv? #x100000000000000000000000000000000
279 (rotate-bit-field #x100000000000000000000000000000000 128 0 64)))
280 (pass-if
281 (eqv? #x100000000000000000000000000000008
282 (rotate-bit-field #x100000000000000000000000000000001 3 0 64)))
283 (pass-if
284 (eqv? #x100000000000000002000000000000000
285 (rotate-bit-field #x100000000000000000000000000000001 -3 0 64)))
286
287 (pass-if (eqv? #b110 (rotate-bit-field #b110 0 0 10)))
288 (pass-if (eqv? #b110 (rotate-bit-field #b110 0 0 256)))
289
290 (pass-if "bignum becomes inum"
291 (eqv? 1 (rotate-bit-field #x100000000000000000000000000000000 1 0 129))))
292
293;;
294;; reverse-bit-field
295;;
296
297(with-test-prefix "reverse-bit-field"
298 (pass-if (eqv? 6 (reverse-bit-field 6 1 3)))
299 (pass-if (eqv? 12 (reverse-bit-field 6 1 4)))
300
301 (pass-if (eqv? #x80000000 (reverse-bit-field 1 0 32)))
302 (pass-if (eqv? #x40000000 (reverse-bit-field 1 0 31)))
303 (pass-if (eqv? #x20000000 (reverse-bit-field 1 0 30)))
304
305 (pass-if (eqv? (logior (ash -1 32) #xFBFFFFFF)
306 (reverse-bit-field -2 0 27)))
307 (pass-if (eqv? (logior (ash -1 32) #xF7FFFFFF)
308 (reverse-bit-field -2 0 28)))
309 (pass-if (eqv? (logior (ash -1 32) #xEFFFFFFF)
310 (reverse-bit-field -2 0 29)))
311 (pass-if (eqv? (logior (ash -1 32) #xDFFFFFFF)
312 (reverse-bit-field -2 0 30)))
313 (pass-if (eqv? (logior (ash -1 32) #xBFFFFFFF)
314 (reverse-bit-field -2 0 31)))
315 (pass-if (eqv? (logior (ash -1 32) #x7FFFFFFF)
316 (reverse-bit-field -2 0 32)))
317
318 (pass-if "bignum becomes inum"
319 (eqv? 5 (reverse-bit-field #x140000000000000000000000000000000 0 129))))
320
321;;
322;; integer->list
323;;
324
325(with-test-prefix "integer->list"
326 (pass-if (equal? '(#t #t #f) (integer->list 6)))
327 (pass-if (equal? '(#f #t #t #f) (integer->list 6 4)))
328 (pass-if (equal? '(#t #f) (integer->list 6 2)))
329
330 (pass-if "zeros above top of positive inum"
331 (equal? '(#f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
332 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
333 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
334 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
335 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
336 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
337 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
338 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #t)
339 (integer->list 1 128)))
340
341 (pass-if "ones above top of negative inum"
342 (equal? '(#t #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t
343 #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t
344 #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t
345 #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t
346 #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t
347 #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t
348 #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t
349 #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t #t)
350 (integer->list -1 128)))
351
352 (pass-if (equal? '(#t
353 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
354 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
355 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
356 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
357 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
358 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
359 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
360 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f)
361 (integer->list #x100000000000000000000000000000000))))
362
363;;
364;; list->integer
365;;
366
367(with-test-prefix "list->integer"
368 (pass-if (eqv? 6 (list->integer '(#t #t #f))))
369 (pass-if (eqv? 6 (list->integer '(#f #t #t #f))))
370 (pass-if (eqv? 2 (list->integer '(#t #f))))
371
372 (pass-if "leading #f's"
373 (eqv? 1 (list->integer
374 '(#f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
375 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
376 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
377 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
378 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
379 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
380 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
381 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #t))))
382
383 (pass-if (eqv? #x100000000000000000000000000000000
384 (list->integer
385 '(#t
386 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
387 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
388 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
389 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
390 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
391 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
392 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f
393 #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f #f))))
394
395 (pass-if (eqv? #x03FFFFFF (list->integer '(#t #t
396 #t #t #t #t #t #t #t #t
397 #t #t #t #t #t #t #t #t
398 #t #t #t #t #t #t #t #t))))
399 (pass-if (eqv? #x07FFFFFF (list->integer '(#t #t #t
400 #t #t #t #t #t #t #t #t
401 #t #t #t #t #t #t #t #t
402 #t #t #t #t #t #t #t #t))))
403 (pass-if (eqv? #x0FFFFFFF (list->integer '(#t #t #t #t
404 #t #t #t #t #t #t #t #t
405 #t #t #t #t #t #t #t #t
406 #t #t #t #t #t #t #t #t))))
407 (pass-if (eqv? #x1FFFFFFF (list->integer '(#t #t #t #t #t
408 #t #t #t #t #t #t #t #t
409 #t #t #t #t #t #t #t #t
410 #t #t #t #t #t #t #t #t))))
411 (pass-if (eqv? #x3FFFFFFF (list->integer '(#t #t #t #t #t #t
412 #t #t #t #t #t #t #t #t
413 #t #t #t #t #t #t #t #t
414 #t #t #t #t #t #t #t #t))))
415 (pass-if (eqv? #x7FFFFFFF (list->integer '(#t #t #t #t #t #t #t
416 #t #t #t #t #t #t #t #t
417 #t #t #t #t #t #t #t #t
418 #t #t #t #t #t #t #t #t))))
419 (pass-if (eqv? #xFFFFFFFF (list->integer '(#t #t #t #t #t #t #t #t
420 #t #t #t #t #t #t #t #t
421 #t #t #t #t #t #t #t #t
422 #t #t #t #t #t #t #t #t))))
423 (pass-if (eqv? #x1FFFFFFFF (list->integer '(#t
424 #t #t #t #t #t #t #t #t
425 #t #t #t #t #t #t #t #t
426 #t #t #t #t #t #t #t #t
427 #t #t #t #t #t #t #t #t)))))
428
429;;
430;; list->integer
431;;
432
433(with-test-prefix "list->integer"
434 (pass-if (eqv? 0 (booleans->integer)))
435 (pass-if (eqv? 6 (booleans->integer #t #t #f))))
Unnamed repository; edit this file 'description' to name the repository.