GOOPS cosmetics
[bpt/guile.git] / test-suite / tests / bit-operations.test
CommitLineData
339bfe47 1;;;; bit-operations.test --- bitwise operations on numbers -*- scheme -*-
8ecd1943 2;;;; Copyright (C) 2000, 2001, 2003, 2006, 2009, 2010 Free Software Foundation, Inc.
339bfe47 3;;;;
73be1d9e
MV
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
53befeb7 7;;;; version 3 of the License, or (at your option) any later version.
73be1d9e
MV
8;;;;
9;;;; This library is distributed in the hope that it will be useful,
339bfe47 10;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
73be1d9e
MV
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
92205699 16;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
339bfe47 17
9120012f
LC
18(define-module (test-bit-operations)
19 :use-module (test-suite lib)
20 :use-module (ice-9 documentation))
339bfe47
DH
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)
5c96bc39 35 (not (not (object-documentation object))))
339bfe47 36
af297b33 37(define fixnum-bit
9dd9857f 38 (inexact->exact (round (+ (/ (log (+ most-positive-fixnum 1)) (log 2)) 1))))
af297b33 39
339bfe47
DH
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)))
122cf9a5
RB
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))))
339bfe47
DH
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)))
122cf9a5
RB
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))))
339bfe47
DH
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)))
122cf9a5
RB
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)))))
339bfe47
DH
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
122cf9a5
RB
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))))
339bfe47
DH
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
122cf9a5
RB
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))))
339bfe47
DH
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
122cf9a5
RB
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))))))
8ecd1943
AW
365
366(with-test-prefix "bitshifts on word boundaries"
367 (pass-if (= (ash 1 32) 4294967296))
368 (pass-if (= (ash 1 64) 18446744073709551616)))