guile18/test-suite/tests/bit-operations.test

   1 ;;;; bit-operations.test --- bitwise operations on numbers -*- scheme -*-
   2 ;;;; Copyright (C) 2000, 2001, 2003, 2006, 2009 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 2.1 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))))))