1#!r6rs
2
3(library (tests r6rs arithmetic bitwise)
4  (export run-arithmetic-bitwise-tests)
5  (import (rnrs)
6          (tests r6rs test))
7
8  ;; Helpers originally from Ikarus test suite:
9  (define (ref ei)
10    (do ((result 0 (+ result 1))
11         (bits (if (negative? ei)
12                   (bitwise-not ei)
13                   ei)
14               (bitwise-arithmetic-shift bits -1)))
15        ((zero? bits)
16         result)))
17  (define-syntax len-test
18    (syntax-rules ()
19      [(_ n) (test (bitwise-length n)
20                   (ref n))]))
21  (define (pos-count-bits n)
22    (if (zero? n)
23        0
24        (let ([c (count-bits (bitwise-arithmetic-shift-right n 1))])
25          (if (even? n) c (+ c 1)))))
26  (define (count-bits n)
27    (if (>= n 0)
28        (pos-count-bits n)
29        (bitwise-not (pos-count-bits (bitwise-not n)))))
30  (define-syntax count-test
31    (syntax-rules ()
32      [(_ n)
33       (test (bitwise-bit-count n) (count-bits n))]))
34
35  (define (run-arithmetic-bitwise-tests)
36
37    (test (bitwise-first-bit-set 0)         -1)
38    (test (bitwise-first-bit-set 1)         0)
39    (test (bitwise-first-bit-set -4)        2)
40
41    (test (bitwise-arithmetic-shift -6 -1) -3)
42    (test (bitwise-arithmetic-shift -5 -1) -3)
43    (test (bitwise-arithmetic-shift -4 -1) -2)
44    (test (bitwise-arithmetic-shift -3 -1) -2)
45    (test (bitwise-arithmetic-shift -2 -1) -1)
46    (test (bitwise-arithmetic-shift -1 -1) -1)
47
48    (test (bitwise-reverse-bit-field #b1010010 1 4)    88) ; #b1011000
49
50    ;; Originally from Ikarus test suite:
51    (len-test #xF)
52    (len-test #xFF)
53    (len-test #xFFF)
54    (len-test #xFFFF)
55    (len-test #xFFFFF)
56    (len-test #xFFFFFF)
57    (len-test #xFFFFFFF)
58    (len-test #xFFFFFFFF)
59    (len-test #xFFFFFFFFF)
60    (len-test #xFFFFFFFFFF)
61    (len-test #xFFFFFFFFFFF)
62    (len-test #xFFFFFFFFFFFF)
63    (len-test #xFFFFFFFFFFFFF)
64    (len-test #xFFFFFFFFFFFFFF)
65    (len-test #xFFFFFFFFFFFFFFF)
66    (len-test #xFFFFFFFFFFFFFFFF)
67    (len-test #x-F)
68    (len-test #x-FF)
69    (len-test #x-FFF)
70    (len-test #x-FFFF)
71    (len-test #x-FFFFF)
72    (len-test #x-FFFFFF)
73    (len-test #x-FFFFFFF)
74    (len-test #x-FFFFFFFF)
75    (len-test #x-FFFFFFFFF)
76    (len-test #x-FFFFFFFFFF)
77    (len-test #x-FFFFFFFFFFF)
78    (len-test #x-FFFFFFFFFFFF)
79    (len-test #x-FFFFFFFFFFFFF)
80    (len-test #x-FFFFFFFFFFFFFF)
81    (len-test #x-FFFFFFFFFFFFFFF)
82    (len-test #x-FFFFFFFFFFFFFFFF)
83
84    (len-test #xE)
85    (len-test #xFE)
86    (len-test #xFFE)
87    (len-test #xFFFE)
88    (len-test #xFFFFE)
89    (len-test #xFFFFFE)
90    (len-test #xFFFFFFE)
91    (len-test #xFFFFFFFE)
92    (len-test #xFFFFFFFFE)
93    (len-test #xFFFFFFFFFE)
94    (len-test #xFFFFFFFFFFE)
95    (len-test #xFFFFFFFFFFFE)
96    (len-test #xFFFFFFFFFFFFE)
97    (len-test #xFFFFFFFFFFFFFE)
98    (len-test #xFFFFFFFFFFFFFFE)
99    (len-test #xFFFFFFFFFFFFFFFE)
100    (len-test #x-E)
101    (len-test #x-FE)
102    (len-test #x-FFE)
103    (len-test #x-FFFE)
104    (len-test #x-FFFFE)
105    (len-test #x-FFFFFE)
106    (len-test #x-FFFFFFE)
107    (len-test #x-FFFFFFFE)
108    (len-test #x-FFFFFFFFE)
109    (len-test #x-FFFFFFFFFE)
110    (len-test #x-FFFFFFFFFFE)
111    (len-test #x-FFFFFFFFFFFE)
112    (len-test #x-FFFFFFFFFFFFE)
113    (len-test #x-FFFFFFFFFFFFFE)
114    (len-test #x-FFFFFFFFFFFFFFE)
115    (len-test #x-FFFFFFFFFFFFFFFE)
116
117    (len-test #x1)
118    (len-test #x1F)
119    (len-test #x1FF)
120    (len-test #x1FFF)
121    (len-test #x1FFFF)
122    (len-test #x1FFFFF)
123    (len-test #x1FFFFFF)
124    (len-test #x1FFFFFFF)
125    (len-test #x1FFFFFFFF)
126    (len-test #x1FFFFFFFFF)
127    (len-test #x1FFFFFFFFFF)
128    (len-test #x1FFFFFFFFFFF)
129    (len-test #x1FFFFFFFFFFFF)
130    (len-test #x1FFFFFFFFFFFFF)
131    (len-test #x1FFFFFFFFFFFFFF)
132    (len-test #x1FFFFFFFFFFFFFFF)
133    (len-test #x-1)
134    (len-test #x-1F)
135    (len-test #x-1FF)
136    (len-test #x-1FFF)
137    (len-test #x-1FFFF)
138    (len-test #x-1FFFFF)
139    (len-test #x-1FFFFFF)
140    (len-test #x-1FFFFFFF)
141    (len-test #x-1FFFFFFFF)
142    (len-test #x-1FFFFFFFFF)
143    (len-test #x-1FFFFFFFFFF)
144    (len-test #x-1FFFFFFFFFFF)
145    (len-test #x-1FFFFFFFFFFFF)
146    (len-test #x-1FFFFFFFFFFFFF)
147    (len-test #x-1FFFFFFFFFFFFFF)
148    (len-test #x-1FFFFFFFFFFFFFFF)
149
150    (len-test #x1)
151    (len-test #x10)
152    (len-test #x100)
153    (len-test #x1000)
154    (len-test #x10000)
155    (len-test #x100000)
156    (len-test #x1000000)
157    (len-test #x10000000)
158    (len-test #x100000000)
159    (len-test #x1000000000)
160    (len-test #x10000000000)
161    (len-test #x100000000000)
162    (len-test #x1000000000000)
163    (len-test #x10000000000000)
164    (len-test #x100000000000000)
165    (len-test #x1000000000000000)
166    (len-test #x-1)
167    (len-test #x-10)
168    (len-test #x-100)
169    (len-test #x-1000)
170    (len-test #x-10000)
171    (len-test #x-100000)
172    (len-test #x-1000000)
173    (len-test #x-10000000)
174    (len-test #x-100000000)
175    (len-test #x-1000000000)
176    (len-test #x-10000000000)
177    (len-test #x-100000000000)
178    (len-test #x-1000000000000)
179    (len-test #x-10000000000000)
180    (len-test #x-100000000000000)
181    (len-test #x-1000000000000000)
182
183    (len-test #x1)
184    (len-test #x11)
185    (len-test #x101)
186    (len-test #x1001)
187    (len-test #x10001)
188    (len-test #x100001)
189    (len-test #x1000001)
190    (len-test #x10000001)
191    (len-test #x100000001)
192    (len-test #x1000000001)
193    (len-test #x10000000001)
194    (len-test #x100000000001)
195    (len-test #x1000000000001)
196    (len-test #x10000000000001)
197    (len-test #x100000000000001)
198    (len-test #x1000000000000001)
199    (len-test #x-1)
200    (len-test #x-11)
201    (len-test #x-101)
202    (len-test #x-1001)
203    (len-test #x-10001)
204    (len-test #x-100001)
205    (len-test #x-1000001)
206    (len-test #x-10000001)
207    (len-test #x-100000001)
208    (len-test #x-1000000001)
209    (len-test #x-10000000001)
210    (len-test #x-100000000001)
211    (len-test #x-1000000000001)
212    (len-test #x-10000000000001)
213    (len-test #x-100000000000001)
214    (len-test #x-1000000000000001)
215
216    (len-test (greatest-fixnum))
217    (len-test (least-fixnum))
218
219    (count-test 1)
220    (count-test 28472347823493290482390849023840928390482309480923840923840983)
221    (count-test -847234234903290482390849023840928390482309480923840923840983)
222    (count-test (greatest-fixnum))
223    (count-test (least-fixnum))
224
225    (test (bitwise-not 12) -13)
226    (test (bitwise-not -12) 11)
227    (test (bitwise-not -1) 0)
228    (test (bitwise-not 0) -1)
229    (test (least-fixnum) (bitwise-not (greatest-fixnum)))
230    (test (greatest-fixnum) (bitwise-not (least-fixnum)))
231
232    (test (bitwise-not 38947389478348937489374)
233          -38947389478348937489375)
234    (test (bitwise-not #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)
235          -22300745198530623141535718272648361505980416)
236    (test (bitwise-not -38947389478348937489375)
237          38947389478348937489374)
238    (test (bitwise-not #x-FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)
239          22300745198530623141535718272648361505980414)
240    (test (bitwise-not #xFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)
241          -340282366920938463463374607431768211456)
242    (test (bitwise-not #x-FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF)
243          340282366920938463463374607431768211454)
244    (test (bitwise-not #x1000000000000000000000000)
245          -79228162514264337593543950337)
246    (test (bitwise-not #x-1000000000000000000000000)
247          79228162514264337593543950335)
248
249    ;; ----------------------------------------
250
251    (test (bitwise-and (expt 2 100) 17) 0)
252    (test (bitwise-and (- (expt 2 100) 1) 17) 17)
253    (test (bitwise-and (- (expt 2 100) 1) (expt 2 90)) (expt 2 90))
254
255    (test (bitwise-xor (expt 2 100) 17) (bitwise-ior (expt 2 100) 17))
256    (test (bitwise-xor (- (expt 2 100) 1) 17) (- (expt 2 100) 18))
257    (test (bitwise-xor (- (expt 2 100) 1) (expt 2 90)) (- (expt 2 100) (expt 2 90) 1))
258
259    (test (bitwise-if (expt 2 100) -1 1) (+ (expt 2 100) 1))
260    (test (bitwise-if (expt 2 100) 1 1) 1)
261    (test (bitwise-if (expt 2 100) (- (expt 2 200) 1) 1) (+ (expt 2 100) 1))
262
263    (test (bitwise-bit-count (expt 2 300)) 1)
264    (test (bitwise-bit-count (- (expt 2 300) 1)) 300)
265    (test (bitwise-bit-count (- (expt 2 300))) -301)
266
267    (test (bitwise-length (expt 2 300)) 301)
268    (test (bitwise-length (- (expt 2 300) 1)) 300)
269    (test (bitwise-length (- (expt 2 300))) 300)
270
271    (test (bitwise-first-bit-set (expt 2 300)) 300)
272    (test (bitwise-first-bit-set (- (expt 2 300) 1)) 0)
273
274    (test (bitwise-bit-set? (expt 2 300) 300) #t)
275    (test (bitwise-bit-set? (expt 2 300) 0) #f)
276    (test (bitwise-bit-set? (- (expt 2 300) 1) 300) #f)
277    (test (bitwise-bit-set? (- (expt 2 300) 1) 299) #t)
278    (test (bitwise-bit-set? (- (expt 2 300) 1) 298) #t)
279    (test (bitwise-bit-set? (- (expt 2 300) 2) 0) #f)
280    (test (bitwise-bit-set? -1 300) #t)
281    (test (bitwise-bit-set? -1 0) #t)
282    (test (bitwise-bit-set? -2 0) #f)
283
284    (test (bitwise-copy-bit-field (expt 2 300) 300 302 0) 0)
285    (test (bitwise-copy-bit-field (expt 2 300) 300 302 1) (expt 2 300))
286    (test (bitwise-copy-bit-field (expt 2 300) 300 302 2) (expt 2 301))
287    (test (bitwise-copy-bit-field (expt 2 300) 300 302 3) (+ (expt 2 300)
288                                                             (expt 2 301)))
289
290    (test (bitwise-arithmetic-shift (expt 2 300) 1) (expt 2 301))
291    (test (bitwise-arithmetic-shift (expt 2 300) -1) (expt 2 299))
292    (test (bitwise-arithmetic-shift (expt 2 300) 300) (expt 2 600))
293    (test (bitwise-arithmetic-shift (expt 2 300) -300) 1)
294
295    (test (bitwise-arithmetic-shift-left (expt 2 300) 1) (expt 2 301))
296    (test (bitwise-arithmetic-shift-right (expt 2 300) 1) (expt 2 299))
297    (test (bitwise-arithmetic-shift-left (expt 2 300) 300) (expt 2 600))
298    (test (bitwise-arithmetic-shift-right (expt 2 300) 300) 1)
299
300    (test (bitwise-rotate-bit-field (expt 2 300) 299 304 2) (expt 2 302))
301    (test (bitwise-rotate-bit-field (expt 2 300) 299 304 4) (expt 2 299))
302
303    (test (bitwise-reverse-bit-field (expt 2 300) 299 304) (expt 2 302))
304
305    ;;
306    ))
307
308