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