1;;;; bit-operations.test --- bitwise operations on numbers -*- scheme -*-
2;;;; Copyright (C) 2000, 2001, 2003, 2006, 2009, 2010 Free Software Foundation, Inc.
3;;;;
4;;;; This library is free software; you can redistribute it and/or
5;;;; modify it under the terms of the GNU Lesser General Public
6;;;; License as published by the Free Software Foundation; either
7;;;; version 3 of the License, or (at your option) any later version.
8;;;;
9;;;; This library is distributed in the hope that it will be useful,
10;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
11;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
12;;;; Lesser General Public License for more details.
13;;;;
14;;;; You should have received a copy of the GNU Lesser General Public
15;;;; License along with this library; if not, write to the Free Software
16;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
17
18(define-module (test-bit-operations)
19  :use-module (test-suite lib)
20  :use-module (ice-9 documentation))
21
22
23;;;
24;;; miscellaneous
25;;;
26
27(define (run-tests name-proc test-proc arg-sets)
28  (for-each
29   (lambda (arg-set)
30     (pass-if (apply name-proc arg-set)
31       (apply test-proc arg-set)))
32   arg-sets))
33
34(define (documented? object)
35  (not (not (object-documentation object))))
36
37(define fixnum-bit
38  (inexact->exact (round (+ (/ (log (+ most-positive-fixnum 1)) (log 2)) 1))))
39
40(define fixnum-min most-negative-fixnum)
41(define fixnum-max most-positive-fixnum)
42
43(with-test-prefix "bit-extract"
44
45  (pass-if "documented?"
46    (documented? bit-extract))
47
48  (with-test-prefix "extract from zero"
49
50    (run-tests
51     (lambda (a b c d)
52       (string-append "single bit " (number->string b)))
53     (lambda (a b c d)
54       (= (bit-extract a b c) d))
55     (list
56      (list 0 0 1 0)
57      (list 0 1 2 0)
58      (list 0 (+ fixnum-bit -2) (+ fixnum-bit -1) 0)
59      (list 0 (+ fixnum-bit -1) (+ fixnum-bit  0) 0)
60      (list 0 (+ fixnum-bit  0) (+ fixnum-bit  1) 0)
61      (list 0 (+ fixnum-bit  1) (+ fixnum-bit  2) 0)))
62
63    (run-tests
64     (lambda (a b c d)
65       (string-append "fixnum-bit - 1 bits starting at " (number->string b)))
66     (lambda (a b c d)
67       (= (bit-extract a b c) d))
68     (list
69      (list 0 0 (+ fixnum-bit -1) 0)
70      (list 0 1 (+ fixnum-bit  0) 0)
71      (list 0 2 (+ fixnum-bit  1) 0)
72      (list 0 (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -3) 0)
73      (list 0 (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -2) 0)
74      (list 0 (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit -1) 0)
75      (list 0 (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  0) 0)))
76
77    (run-tests
78     (lambda (a b c d)
79       (string-append "fixnum-bit bits starting at " (number->string b)))
80     (lambda (a b c d)
81       (= (bit-extract a b c) d))
82     (list
83      (list 0 0 (+ fixnum-bit  0) 0)
84      (list 0 1 (+ fixnum-bit  1) 0)
85      (list 0 2 (+ fixnum-bit  2) 0)
86      (list 0 (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -2) 0)
87      (list 0 (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -1) 0)
88      (list 0 (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  0) 0)
89      (list 0 (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  1) 0)))
90
91    (run-tests
92     (lambda (a b c d)
93       (string-append "fixnum-bit + 1 bits starting at " (number->string b)))
94     (lambda (a b c d)
95       (= (bit-extract a b c) d))
96     (list
97      (list 0 0 (+ fixnum-bit  1) 0)
98      (list 0 1 (+ fixnum-bit  2) 0)
99      (list 0 2 (+ fixnum-bit  3) 0)
100      (list 0 (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -1) 0)
101      (list 0 (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit  0) 0)
102      (list 0 (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  1) 0)
103      (list 0 (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  2) 0))))
104
105  (with-test-prefix "extract from fixnum-max"
106
107    (run-tests
108     (lambda (a b c d)
109       (string-append "single bit " (number->string b)))
110     (lambda (a b c d)
111       (= (bit-extract a b c) d))
112     (list
113      (list fixnum-max 0 1 1)
114      (list fixnum-max 1 2 1)
115      (list fixnum-max (+ fixnum-bit -2) (+ fixnum-bit -1) 1)
116      (list fixnum-max (+ fixnum-bit -1) (+ fixnum-bit  0) 0)
117      (list fixnum-max (+ fixnum-bit  0) (+ fixnum-bit  1) 0)
118      (list fixnum-max (+ fixnum-bit  1) (+ fixnum-bit  2) 0)))
119
120    (run-tests
121     (lambda (a b c d)
122       (string-append "fixnum-bit - 1 bits starting at " (number->string b)))
123     (lambda (a b c d)
124       (= (bit-extract a b c) d))
125     (list
126      (list fixnum-max 0 (+ fixnum-bit -1) (ash fixnum-max  0))
127      (list fixnum-max 1 (+ fixnum-bit  0) (ash fixnum-max -1))
128      (list fixnum-max 2 (+ fixnum-bit  1) (ash fixnum-max -2))
129      (list fixnum-max (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -3) 1)
130      (list fixnum-max (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -2) 0)
131      (list fixnum-max (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit -1) 0)
132      (list fixnum-max (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  0) 0)))
133
134    (run-tests
135     (lambda (a b c d)
136       (string-append "fixnum-bit bits starting at " (number->string b)))
137     (lambda (a b c d)
138       (= (bit-extract a b c) d))
139     (list
140      (list fixnum-max 0 (+ fixnum-bit  0) (ash fixnum-max  0))
141      (list fixnum-max 1 (+ fixnum-bit  1) (ash fixnum-max -1))
142      (list fixnum-max 2 (+ fixnum-bit  2) (ash fixnum-max -2))
143      (list fixnum-max (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -2) 1)
144      (list fixnum-max (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -1) 0)
145      (list fixnum-max (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  0) 0)
146      (list fixnum-max (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  1) 0)))
147
148    (run-tests
149     (lambda (a b c d)
150       (string-append "fixnum-bit + 1 bits starting at " (number->string b)))
151     (lambda (a b c d)
152       (= (bit-extract a b c) d))
153     (list
154      (list fixnum-max 0 (+ fixnum-bit  1) (ash fixnum-max  0))
155      (list fixnum-max 1 (+ fixnum-bit  2) (ash fixnum-max -1))
156      (list fixnum-max 2 (+ fixnum-bit  3) (ash fixnum-max -2))
157      (list fixnum-max (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -1) 1)
158      (list fixnum-max (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit  0) 0)
159      (list fixnum-max (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  1) 0)
160      (list fixnum-max (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  2) 0))))
161
162  (with-test-prefix "extract from fixnum-max + 1"
163
164    (run-tests
165     (lambda (a b c d)
166       (string-append "single bit " (number->string b)))
167     (lambda (a b c d)
168       (= (bit-extract a b c) d))
169     (list
170      (list (+ fixnum-max 1) 0 1 0)
171      (list (+ fixnum-max 1) 1 2 0)
172      (list (+ fixnum-max 1) (+ fixnum-bit -2) (+ fixnum-bit -1) 0)
173      (list (+ fixnum-max 1) (+ fixnum-bit -1) (+ fixnum-bit  0) 1)
174      (list (+ fixnum-max 1) (+ fixnum-bit  0) (+ fixnum-bit  1) 0)
175      (list (+ fixnum-max 1) (+ fixnum-bit  1) (+ fixnum-bit  2) 0)))
176
177    (run-tests
178     (lambda (a b c d)
179       (string-append "fixnum-bit - 1 bits starting at " (number->string b)))
180     (lambda (a b c d)
181       (= (bit-extract a b c) d))
182     (list
183      (list (+ fixnum-max 1) 0 (+ fixnum-bit -1) (ash 0 (- fixnum-bit 1)))
184      (list (+ fixnum-max 1) 1 (+ fixnum-bit  0) (ash 1 (- fixnum-bit 2)))
185      (list (+ fixnum-max 1) 2 (+ fixnum-bit  1) (ash 1 (- fixnum-bit 3)))
186      (list (+ fixnum-max 1) (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -3) 2)
187      (list (+ fixnum-max 1) (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -2) 1)
188      (list (+ fixnum-max 1) (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit -1) 0)
189      (list (+ fixnum-max 1) (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  0) 0)))
190
191    (run-tests
192     (lambda (a b c d)
193       (string-append "fixnum-bit bits starting at " (number->string b)))
194     (lambda (a b c d)
195       (= (bit-extract a b c) d))
196     (list
197      (list (+ fixnum-max 1) 0 (+ fixnum-bit  0) (ash 1 (- fixnum-bit 1)))
198      (list (+ fixnum-max 1) 1 (+ fixnum-bit  1) (ash 1 (- fixnum-bit 2)))
199      (list (+ fixnum-max 1) 2 (+ fixnum-bit  2) (ash 1 (- fixnum-bit 3)))
200      (list (+ fixnum-max 1) (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -2) 2)
201      (list (+ fixnum-max 1) (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -1) 1)
202      (list (+ fixnum-max 1) (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  0) 0)
203      (list (+ fixnum-max 1) (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  1) 0)))
204
205    (run-tests
206     (lambda (a b c d)
207       (string-append "fixnum-bit + 1 bits starting at " (number->string b)))
208     (lambda (a b c d)
209       (= (bit-extract a b c) d))
210     (list
211      (list (+ fixnum-max 1) 0 (+ fixnum-bit  1) (ash 1 (- fixnum-bit 1)))
212      (list (+ fixnum-max 1) 1 (+ fixnum-bit  2) (ash 1 (- fixnum-bit 2)))
213      (list (+ fixnum-max 1) 2 (+ fixnum-bit  3) (ash 1 (- fixnum-bit 3)))
214      (list (+ fixnum-max 1) (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -1) 2)
215      (list (+ fixnum-max 1) (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit  0) 1)
216      (list (+ fixnum-max 1) (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  1) 0)
217      (list (+ fixnum-max 1) (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  2) 0))))
218
219  (with-test-prefix "extract from fixnum-min"
220
221    (run-tests
222     (lambda (a b c d)
223       (string-append "single bit " (number->string b)))
224     (lambda (a b c d)
225       (= (bit-extract a b c) d))
226     (list
227      (list fixnum-min 0 1 0)
228      (list fixnum-min 1 2 0)
229      (list fixnum-min (+ fixnum-bit -2) (+ fixnum-bit -1) 0)
230      (list fixnum-min (+ fixnum-bit -1) (+ fixnum-bit  0) 1)
231      (list fixnum-min (+ fixnum-bit  0) (+ fixnum-bit  1) 1)
232      (list fixnum-min (+ fixnum-bit  1) (+ fixnum-bit  2) 1)))
233
234    (run-tests
235     (lambda (a b c d)
236       (string-append "fixnum-bit - 1 bits starting at " (number->string b)))
237     (lambda (a b c d)
238       (= (bit-extract a b c) d))
239     (list
240      (list fixnum-min 0 (+ fixnum-bit -1) (ash 0 (- fixnum-bit 1)))
241      (list fixnum-min 1 (+ fixnum-bit  0) (ash 1 (- fixnum-bit 2)))
242      (list fixnum-min 2 (+ fixnum-bit  1) (ash 3 (- fixnum-bit 3)))
243      (list fixnum-min (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -3)
244            (- (ash 1	(- fixnum-bit 1)) 2))
245      (list fixnum-min (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -2)
246            (- (ash 1	(- fixnum-bit 1)) 1))
247      (list fixnum-min (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit -1)
248            (- (ash 1	(- fixnum-bit 1)) 1))
249      (list fixnum-min (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  0)
250            (- (ash 1	(- fixnum-bit 1)) 1))))
251
252    (run-tests
253     (lambda (a b c d)
254       (string-append "fixnum-bit bits starting at " (number->string b)))
255     (lambda (a b c d)
256       (= (bit-extract a b c) d))
257     (list
258      (list fixnum-min 0 (+ fixnum-bit  0) (ash 1 (- fixnum-bit 1)))
259      (list fixnum-min 1 (+ fixnum-bit  1) (ash 3 (- fixnum-bit 2)))
260      (list fixnum-min 2 (+ fixnum-bit  2) (ash 7 (- fixnum-bit 3)))
261      (list fixnum-min (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -2)
262            (- (ash 1	fixnum-bit) 2))
263      (list fixnum-min (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -1)
264            (- (ash 1	fixnum-bit) 1))
265      (list fixnum-min (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  0)
266            (- (ash 1	fixnum-bit) 1))
267      (list fixnum-min (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  1)
268            (- (ash 1	fixnum-bit) 1))))
269
270    (run-tests
271     (lambda (a b c d)
272       (string-append "fixnum-bit + 1 bits starting at " (number->string b)))
273     (lambda (a b c d)
274       (= (bit-extract a b c) d))
275     (list
276      (list fixnum-min 0 (+ fixnum-bit  1) (ash  3 (- fixnum-bit 1)))
277      (list fixnum-min 1 (+ fixnum-bit  2) (ash  7 (- fixnum-bit 2)))
278      (list fixnum-min 2 (+ fixnum-bit  3) (ash 15 (- fixnum-bit 3)))
279      (list fixnum-min (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -1)
280            (- (ash 1 (+ fixnum-bit 1)) 2))
281      (list fixnum-min (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit  0)
282            (- (ash 1 (+ fixnum-bit 1)) 1))
283      (list fixnum-min (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  1)
284            (- (ash 1 (+ fixnum-bit 1)) 1))
285      (list fixnum-min (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  2)
286            (- (ash 1 (+ fixnum-bit 1)) 1)))))
287
288  (with-test-prefix "extract from fixnum-min - 1"
289
290    (run-tests
291     (lambda (a b c d)
292       (string-append "single bit " (number->string b)))
293     (lambda (a b c d)
294       (= (bit-extract a b c) d))
295     (list
296      (list (- fixnum-min 1) 0 1 1)
297      (list (- fixnum-min 1) 1 2 1)
298      (list (- fixnum-min 1) (+ fixnum-bit -2) (+ fixnum-bit -1) 1)
299      (list (- fixnum-min 1) (+ fixnum-bit -1) (+ fixnum-bit  0) 0)
300      (list (- fixnum-min 1) (+ fixnum-bit  0) (+ fixnum-bit  1) 1)
301      (list (- fixnum-min 1) (+ fixnum-bit  1) (+ fixnum-bit  2) 1)))
302
303    (run-tests
304     (lambda (a b c d)
305       (string-append "fixnum-bit - 1 bits starting at " (number->string b)))
306     (lambda (a b c d)
307       (= (bit-extract a b c) d))
308     (list
309      (list (- fixnum-min 1) 0 (+ fixnum-bit -1)
310            (- (ash 1 (- fixnum-bit 1)) 1 (ash 0 (- fixnum-bit 1))))
311      (list (- fixnum-min 1) 1 (+ fixnum-bit  0)
312            (- (ash 1 (- fixnum-bit 1)) 1 (ash 1 (- fixnum-bit 2))))
313      (list (- fixnum-min 1) 2 (+ fixnum-bit  1)
314            (- (ash 1 (- fixnum-bit 1)) 1 (ash 1 (- fixnum-bit 3))))
315      (list (- fixnum-min 1) (+ fixnum-bit -2)
316            (+ fixnum-bit fixnum-bit -3) (- (ash 1 (- fixnum-bit 1)) 3))
317      (list (- fixnum-min 1) (+ fixnum-bit -1)
318            (+ fixnum-bit fixnum-bit -2) (- (ash 1 (- fixnum-bit 1)) 2))
319      (list (- fixnum-min 1) (+ fixnum-bit  0)
320            (+ fixnum-bit fixnum-bit -1) (- (ash 1 (- fixnum-bit 1)) 1))
321      (list (- fixnum-min 1) (+ fixnum-bit  1)
322            (+ fixnum-bit fixnum-bit  0) (- (ash 1 (- fixnum-bit 1)) 1))))
323
324    (run-tests
325     (lambda (a b c d)
326       (string-append "fixnum-bit bits starting at " (number->string b)))
327     (lambda (a b c d)
328       (= (bit-extract a b c) d))
329     (list
330      (list (- fixnum-min 1) 0 (+ fixnum-bit  0)
331            (- (ash 1 fixnum-bit) 1 (ash 1 (- fixnum-bit 1))))
332      (list (- fixnum-min 1) 1 (+ fixnum-bit  1)
333            (- (ash 1 fixnum-bit) 1 (ash 1 (- fixnum-bit 2))))
334      (list (- fixnum-min 1) 2 (+ fixnum-bit  2)
335            (- (ash 1 fixnum-bit) 1 (ash 1 (- fixnum-bit 3))))
336      (list (- fixnum-min 1) (+ fixnum-bit -2)
337            (+ fixnum-bit fixnum-bit -2) (- (ash 1 fixnum-bit) 3))
338      (list (- fixnum-min 1) (+ fixnum-bit -1)
339            (+ fixnum-bit fixnum-bit -1) (- (ash 1 fixnum-bit) 2))
340      (list (- fixnum-min 1) (+ fixnum-bit  0)
341            (+ fixnum-bit fixnum-bit  0) (- (ash 1 fixnum-bit) 1))
342      (list (- fixnum-min 1) (+ fixnum-bit  1)
343            (+ fixnum-bit fixnum-bit  1) (- (ash 1 fixnum-bit) 1))))
344
345    (run-tests
346     (lambda (a b c d)
347       (string-append "fixnum-bit + 1 bits starting at " (number->string b)))
348     (lambda (a b c d)
349       (= (bit-extract a b c) d))
350     (list
351      (list (- fixnum-min 1) 0 (+ fixnum-bit  1)
352            (- (ash 1 (+ fixnum-bit 1)) 1 (ash 1 (- fixnum-bit 1))))
353      (list (- fixnum-min 1) 1 (+ fixnum-bit  2)
354            (- (ash 1 (+ fixnum-bit 1)) 1 (ash 1 (- fixnum-bit 2))))
355      (list (- fixnum-min 1) 2 (+ fixnum-bit  3)
356            (- (ash 1 (+ fixnum-bit 1)) 1 (ash 1 (- fixnum-bit 3))))
357      (list (- fixnum-min 1) (+ fixnum-bit -2)
358            (+ fixnum-bit fixnum-bit -1) (- (ash 1 (+ fixnum-bit 1)) 3))
359      (list (- fixnum-min 1) (+ fixnum-bit -1)
360            (+ fixnum-bit fixnum-bit  0) (- (ash 1 (+ fixnum-bit 1)) 2))
361      (list (- fixnum-min 1) (+ fixnum-bit  0)
362            (+ fixnum-bit fixnum-bit  1) (- (ash 1 (+ fixnum-bit 1)) 1))
363      (list (- fixnum-min 1) (+ fixnum-bit  1)
364            (+ fixnum-bit fixnum-bit  2) (- (ash 1 (+ fixnum-bit 1)) 1))))))
365
366(with-test-prefix "bitshifts on word boundaries"
367  (pass-if (= (ash 1 32) 4294967296))
368  (pass-if (= (ash 1 64) 18446744073709551616)))
369