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