test-suite/tests/bit-operations.test

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