test-suite/tests/bit-operations.test

   1 ;;;; bit-operations.test --- bitwise operations on numbers -*- scheme -*-
   2 ;;;; Copyright (C) 2000, 2001, 2003, 2006 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 (use-modules (test-suite lib)
  19              (ice-9 documentation))
  20
  21
  22 ;;;
  23 ;;; miscellaneous
  24 ;;;
  25
  26 (define (run-tests name-proc test-proc arg-sets)
  27   (for-each
  28    (lambda (arg-set)
  29      (pass-if (apply name-proc arg-set)
  30        (apply test-proc arg-set)))
  31    arg-sets))
  32
  33 (define (documented? object)
  34   (not (not (object-documentation object))))
  35
  36 (define fixnum-bit
  37   (inexact->exact (round (+ (/ (log (+ most-positive-fixnum 1)) (log 2)) 1))))
  38
  39 (define fixnum-min most-negative-fixnum)
  40 (define fixnum-max most-positive-fixnum)
  41
  42 (with-test-prefix "bit-extract"
  43
  44   (pass-if "documented?"
  45     (documented? bit-extract))
  46
  47   (with-test-prefix "extract from zero"
  48
  49     (run-tests
  50      (lambda (a b c d)
  51        (string-append "single bit " (number->string b)))
  52      (lambda (a b c d)
  53        (= (bit-extract a b c) d))
  54      (list
  55       (list 0 0 1 0)
  56       (list 0 1 2 0)
  57       (list 0 (+ fixnum-bit -2) (+ fixnum-bit -1) 0)
  58       (list 0 (+ fixnum-bit -1) (+ fixnum-bit  0) 0)
  59       (list 0 (+ fixnum-bit  0) (+ fixnum-bit  1) 0)
  60       (list 0 (+ fixnum-bit  1) (+ fixnum-bit  2) 0)))
  61
  62     (run-tests
  63      (lambda (a b c d)
  64        (string-append "fixnum-bit - 1 bits starting at " (number->string b)))
  65      (lambda (a b c d)
  66        (= (bit-extract a b c) d))
  67      (list
  68       (list 0 0 (+ fixnum-bit -1) 0)
  69       (list 0 1 (+ fixnum-bit  0) 0)
  70       (list 0 2 (+ fixnum-bit  1) 0)
  71       (list 0 (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -3) 0)
  72       (list 0 (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -2) 0)
  73       (list 0 (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit -1) 0)
  74       (list 0 (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  0) 0)))
  75
  76     (run-tests
  77      (lambda (a b c d)
  78        (string-append "fixnum-bit bits starting at " (number->string b)))
  79      (lambda (a b c d)
  80        (= (bit-extract a b c) d))
  81      (list
  82       (list 0 0 (+ fixnum-bit  0) 0)
  83       (list 0 1 (+ fixnum-bit  1) 0)
  84       (list 0 2 (+ fixnum-bit  2) 0)
  85       (list 0 (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -2) 0)
  86       (list 0 (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -1) 0)
  87       (list 0 (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  0) 0)
  88       (list 0 (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  1) 0)))
  89
  90     (run-tests
  91      (lambda (a b c d)
  92        (string-append "fixnum-bit + 1 bits starting at " (number->string b)))
  93      (lambda (a b c d)
  94        (= (bit-extract a b c) d))
  95      (list
  96       (list 0 0 (+ fixnum-bit  1) 0)
  97       (list 0 1 (+ fixnum-bit  2) 0)
  98       (list 0 2 (+ fixnum-bit  3) 0)
  99       (list 0 (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -1) 0)
 100       (list 0 (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit  0) 0)
 101       (list 0 (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  1) 0)
 102       (list 0 (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  2) 0))))
 103
 104   (with-test-prefix "extract from fixnum-max"
 105
 106     (run-tests
 107      (lambda (a b c d)
 108        (string-append "single bit " (number->string b)))
 109      (lambda (a b c d)
 110        (= (bit-extract a b c) d))
 111      (list
 112       (list fixnum-max 0 1 1)
 113       (list fixnum-max 1 2 1)
 114       (list fixnum-max (+ fixnum-bit -2) (+ fixnum-bit -1) 1)
 115       (list fixnum-max (+ fixnum-bit -1) (+ fixnum-bit  0) 0)
 116       (list fixnum-max (+ fixnum-bit  0) (+ fixnum-bit  1) 0)
 117       (list fixnum-max (+ fixnum-bit  1) (+ fixnum-bit  2) 0)))
 118
 119     (run-tests
 120      (lambda (a b c d)
 121        (string-append "fixnum-bit - 1 bits starting at " (number->string b)))
 122      (lambda (a b c d)
 123        (= (bit-extract a b c) d))
 124      (list
 125       (list fixnum-max 0 (+ fixnum-bit -1) (ash fixnum-max  0))
 126       (list fixnum-max 1 (+ fixnum-bit  0) (ash fixnum-max -1))
 127       (list fixnum-max 2 (+ fixnum-bit  1) (ash fixnum-max -2))
 128       (list fixnum-max (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -3) 1)
 129       (list fixnum-max (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -2) 0)
 130       (list fixnum-max (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit -1) 0)
 131       (list fixnum-max (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  0) 0)))
 132
 133     (run-tests
 134      (lambda (a b c d)
 135        (string-append "fixnum-bit bits starting at " (number->string b)))
 136      (lambda (a b c d)
 137        (= (bit-extract a b c) d))
 138      (list
 139       (list fixnum-max 0 (+ fixnum-bit  0) (ash fixnum-max  0))
 140       (list fixnum-max 1 (+ fixnum-bit  1) (ash fixnum-max -1))
 141       (list fixnum-max 2 (+ fixnum-bit  2) (ash fixnum-max -2))
 142       (list fixnum-max (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -2) 1)
 143       (list fixnum-max (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -1) 0)
 144       (list fixnum-max (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  0) 0)
 145       (list fixnum-max (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  1) 0)))
 146
 147     (run-tests
 148      (lambda (a b c d)
 149        (string-append "fixnum-bit + 1 bits starting at " (number->string b)))
 150      (lambda (a b c d)
 151        (= (bit-extract a b c) d))
 152      (list
 153       (list fixnum-max 0 (+ fixnum-bit  1) (ash fixnum-max  0))
 154       (list fixnum-max 1 (+ fixnum-bit  2) (ash fixnum-max -1))
 155       (list fixnum-max 2 (+ fixnum-bit  3) (ash fixnum-max -2))
 156       (list fixnum-max (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -1) 1)
 157       (list fixnum-max (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit  0) 0)
 158       (list fixnum-max (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  1) 0)
 159       (list fixnum-max (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  2) 0))))
 160
 161   (with-test-prefix "extract from fixnum-max + 1"
 162
 163     (run-tests
 164      (lambda (a b c d)
 165        (string-append "single bit " (number->string b)))
 166      (lambda (a b c d)
 167        (= (bit-extract a b c) d))
 168      (list
 169       (list (+ fixnum-max 1) 0 1 0)
 170       (list (+ fixnum-max 1) 1 2 0)
 171       (list (+ fixnum-max 1) (+ fixnum-bit -2) (+ fixnum-bit -1) 0)
 172       (list (+ fixnum-max 1) (+ fixnum-bit -1) (+ fixnum-bit  0) 1)
 173       (list (+ fixnum-max 1) (+ fixnum-bit  0) (+ fixnum-bit  1) 0)
 174       (list (+ fixnum-max 1) (+ fixnum-bit  1) (+ fixnum-bit  2) 0)))
 175
 176     (run-tests
 177      (lambda (a b c d)
 178        (string-append "fixnum-bit - 1 bits starting at " (number->string b)))
 179      (lambda (a b c d)
 180        (= (bit-extract a b c) d))
 181      (list
 182       (list (+ fixnum-max 1) 0 (+ fixnum-bit -1) (ash 0 (- fixnum-bit 1)))
 183       (list (+ fixnum-max 1) 1 (+ fixnum-bit  0) (ash 1 (- fixnum-bit 2)))
 184       (list (+ fixnum-max 1) 2 (+ fixnum-bit  1) (ash 1 (- fixnum-bit 3)))
 185       (list (+ fixnum-max 1) (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -3) 2)
 186       (list (+ fixnum-max 1) (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -2) 1)
 187       (list (+ fixnum-max 1) (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit -1) 0)
 188       (list (+ fixnum-max 1) (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  0) 0)))
 189
 190     (run-tests
 191      (lambda (a b c d)
 192        (string-append "fixnum-bit bits starting at " (number->string b)))
 193      (lambda (a b c d)
 194        (= (bit-extract a b c) d))
 195      (list
 196       (list (+ fixnum-max 1) 0 (+ fixnum-bit  0) (ash 1 (- fixnum-bit 1)))
 197       (list (+ fixnum-max 1) 1 (+ fixnum-bit  1) (ash 1 (- fixnum-bit 2)))
 198       (list (+ fixnum-max 1) 2 (+ fixnum-bit  2) (ash 1 (- fixnum-bit 3)))
 199       (list (+ fixnum-max 1) (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -2) 2)
 200       (list (+ fixnum-max 1) (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -1) 1)
 201       (list (+ fixnum-max 1) (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  0) 0)
 202       (list (+ fixnum-max 1) (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  1) 0)))
 203
 204     (run-tests
 205      (lambda (a b c d)
 206        (string-append "fixnum-bit + 1 bits starting at " (number->string b)))
 207      (lambda (a b c d)
 208        (= (bit-extract a b c) d))
 209      (list
 210       (list (+ fixnum-max 1) 0 (+ fixnum-bit  1) (ash 1 (- fixnum-bit 1)))
 211       (list (+ fixnum-max 1) 1 (+ fixnum-bit  2) (ash 1 (- fixnum-bit 2)))
 212       (list (+ fixnum-max 1) 2 (+ fixnum-bit  3) (ash 1 (- fixnum-bit 3)))
 213       (list (+ fixnum-max 1) (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -1) 2)
 214       (list (+ fixnum-max 1) (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit  0) 1)
 215       (list (+ fixnum-max 1) (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  1) 0)
 216       (list (+ fixnum-max 1) (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  2) 0))))
 217
 218   (with-test-prefix "extract from fixnum-min"
 219
 220     (run-tests
 221      (lambda (a b c d)
 222        (string-append "single bit " (number->string b)))
 223      (lambda (a b c d)
 224        (= (bit-extract a b c) d))
 225      (list
 226       (list fixnum-min 0 1 0)
 227       (list fixnum-min 1 2 0)
 228       (list fixnum-min (+ fixnum-bit -2) (+ fixnum-bit -1) 0)
 229       (list fixnum-min (+ fixnum-bit -1) (+ fixnum-bit  0) 1)
 230       (list fixnum-min (+ fixnum-bit  0) (+ fixnum-bit  1) 1)
 231       (list fixnum-min (+ fixnum-bit  1) (+ fixnum-bit  2) 1)))
 232
 233     (run-tests
 234      (lambda (a b c d)
 235        (string-append "fixnum-bit - 1 bits starting at " (number->string b)))
 236      (lambda (a b c d)
 237        (= (bit-extract a b c) d))
 238      (list
 239       (list fixnum-min 0 (+ fixnum-bit -1) (ash 0 (- fixnum-bit 1)))
 240       (list fixnum-min 1 (+ fixnum-bit  0) (ash 1 (- fixnum-bit 2)))
 241       (list fixnum-min 2 (+ fixnum-bit  1) (ash 3 (- fixnum-bit 3)))
 242       (list fixnum-min (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -3)
 243             (- (ash 1   (- fixnum-bit 1)) 2))
 244       (list fixnum-min (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -2)
 245             (- (ash 1   (- fixnum-bit 1)) 1))
 246       (list fixnum-min (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit -1)
 247             (- (ash 1   (- fixnum-bit 1)) 1))
 248       (list fixnum-min (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  0)
 249             (- (ash 1   (- fixnum-bit 1)) 1))))
 250
 251     (run-tests
 252      (lambda (a b c d)
 253        (string-append "fixnum-bit bits starting at " (number->string b)))
 254      (lambda (a b c d)
 255        (= (bit-extract a b c) d))
 256      (list
 257       (list fixnum-min 0 (+ fixnum-bit  0) (ash 1 (- fixnum-bit 1)))
 258       (list fixnum-min 1 (+ fixnum-bit  1) (ash 3 (- fixnum-bit 2)))
 259       (list fixnum-min 2 (+ fixnum-bit  2) (ash 7 (- fixnum-bit 3)))
 260       (list fixnum-min (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -2)
 261             (- (ash 1   fixnum-bit) 2))
 262       (list fixnum-min (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -1)
 263             (- (ash 1   fixnum-bit) 1))
 264       (list fixnum-min (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  0)
 265             (- (ash 1   fixnum-bit) 1))
 266       (list fixnum-min (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  1)
 267             (- (ash 1   fixnum-bit) 1))))
 268
 269     (run-tests
 270      (lambda (a b c d)
 271        (string-append "fixnum-bit + 1 bits starting at " (number->string b)))
 272      (lambda (a b c d)
 273        (= (bit-extract a b c) d))
 274      (list
 275       (list fixnum-min 0 (+ fixnum-bit  1) (ash  3 (- fixnum-bit 1)))
 276       (list fixnum-min 1 (+ fixnum-bit  2) (ash  7 (- fixnum-bit 2)))
 277       (list fixnum-min 2 (+ fixnum-bit  3) (ash 15 (- fixnum-bit 3)))
 278       (list fixnum-min (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -1)
 279             (- (ash 1 (+ fixnum-bit 1)) 2))
 280       (list fixnum-min (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit  0)
 281             (- (ash 1 (+ fixnum-bit 1)) 1))
 282       (list fixnum-min (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  1)
 283             (- (ash 1 (+ fixnum-bit 1)) 1))
 284       (list fixnum-min (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  2)
 285             (- (ash 1 (+ fixnum-bit 1)) 1)))))
 286
 287   (with-test-prefix "extract from fixnum-min - 1"
 288
 289     (run-tests
 290      (lambda (a b c d)
 291        (string-append "single bit " (number->string b)))
 292      (lambda (a b c d)
 293        (= (bit-extract a b c) d))
 294      (list
 295       (list (- fixnum-min 1) 0 1 1)
 296       (list (- fixnum-min 1) 1 2 1)
 297       (list (- fixnum-min 1) (+ fixnum-bit -2) (+ fixnum-bit -1) 1)
 298       (list (- fixnum-min 1) (+ fixnum-bit -1) (+ fixnum-bit  0) 0)
 299       (list (- fixnum-min 1) (+ fixnum-bit  0) (+ fixnum-bit  1) 1)
 300       (list (- fixnum-min 1) (+ fixnum-bit  1) (+ fixnum-bit  2) 1)))
 301
 302     (run-tests
 303      (lambda (a b c d)
 304        (string-append "fixnum-bit - 1 bits starting at " (number->string b)))
 305      (lambda (a b c d)
 306        (= (bit-extract a b c) d))
 307      (list
 308       (list (- fixnum-min 1) 0 (+ fixnum-bit -1)
 309             (- (ash 1 (- fixnum-bit 1)) 1 (ash 0 (- fixnum-bit 1))))
 310       (list (- fixnum-min 1) 1 (+ fixnum-bit  0)
 311             (- (ash 1 (- fixnum-bit 1)) 1 (ash 1 (- fixnum-bit 2))))
 312       (list (- fixnum-min 1) 2 (+ fixnum-bit  1)
 313             (- (ash 1 (- fixnum-bit 1)) 1 (ash 1 (- fixnum-bit 3))))
 314       (list (- fixnum-min 1) (+ fixnum-bit -2)
 315             (+ fixnum-bit fixnum-bit -3) (- (ash 1 (- fixnum-bit 1)) 3))
 316       (list (- fixnum-min 1) (+ fixnum-bit -1)
 317             (+ fixnum-bit fixnum-bit -2) (- (ash 1 (- fixnum-bit 1)) 2))
 318       (list (- fixnum-min 1) (+ fixnum-bit  0)
 319             (+ fixnum-bit fixnum-bit -1) (- (ash 1 (- fixnum-bit 1)) 1))
 320       (list (- fixnum-min 1) (+ fixnum-bit  1)
 321             (+ fixnum-bit fixnum-bit  0) (- (ash 1 (- fixnum-bit 1)) 1))))
 322
 323     (run-tests
 324      (lambda (a b c d)
 325        (string-append "fixnum-bit bits starting at " (number->string b)))
 326      (lambda (a b c d)
 327        (= (bit-extract a b c) d))
 328      (list
 329       (list (- fixnum-min 1) 0 (+ fixnum-bit  0)
 330             (- (ash 1 fixnum-bit) 1 (ash 1 (- fixnum-bit 1))))
 331       (list (- fixnum-min 1) 1 (+ fixnum-bit  1)
 332             (- (ash 1 fixnum-bit) 1 (ash 1 (- fixnum-bit 2))))
 333       (list (- fixnum-min 1) 2 (+ fixnum-bit  2)
 334             (- (ash 1 fixnum-bit) 1 (ash 1 (- fixnum-bit 3))))
 335       (list (- fixnum-min 1) (+ fixnum-bit -2)
 336             (+ fixnum-bit fixnum-bit -2) (- (ash 1 fixnum-bit) 3))
 337       (list (- fixnum-min 1) (+ fixnum-bit -1)
 338             (+ fixnum-bit fixnum-bit -1) (- (ash 1 fixnum-bit) 2))
 339       (list (- fixnum-min 1) (+ fixnum-bit  0)
 340             (+ fixnum-bit fixnum-bit  0) (- (ash 1 fixnum-bit) 1))
 341       (list (- fixnum-min 1) (+ fixnum-bit  1)
 342             (+ fixnum-bit fixnum-bit  1) (- (ash 1 fixnum-bit) 1))))
 343
 344     (run-tests
 345      (lambda (a b c d)
 346        (string-append "fixnum-bit + 1 bits starting at " (number->string b)))
 347      (lambda (a b c d)
 348        (= (bit-extract a b c) d))
 349      (list
 350       (list (- fixnum-min 1) 0 (+ fixnum-bit  1)
 351             (- (ash 1 (+ fixnum-bit 1)) 1 (ash 1 (- fixnum-bit 1))))
 352       (list (- fixnum-min 1) 1 (+ fixnum-bit  2)
 353             (- (ash 1 (+ fixnum-bit 1)) 1 (ash 1 (- fixnum-bit 2))))
 354       (list (- fixnum-min 1) 2 (+ fixnum-bit  3)
 355             (- (ash 1 (+ fixnum-bit 1)) 1 (ash 1 (- fixnum-bit 3))))
 356       (list (- fixnum-min 1) (+ fixnum-bit -2)
 357             (+ fixnum-bit fixnum-bit -1) (- (ash 1 (+ fixnum-bit 1)) 3))
 358       (list (- fixnum-min 1) (+ fixnum-bit -1)
 359             (+ fixnum-bit fixnum-bit  0) (- (ash 1 (+ fixnum-bit 1)) 2))
 360       (list (- fixnum-min 1) (+ fixnum-bit  0)
 361             (+ fixnum-bit fixnum-bit  1) (- (ash 1 (+ fixnum-bit 1)) 1))
 362       (list (- fixnum-min 1) (+ fixnum-bit  1)
 363             (+ fixnum-bit fixnum-bit  2) (- (ash 1 (+ fixnum-bit 1)) 1))))))