*** empty log message ***
[bpt/guile.git] / test-suite / tests / bit-operations.test
CommitLineData
339bfe47 1;;;; bit-operations.test --- bitwise operations on numbers -*- scheme -*-
96e30d2a 2;;;; Copyright (C) 2000, 2001 Free Software Foundation, Inc.
339bfe47
DH
3;;;;
4;;;; This program is free software; you can redistribute it and/or modify
5;;;; it under the terms of the GNU General Public License as published by
6;;;; the Free Software Foundation; either version 2, or (at your option)
7;;;; any later version.
8;;;;
9;;;; This program 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
12;;;; GNU General Public License for more details.
13;;;;
14;;;; You should have received a copy of the GNU General Public License
15;;;; along with this software; see the file COPYING. If not, write to
16;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
17;;;; Boston, MA 02111-1307 USA
18;;;;
19;;;; As a special exception, the Free Software Foundation gives permission
20;;;; for additional uses of the text contained in its release of GUILE.
21;;;;
22;;;; The exception is that, if you link the GUILE library with other files
23;;;; to produce an executable, this does not by itself cause the
24;;;; resulting executable to be covered by the GNU General Public License.
25;;;; Your use of that executable is in no way restricted on account of
26;;;; linking the GUILE library code into it.
27;;;;
28;;;; This exception does not however invalidate any other reasons why
29;;;; the executable file might be covered by the GNU General Public License.
30;;;;
31;;;; This exception applies only to the code released by the
32;;;; Free Software Foundation under the name GUILE. If you copy
33;;;; code from other Free Software Foundation releases into a copy of
34;;;; GUILE, as the General Public License permits, the exception does
35;;;; not apply to the code that you add in this way. To avoid misleading
36;;;; anyone as to the status of such modified files, you must delete
37;;;; this exception notice from them.
38;;;;
39;;;; If you write modifications of your own for GUILE, it is your choice
40;;;; whether to permit this exception to apply to your modifications.
41;;;; If you do not wish that, delete this exception notice.
42
43(use-modules (ice-9 documentation))
44
45
46;;;
47;;; miscellaneous
48;;;
49
50(define (run-tests name-proc test-proc arg-sets)
51 (for-each
52 (lambda (arg-set)
53 (pass-if (apply name-proc arg-set)
54 (apply test-proc arg-set)))
55 arg-sets))
56
57(define (documented? object)
5c96bc39 58 (not (not (object-documentation object))))
339bfe47 59
af297b33
RB
60(define fixnum-bit
61 (inexact->exact (+ (/ (log (+ most-positive-fixnum 1)) (log 2)) 1)))
62
339bfe47
DH
63(define fixnum-min most-negative-fixnum)
64(define fixnum-max most-positive-fixnum)
65
66(with-test-prefix "bit-extract"
67
68 (pass-if "documented?"
69 (documented? bit-extract))
70
71 (with-test-prefix "extract from zero"
72
73 (run-tests
74 (lambda (a b c d)
75 (string-append "single bit " (number->string b)))
76 (lambda (a b c d)
77 (= (bit-extract a b c) d))
78 (list
79 (list 0 0 1 0)
80 (list 0 1 2 0)
81 (list 0 (+ fixnum-bit -2) (+ fixnum-bit -1) 0)
82 (list 0 (+ fixnum-bit -1) (+ fixnum-bit 0) 0)
83 (list 0 (+ fixnum-bit 0) (+ fixnum-bit 1) 0)
84 (list 0 (+ fixnum-bit 1) (+ fixnum-bit 2) 0)))
85
86 (run-tests
87 (lambda (a b c d)
88 (string-append "fixnum-bit - 1 bits starting at " (number->string b)))
89 (lambda (a b c d)
90 (= (bit-extract a b c) d))
91 (list
92 (list 0 0 (+ fixnum-bit -1) 0)
93 (list 0 1 (+ fixnum-bit 0) 0)
94 (list 0 2 (+ fixnum-bit 1) 0)
95 (list 0 (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -3) 0)
96 (list 0 (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -2) 0)
97 (list 0 (+ fixnum-bit 0) (+ fixnum-bit fixnum-bit -1) 0)
98 (list 0 (+ fixnum-bit 1) (+ fixnum-bit fixnum-bit 0) 0)))
99
100 (run-tests
101 (lambda (a b c d)
102 (string-append "fixnum-bit bits starting at " (number->string b)))
103 (lambda (a b c d)
104 (= (bit-extract a b c) d))
105 (list
106 (list 0 0 (+ fixnum-bit 0) 0)
107 (list 0 1 (+ fixnum-bit 1) 0)
108 (list 0 2 (+ fixnum-bit 2) 0)
109 (list 0 (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -2) 0)
110 (list 0 (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -1) 0)
111 (list 0 (+ fixnum-bit 0) (+ fixnum-bit fixnum-bit 0) 0)
112 (list 0 (+ fixnum-bit 1) (+ fixnum-bit fixnum-bit 1) 0)))
113
114 (run-tests
115 (lambda (a b c d)
116 (string-append "fixnum-bit + 1 bits starting at " (number->string b)))
117 (lambda (a b c d)
118 (= (bit-extract a b c) d))
119 (list
120 (list 0 0 (+ fixnum-bit 1) 0)
121 (list 0 1 (+ fixnum-bit 2) 0)
122 (list 0 2 (+ fixnum-bit 3) 0)
123 (list 0 (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -1) 0)
124 (list 0 (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit 0) 0)
125 (list 0 (+ fixnum-bit 0) (+ fixnum-bit fixnum-bit 1) 0)
126 (list 0 (+ fixnum-bit 1) (+ fixnum-bit fixnum-bit 2) 0))))
127
128 (with-test-prefix "extract from fixnum-max"
129
130 (run-tests
131 (lambda (a b c d)
132 (string-append "single bit " (number->string b)))
133 (lambda (a b c d)
134 (= (bit-extract a b c) d))
135 (list
136 (list fixnum-max 0 1 1)
137 (list fixnum-max 1 2 1)
138 (list fixnum-max (+ fixnum-bit -2) (+ fixnum-bit -1) 1)
139 (list fixnum-max (+ fixnum-bit -1) (+ fixnum-bit 0) 0)
140 (list fixnum-max (+ fixnum-bit 0) (+ fixnum-bit 1) 0)
141 (list fixnum-max (+ fixnum-bit 1) (+ fixnum-bit 2) 0)))
142
143 (run-tests
144 (lambda (a b c d)
145 (string-append "fixnum-bit - 1 bits starting at " (number->string b)))
146 (lambda (a b c d)
147 (= (bit-extract a b c) d))
148 (list
149 (list fixnum-max 0 (+ fixnum-bit -1) (ash fixnum-max 0))
150 (list fixnum-max 1 (+ fixnum-bit 0) (ash fixnum-max -1))
151 (list fixnum-max 2 (+ fixnum-bit 1) (ash fixnum-max -2))
152 (list fixnum-max (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -3) 1)
153 (list fixnum-max (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -2) 0)
154 (list fixnum-max (+ fixnum-bit 0) (+ fixnum-bit fixnum-bit -1) 0)
155 (list fixnum-max (+ fixnum-bit 1) (+ fixnum-bit fixnum-bit 0) 0)))
156
157 (run-tests
158 (lambda (a b c d)
159 (string-append "fixnum-bit bits starting at " (number->string b)))
160 (lambda (a b c d)
161 (= (bit-extract a b c) d))
162 (list
163 (list fixnum-max 0 (+ fixnum-bit 0) (ash fixnum-max 0))
164 (list fixnum-max 1 (+ fixnum-bit 1) (ash fixnum-max -1))
165 (list fixnum-max 2 (+ fixnum-bit 2) (ash fixnum-max -2))
166 (list fixnum-max (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -2) 1)
167 (list fixnum-max (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -1) 0)
168 (list fixnum-max (+ fixnum-bit 0) (+ fixnum-bit fixnum-bit 0) 0)
169 (list fixnum-max (+ fixnum-bit 1) (+ fixnum-bit fixnum-bit 1) 0)))
170
171 (run-tests
172 (lambda (a b c d)
173 (string-append "fixnum-bit + 1 bits starting at " (number->string b)))
174 (lambda (a b c d)
175 (= (bit-extract a b c) d))
176 (list
177 (list fixnum-max 0 (+ fixnum-bit 1) (ash fixnum-max 0))
178 (list fixnum-max 1 (+ fixnum-bit 2) (ash fixnum-max -1))
179 (list fixnum-max 2 (+ fixnum-bit 3) (ash fixnum-max -2))
180 (list fixnum-max (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -1) 1)
181 (list fixnum-max (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit 0) 0)
182 (list fixnum-max (+ fixnum-bit 0) (+ fixnum-bit fixnum-bit 1) 0)
183 (list fixnum-max (+ fixnum-bit 1) (+ fixnum-bit fixnum-bit 2) 0))))
184
185 (with-test-prefix "extract from fixnum-max + 1"
186
187 (run-tests
188 (lambda (a b c d)
189 (string-append "single bit " (number->string b)))
190 (lambda (a b c d)
191 (= (bit-extract a b c) d))
192 (list
193 (list (+ fixnum-max 1) 0 1 0)
194 (list (+ fixnum-max 1) 1 2 0)
195 (list (+ fixnum-max 1) (+ fixnum-bit -2) (+ fixnum-bit -1) 0)
196 (list (+ fixnum-max 1) (+ fixnum-bit -1) (+ fixnum-bit 0) 1)
197 (list (+ fixnum-max 1) (+ fixnum-bit 0) (+ fixnum-bit 1) 0)
198 (list (+ fixnum-max 1) (+ fixnum-bit 1) (+ fixnum-bit 2) 0)))
199
200 (run-tests
201 (lambda (a b c d)
202 (string-append "fixnum-bit - 1 bits starting at " (number->string b)))
203 (lambda (a b c d)
204 (= (bit-extract a b c) d))
205 (list
206 (list (+ fixnum-max 1) 0 (+ fixnum-bit -1) (ash 0 (- fixnum-bit 1)))
207 (list (+ fixnum-max 1) 1 (+ fixnum-bit 0) (ash 1 (- fixnum-bit 2)))
208 (list (+ fixnum-max 1) 2 (+ fixnum-bit 1) (ash 1 (- fixnum-bit 3)))
209 (list (+ fixnum-max 1) (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -3) 2)
210 (list (+ fixnum-max 1) (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -2) 1)
211 (list (+ fixnum-max 1) (+ fixnum-bit 0) (+ fixnum-bit fixnum-bit -1) 0)
212 (list (+ fixnum-max 1) (+ fixnum-bit 1) (+ fixnum-bit fixnum-bit 0) 0)))
213
214 (run-tests
215 (lambda (a b c d)
216 (string-append "fixnum-bit bits starting at " (number->string b)))
217 (lambda (a b c d)
218 (= (bit-extract a b c) d))
219 (list
220 (list (+ fixnum-max 1) 0 (+ fixnum-bit 0) (ash 1 (- fixnum-bit 1)))
221 (list (+ fixnum-max 1) 1 (+ fixnum-bit 1) (ash 1 (- fixnum-bit 2)))
222 (list (+ fixnum-max 1) 2 (+ fixnum-bit 2) (ash 1 (- fixnum-bit 3)))
223 (list (+ fixnum-max 1) (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -2) 2)
224 (list (+ fixnum-max 1) (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -1) 1)
225 (list (+ fixnum-max 1) (+ fixnum-bit 0) (+ fixnum-bit fixnum-bit 0) 0)
226 (list (+ fixnum-max 1) (+ fixnum-bit 1) (+ fixnum-bit fixnum-bit 1) 0)))
227
228 (run-tests
229 (lambda (a b c d)
230 (string-append "fixnum-bit + 1 bits starting at " (number->string b)))
231 (lambda (a b c d)
232 (= (bit-extract a b c) d))
233 (list
234 (list (+ fixnum-max 1) 0 (+ fixnum-bit 1) (ash 1 (- fixnum-bit 1)))
235 (list (+ fixnum-max 1) 1 (+ fixnum-bit 2) (ash 1 (- fixnum-bit 2)))
236 (list (+ fixnum-max 1) 2 (+ fixnum-bit 3) (ash 1 (- fixnum-bit 3)))
237 (list (+ fixnum-max 1) (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -1) 2)
238 (list (+ fixnum-max 1) (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit 0) 1)
239 (list (+ fixnum-max 1) (+ fixnum-bit 0) (+ fixnum-bit fixnum-bit 1) 0)
240 (list (+ fixnum-max 1) (+ fixnum-bit 1) (+ fixnum-bit fixnum-bit 2) 0))))
241
242 (with-test-prefix "extract from fixnum-min"
243
244 (run-tests
245 (lambda (a b c d)
246 (string-append "single bit " (number->string b)))
247 (lambda (a b c d)
248 (= (bit-extract a b c) d))
249 (list
250 (list fixnum-min 0 1 0)
251 (list fixnum-min 1 2 0)
252 (list fixnum-min (+ fixnum-bit -2) (+ fixnum-bit -1) 0)
253 (list fixnum-min (+ fixnum-bit -1) (+ fixnum-bit 0) 1)
254 (list fixnum-min (+ fixnum-bit 0) (+ fixnum-bit 1) 1)
255 (list fixnum-min (+ fixnum-bit 1) (+ fixnum-bit 2) 1)))
256
257 (run-tests
258 (lambda (a b c d)
259 (string-append "fixnum-bit - 1 bits starting at " (number->string b)))
260 (lambda (a b c d)
261 (= (bit-extract a b c) d))
262 (list
263 (list fixnum-min 0 (+ fixnum-bit -1) (ash 0 (- fixnum-bit 1)))
264 (list fixnum-min 1 (+ fixnum-bit 0) (ash 1 (- fixnum-bit 2)))
265 (list fixnum-min 2 (+ fixnum-bit 1) (ash 3 (- fixnum-bit 3)))
122cf9a5
RB
266 (list fixnum-min (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -3)
267 (- (ash 1 (- fixnum-bit 1)) 2))
268 (list fixnum-min (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -2)
269 (- (ash 1 (- fixnum-bit 1)) 1))
270 (list fixnum-min (+ fixnum-bit 0) (+ fixnum-bit fixnum-bit -1)
271 (- (ash 1 (- fixnum-bit 1)) 1))
272 (list fixnum-min (+ fixnum-bit 1) (+ fixnum-bit fixnum-bit 0)
273 (- (ash 1 (- fixnum-bit 1)) 1))))
339bfe47
DH
274
275 (run-tests
276 (lambda (a b c d)
277 (string-append "fixnum-bit bits starting at " (number->string b)))
278 (lambda (a b c d)
279 (= (bit-extract a b c) d))
280 (list
281 (list fixnum-min 0 (+ fixnum-bit 0) (ash 1 (- fixnum-bit 1)))
282 (list fixnum-min 1 (+ fixnum-bit 1) (ash 3 (- fixnum-bit 2)))
283 (list fixnum-min 2 (+ fixnum-bit 2) (ash 7 (- fixnum-bit 3)))
122cf9a5
RB
284 (list fixnum-min (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -2)
285 (- (ash 1 fixnum-bit) 2))
286 (list fixnum-min (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -1)
287 (- (ash 1 fixnum-bit) 1))
288 (list fixnum-min (+ fixnum-bit 0) (+ fixnum-bit fixnum-bit 0)
289 (- (ash 1 fixnum-bit) 1))
290 (list fixnum-min (+ fixnum-bit 1) (+ fixnum-bit fixnum-bit 1)
291 (- (ash 1 fixnum-bit) 1))))
339bfe47
DH
292
293 (run-tests
294 (lambda (a b c d)
295 (string-append "fixnum-bit + 1 bits starting at " (number->string b)))
296 (lambda (a b c d)
297 (= (bit-extract a b c) d))
298 (list
299 (list fixnum-min 0 (+ fixnum-bit 1) (ash 3 (- fixnum-bit 1)))
300 (list fixnum-min 1 (+ fixnum-bit 2) (ash 7 (- fixnum-bit 2)))
301 (list fixnum-min 2 (+ fixnum-bit 3) (ash 15 (- fixnum-bit 3)))
122cf9a5
RB
302 (list fixnum-min (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -1)
303 (- (ash 1 (+ fixnum-bit 1)) 2))
304 (list fixnum-min (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit 0)
305 (- (ash 1 (+ fixnum-bit 1)) 1))
306 (list fixnum-min (+ fixnum-bit 0) (+ fixnum-bit fixnum-bit 1)
307 (- (ash 1 (+ fixnum-bit 1)) 1))
308 (list fixnum-min (+ fixnum-bit 1) (+ fixnum-bit fixnum-bit 2)
309 (- (ash 1 (+ fixnum-bit 1)) 1)))))
339bfe47
DH
310
311 (with-test-prefix "extract from fixnum-min - 1"
312
313 (run-tests
314 (lambda (a b c d)
315 (string-append "single bit " (number->string b)))
316 (lambda (a b c d)
317 (= (bit-extract a b c) d))
318 (list
319 (list (- fixnum-min 1) 0 1 1)
320 (list (- fixnum-min 1) 1 2 1)
321 (list (- fixnum-min 1) (+ fixnum-bit -2) (+ fixnum-bit -1) 1)
322 (list (- fixnum-min 1) (+ fixnum-bit -1) (+ fixnum-bit 0) 0)
323 (list (- fixnum-min 1) (+ fixnum-bit 0) (+ fixnum-bit 1) 1)
324 (list (- fixnum-min 1) (+ fixnum-bit 1) (+ fixnum-bit 2) 1)))
325
326 (run-tests
327 (lambda (a b c d)
328 (string-append "fixnum-bit - 1 bits starting at " (number->string b)))
329 (lambda (a b c d)
330 (= (bit-extract a b c) d))
331 (list
122cf9a5
RB
332 (list (- fixnum-min 1) 0 (+ fixnum-bit -1)
333 (- (ash 1 (- fixnum-bit 1)) 1 (ash 0 (- fixnum-bit 1))))
334 (list (- fixnum-min 1) 1 (+ fixnum-bit 0)
335 (- (ash 1 (- fixnum-bit 1)) 1 (ash 1 (- fixnum-bit 2))))
336 (list (- fixnum-min 1) 2 (+ fixnum-bit 1)
337 (- (ash 1 (- fixnum-bit 1)) 1 (ash 1 (- fixnum-bit 3))))
338 (list (- fixnum-min 1) (+ fixnum-bit -2)
339 (+ fixnum-bit fixnum-bit -3) (- (ash 1 (- fixnum-bit 1)) 3))
340 (list (- fixnum-min 1) (+ fixnum-bit -1)
341 (+ fixnum-bit fixnum-bit -2) (- (ash 1 (- fixnum-bit 1)) 2))
342 (list (- fixnum-min 1) (+ fixnum-bit 0)
343 (+ fixnum-bit fixnum-bit -1) (- (ash 1 (- fixnum-bit 1)) 1))
344 (list (- fixnum-min 1) (+ fixnum-bit 1)
345 (+ fixnum-bit fixnum-bit 0) (- (ash 1 (- fixnum-bit 1)) 1))))
339bfe47
DH
346
347 (run-tests
348 (lambda (a b c d)
349 (string-append "fixnum-bit bits starting at " (number->string b)))
350 (lambda (a b c d)
351 (= (bit-extract a b c) d))
352 (list
122cf9a5
RB
353 (list (- fixnum-min 1) 0 (+ fixnum-bit 0)
354 (- (ash 1 fixnum-bit) 1 (ash 1 (- fixnum-bit 1))))
355 (list (- fixnum-min 1) 1 (+ fixnum-bit 1)
356 (- (ash 1 fixnum-bit) 1 (ash 1 (- fixnum-bit 2))))
357 (list (- fixnum-min 1) 2 (+ fixnum-bit 2)
358 (- (ash 1 fixnum-bit) 1 (ash 1 (- fixnum-bit 3))))
359 (list (- fixnum-min 1) (+ fixnum-bit -2)
360 (+ fixnum-bit fixnum-bit -2) (- (ash 1 fixnum-bit) 3))
361 (list (- fixnum-min 1) (+ fixnum-bit -1)
362 (+ fixnum-bit fixnum-bit -1) (- (ash 1 fixnum-bit) 2))
363 (list (- fixnum-min 1) (+ fixnum-bit 0)
364 (+ fixnum-bit fixnum-bit 0) (- (ash 1 fixnum-bit) 1))
365 (list (- fixnum-min 1) (+ fixnum-bit 1)
366 (+ fixnum-bit fixnum-bit 1) (- (ash 1 fixnum-bit) 1))))
339bfe47
DH
367
368 (run-tests
369 (lambda (a b c d)
370 (string-append "fixnum-bit + 1 bits starting at " (number->string b)))
371 (lambda (a b c d)
372 (= (bit-extract a b c) d))
373 (list
122cf9a5
RB
374 (list (- fixnum-min 1) 0 (+ fixnum-bit 1)
375 (- (ash 1 (+ fixnum-bit 1)) 1 (ash 1 (- fixnum-bit 1))))
376 (list (- fixnum-min 1) 1 (+ fixnum-bit 2)
377 (- (ash 1 (+ fixnum-bit 1)) 1 (ash 1 (- fixnum-bit 2))))
378 (list (- fixnum-min 1) 2 (+ fixnum-bit 3)
379 (- (ash 1 (+ fixnum-bit 1)) 1 (ash 1 (- fixnum-bit 3))))
380 (list (- fixnum-min 1) (+ fixnum-bit -2)
381 (+ fixnum-bit fixnum-bit -1) (- (ash 1 (+ fixnum-bit 1)) 3))
382 (list (- fixnum-min 1) (+ fixnum-bit -1)
383 (+ fixnum-bit fixnum-bit 0) (- (ash 1 (+ fixnum-bit 1)) 2))
384 (list (- fixnum-min 1) (+ fixnum-bit 0)
385 (+ fixnum-bit fixnum-bit 1) (- (ash 1 (+ fixnum-bit 1)) 1))
386 (list (- fixnum-min 1) (+ fixnum-bit 1)
387 (+ fixnum-bit fixnum-bit 2) (- (ash 1 (+ fixnum-bit 1)) 1))))))