test-suite/tests/bit-operations.test

   1 ;;;; bit-operations.test --- bitwise operations on numbers -*- scheme -*-
   2 ;;;; Copyright (C) 2000 Free Software Foundation, Inc.
   3 ;;;;
   4 ;;;; This program is free software; you can redistribute it and/or modify
   5 ;;;; it under the terms of the GNU General Public License as published by
   6 ;;;; the Free Software Foundation; either version 2, or (at your option)
   7 ;;;; any later version.
   8 ;;;;
   9 ;;;; This program 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
  12 ;;;; GNU General Public License for more details.
  13 ;;;;
  14 ;;;; You should have received a copy of the GNU General Public License
  15 ;;;; along with this software; see the file COPYING.  If not, write to
  16 ;;;; the Free Software Foundation, Inc., 59 Temple Place, Suite 330,
  17 ;;;; Boston, MA 02111-1307 USA
  18 ;;;;
  19 ;;;; As a special exception, the Free Software Foundation gives permission
  20 ;;;; for additional uses of the text contained in its release of GUILE.
  21 ;;;;
  22 ;;;; The exception is that, if you link the GUILE library with other files
  23 ;;;; to produce an executable, this does not by itself cause the
  24 ;;;; resulting executable to be covered by the GNU General Public License.
  25 ;;;; Your use of that executable is in no way restricted on account of
  26 ;;;; linking the GUILE library code into it.
  27 ;;;;
  28 ;;;; This exception does not however invalidate any other reasons why
  29 ;;;; the executable file might be covered by the GNU General Public License.
  30 ;;;;
  31 ;;;; This exception applies only to the code released by the
  32 ;;;; Free Software Foundation under the name GUILE.  If you copy
  33 ;;;; code from other Free Software Foundation releases into a copy of
  34 ;;;; GUILE, as the General Public License permits, the exception does
  35 ;;;; not apply to the code that you add in this way.  To avoid misleading
  36 ;;;; anyone as to the status of such modified files, you must delete
  37 ;;;; this exception notice from them.
  38 ;;;;
  39 ;;;; If you write modifications of your own for GUILE, it is your choice
  40 ;;;; whether to permit this exception to apply to your modifications.
  41 ;;;; If you do not wish that, delete this exception notice.
  42
  43 (use-modules (ice-9 documentation))
  44
  45
  46 ;;;
  47 ;;; miscellaneous
  48 ;;;
  49
  50 (define (run-tests name-proc test-proc arg-sets)
  51   (for-each
  52    (lambda (arg-set)
  53      (pass-if (apply name-proc arg-set)
  54        (apply test-proc arg-set)))
  55    arg-sets))
  56
  57 (define (documented? object)
  58   (object-documentation object))
  59
  60 (define fixnum-bit 30)
  61 (define fixnum-min most-negative-fixnum)
  62 (define fixnum-max most-positive-fixnum)
  63
  64 (with-test-prefix "bit-extract"
  65
  66   (pass-if "documented?"
  67     (documented? bit-extract))
  68
  69   (with-test-prefix "extract from zero"
  70
  71     (run-tests
  72      (lambda (a b c d)
  73        (string-append "single bit " (number->string b)))
  74      (lambda (a b c d)
  75        (= (bit-extract a b c) d))
  76      (list
  77       (list 0 0 1 0)
  78       (list 0 1 2 0)
  79       (list 0 (+ fixnum-bit -2) (+ fixnum-bit -1) 0)
  80       (list 0 (+ fixnum-bit -1) (+ fixnum-bit  0) 0)
  81       (list 0 (+ fixnum-bit  0) (+ fixnum-bit  1) 0)
  82       (list 0 (+ fixnum-bit  1) (+ fixnum-bit  2) 0)))
  83
  84     (run-tests
  85      (lambda (a b c d)
  86        (string-append "fixnum-bit - 1 bits starting at " (number->string b)))
  87      (lambda (a b c d)
  88        (= (bit-extract a b c) d))
  89      (list
  90       (list 0 0 (+ fixnum-bit -1) 0)
  91       (list 0 1 (+ fixnum-bit  0) 0)
  92       (list 0 2 (+ fixnum-bit  1) 0)
  93       (list 0 (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -3) 0)
  94       (list 0 (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -2) 0)
  95       (list 0 (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit -1) 0)
  96       (list 0 (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  0) 0)))
  97
  98     (run-tests
  99      (lambda (a b c d)
 100        (string-append "fixnum-bit bits starting at " (number->string b)))
 101      (lambda (a b c d)
 102        (= (bit-extract a b c) d))
 103      (list
 104       (list 0 0 (+ fixnum-bit  0) 0)
 105       (list 0 1 (+ fixnum-bit  1) 0)
 106       (list 0 2 (+ fixnum-bit  2) 0)
 107       (list 0 (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -2) 0)
 108       (list 0 (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -1) 0)
 109       (list 0 (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  0) 0)
 110       (list 0 (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  1) 0)))
 111
 112     (run-tests
 113      (lambda (a b c d)
 114        (string-append "fixnum-bit + 1 bits starting at " (number->string b)))
 115      (lambda (a b c d)
 116        (= (bit-extract a b c) d))
 117      (list
 118       (list 0 0 (+ fixnum-bit  1) 0)
 119       (list 0 1 (+ fixnum-bit  2) 0)
 120       (list 0 2 (+ fixnum-bit  3) 0)
 121       (list 0 (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -1) 0)
 122       (list 0 (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit  0) 0)
 123       (list 0 (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  1) 0)
 124       (list 0 (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  2) 0))))
 125
 126   (with-test-prefix "extract from fixnum-max"
 127
 128     (run-tests
 129      (lambda (a b c d)
 130        (string-append "single bit " (number->string b)))
 131      (lambda (a b c d)
 132        (= (bit-extract a b c) d))
 133      (list
 134       (list fixnum-max 0 1 1)
 135       (list fixnum-max 1 2 1)
 136       (list fixnum-max (+ fixnum-bit -2) (+ fixnum-bit -1) 1)
 137       (list fixnum-max (+ fixnum-bit -1) (+ fixnum-bit  0) 0)
 138       (list fixnum-max (+ fixnum-bit  0) (+ fixnum-bit  1) 0)
 139       (list fixnum-max (+ fixnum-bit  1) (+ fixnum-bit  2) 0)))
 140
 141     (run-tests
 142      (lambda (a b c d)
 143        (string-append "fixnum-bit - 1 bits starting at " (number->string b)))
 144      (lambda (a b c d)
 145        (= (bit-extract a b c) d))
 146      (list
 147       (list fixnum-max 0 (+ fixnum-bit -1) (ash fixnum-max  0))
 148       (list fixnum-max 1 (+ fixnum-bit  0) (ash fixnum-max -1))
 149       (list fixnum-max 2 (+ fixnum-bit  1) (ash fixnum-max -2))
 150       (list fixnum-max (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -3) 1)
 151       (list fixnum-max (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -2) 0)
 152       (list fixnum-max (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit -1) 0)
 153       (list fixnum-max (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  0) 0)))
 154
 155     (run-tests
 156      (lambda (a b c d)
 157        (string-append "fixnum-bit bits starting at " (number->string b)))
 158      (lambda (a b c d)
 159        (= (bit-extract a b c) d))
 160      (list
 161       (list fixnum-max 0 (+ fixnum-bit  0) (ash fixnum-max  0))
 162       (list fixnum-max 1 (+ fixnum-bit  1) (ash fixnum-max -1))
 163       (list fixnum-max 2 (+ fixnum-bit  2) (ash fixnum-max -2))
 164       (list fixnum-max (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -2) 1)
 165       (list fixnum-max (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -1) 0)
 166       (list fixnum-max (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  0) 0)
 167       (list fixnum-max (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  1) 0)))
 168
 169     (run-tests
 170      (lambda (a b c d)
 171        (string-append "fixnum-bit + 1 bits starting at " (number->string b)))
 172      (lambda (a b c d)
 173        (= (bit-extract a b c) d))
 174      (list
 175       (list fixnum-max 0 (+ fixnum-bit  1) (ash fixnum-max  0))
 176       (list fixnum-max 1 (+ fixnum-bit  2) (ash fixnum-max -1))
 177       (list fixnum-max 2 (+ fixnum-bit  3) (ash fixnum-max -2))
 178       (list fixnum-max (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -1) 1)
 179       (list fixnum-max (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit  0) 0)
 180       (list fixnum-max (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  1) 0)
 181       (list fixnum-max (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  2) 0))))
 182
 183   (with-test-prefix "extract from fixnum-max + 1"
 184
 185     (run-tests
 186      (lambda (a b c d)
 187        (string-append "single bit " (number->string b)))
 188      (lambda (a b c d)
 189        (= (bit-extract a b c) d))
 190      (list
 191       (list (+ fixnum-max 1) 0 1 0)
 192       (list (+ fixnum-max 1) 1 2 0)
 193       (list (+ fixnum-max 1) (+ fixnum-bit -2) (+ fixnum-bit -1) 0)
 194       (list (+ fixnum-max 1) (+ fixnum-bit -1) (+ fixnum-bit  0) 1)
 195       (list (+ fixnum-max 1) (+ fixnum-bit  0) (+ fixnum-bit  1) 0)
 196       (list (+ fixnum-max 1) (+ fixnum-bit  1) (+ fixnum-bit  2) 0)))
 197
 198     (run-tests
 199      (lambda (a b c d)
 200        (string-append "fixnum-bit - 1 bits starting at " (number->string b)))
 201      (lambda (a b c d)
 202        (= (bit-extract a b c) d))
 203      (list
 204       (list (+ fixnum-max 1) 0 (+ fixnum-bit -1) (ash 0 (- fixnum-bit 1)))
 205       (list (+ fixnum-max 1) 1 (+ fixnum-bit  0) (ash 1 (- fixnum-bit 2)))
 206       (list (+ fixnum-max 1) 2 (+ fixnum-bit  1) (ash 1 (- fixnum-bit 3)))
 207       (list (+ fixnum-max 1) (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -3) 2)
 208       (list (+ fixnum-max 1) (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -2) 1)
 209       (list (+ fixnum-max 1) (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit -1) 0)
 210       (list (+ fixnum-max 1) (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  0) 0)))
 211
 212     (run-tests
 213      (lambda (a b c d)
 214        (string-append "fixnum-bit bits starting at " (number->string b)))
 215      (lambda (a b c d)
 216        (= (bit-extract a b c) d))
 217      (list
 218       (list (+ fixnum-max 1) 0 (+ fixnum-bit  0) (ash 1 (- fixnum-bit 1)))
 219       (list (+ fixnum-max 1) 1 (+ fixnum-bit  1) (ash 1 (- fixnum-bit 2)))
 220       (list (+ fixnum-max 1) 2 (+ fixnum-bit  2) (ash 1 (- fixnum-bit 3)))
 221       (list (+ fixnum-max 1) (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -2) 2)
 222       (list (+ fixnum-max 1) (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -1) 1)
 223       (list (+ fixnum-max 1) (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  0) 0)
 224       (list (+ fixnum-max 1) (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  1) 0)))
 225
 226     (run-tests
 227      (lambda (a b c d)
 228        (string-append "fixnum-bit + 1 bits starting at " (number->string b)))
 229      (lambda (a b c d)
 230        (= (bit-extract a b c) d))
 231      (list
 232       (list (+ fixnum-max 1) 0 (+ fixnum-bit  1) (ash 1 (- fixnum-bit 1)))
 233       (list (+ fixnum-max 1) 1 (+ fixnum-bit  2) (ash 1 (- fixnum-bit 2)))
 234       (list (+ fixnum-max 1) 2 (+ fixnum-bit  3) (ash 1 (- fixnum-bit 3)))
 235       (list (+ fixnum-max 1) (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -1) 2)
 236       (list (+ fixnum-max 1) (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit  0) 1)
 237       (list (+ fixnum-max 1) (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  1) 0)
 238       (list (+ fixnum-max 1) (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  2) 0))))
 239
 240   (with-test-prefix "extract from fixnum-min"
 241
 242     (run-tests
 243      (lambda (a b c d)
 244        (string-append "single bit " (number->string b)))
 245      (lambda (a b c d)
 246        (= (bit-extract a b c) d))
 247      (list
 248       (list fixnum-min 0 1 0)
 249       (list fixnum-min 1 2 0)
 250       (list fixnum-min (+ fixnum-bit -2) (+ fixnum-bit -1) 0)
 251       (list fixnum-min (+ fixnum-bit -1) (+ fixnum-bit  0) 1)
 252       (list fixnum-min (+ fixnum-bit  0) (+ fixnum-bit  1) 1)
 253       (list fixnum-min (+ fixnum-bit  1) (+ fixnum-bit  2) 1)))
 254
 255     (run-tests
 256      (lambda (a b c d)
 257        (string-append "fixnum-bit - 1 bits starting at " (number->string b)))
 258      (lambda (a b c d)
 259        (= (bit-extract a b c) d))
 260      (list
 261       (list fixnum-min 0 (+ fixnum-bit -1) (ash 0 (- fixnum-bit 1)))
 262       (list fixnum-min 1 (+ fixnum-bit  0) (ash 1 (- fixnum-bit 2)))
 263       (list fixnum-min 2 (+ fixnum-bit  1) (ash 3 (- fixnum-bit 3)))
 264       (list fixnum-min (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -3) (- (ash 1 (- fixnum-bit 1)) 2))
 265       (list fixnum-min (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -2) (- (ash 1 (- fixnum-bit 1)) 1))
 266       (list fixnum-min (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit -1) (- (ash 1 (- fixnum-bit 1)) 1))
 267       (list fixnum-min (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  0) (- (ash 1 (- fixnum-bit 1)) 1))))
 268
 269     (run-tests
 270      (lambda (a b c d)
 271        (string-append "fixnum-bit 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  0) (ash 1 (- fixnum-bit 1)))
 276       (list fixnum-min 1 (+ fixnum-bit  1) (ash 3 (- fixnum-bit 2)))
 277       (list fixnum-min 2 (+ fixnum-bit  2) (ash 7 (- fixnum-bit 3)))
 278       (list fixnum-min (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -2) (- (ash 1 fixnum-bit) 2))
 279       (list fixnum-min (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -1) (- (ash 1 fixnum-bit) 1))
 280       (list fixnum-min (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  0) (- (ash 1 fixnum-bit) 1))
 281       (list fixnum-min (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  1) (- (ash 1 fixnum-bit) 1))))
 282
 283     (run-tests
 284      (lambda (a b c d)
 285        (string-append "fixnum-bit + 1 bits starting at " (number->string b)))
 286      (lambda (a b c d)
 287        (= (bit-extract a b c) d))
 288      (list
 289       (list fixnum-min 0 (+ fixnum-bit  1) (ash  3 (- fixnum-bit 1)))
 290       (list fixnum-min 1 (+ fixnum-bit  2) (ash  7 (- fixnum-bit 2)))
 291       (list fixnum-min 2 (+ fixnum-bit  3) (ash 15 (- fixnum-bit 3)))
 292       (list fixnum-min (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -1) (- (ash 1 (+ fixnum-bit 1)) 2))
 293       (list fixnum-min (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit  0) (- (ash 1 (+ fixnum-bit 1)) 1))
 294       (list fixnum-min (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  1) (- (ash 1 (+ fixnum-bit 1)) 1))
 295       (list fixnum-min (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  2) (- (ash 1 (+ fixnum-bit 1)) 1)))))
 296
 297   (with-test-prefix "extract from fixnum-min - 1"
 298
 299     (run-tests
 300      (lambda (a b c d)
 301        (string-append "single bit " (number->string b)))
 302      (lambda (a b c d)
 303        (= (bit-extract a b c) d))
 304      (list
 305       (list (- fixnum-min 1) 0 1 1)
 306       (list (- fixnum-min 1) 1 2 1)
 307       (list (- fixnum-min 1) (+ fixnum-bit -2) (+ fixnum-bit -1) 1)
 308       (list (- fixnum-min 1) (+ fixnum-bit -1) (+ fixnum-bit  0) 0)
 309       (list (- fixnum-min 1) (+ fixnum-bit  0) (+ fixnum-bit  1) 1)
 310       (list (- fixnum-min 1) (+ fixnum-bit  1) (+ fixnum-bit  2) 1)))
 311
 312     (run-tests
 313      (lambda (a b c d)
 314        (string-append "fixnum-bit - 1 bits starting at " (number->string b)))
 315      (lambda (a b c d)
 316        (= (bit-extract a b c) d))
 317      (list
 318       (list (- fixnum-min 1) 0 (+ fixnum-bit -1) (- (ash 1 (- fixnum-bit 1)) 1 (ash 0 (- fixnum-bit 1))))
 319       (list (- fixnum-min 1) 1 (+ fixnum-bit  0) (- (ash 1 (- fixnum-bit 1)) 1 (ash 1 (- fixnum-bit 2))))
 320       (list (- fixnum-min 1) 2 (+ fixnum-bit  1) (- (ash 1 (- fixnum-bit 1)) 1 (ash 1 (- fixnum-bit 3))))
 321       (list (- fixnum-min 1) (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -3) (- (ash 1 (- fixnum-bit 1)) 3))
 322       (list (- fixnum-min 1) (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -2) (- (ash 1 (- fixnum-bit 1)) 2))
 323       (list (- fixnum-min 1) (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit -1) (- (ash 1 (- fixnum-bit 1)) 1))
 324       (list (- fixnum-min 1) (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  0) (- (ash 1 (- fixnum-bit 1)) 1))))
 325
 326     (run-tests
 327      (lambda (a b c d)
 328        (string-append "fixnum-bit bits starting at " (number->string b)))
 329      (lambda (a b c d)
 330        (= (bit-extract a b c) d))
 331      (list
 332       (list (- fixnum-min 1) 0 (+ fixnum-bit  0) (- (ash 1 fixnum-bit) 1 (ash 1 (- fixnum-bit 1))))
 333       (list (- fixnum-min 1) 1 (+ fixnum-bit  1) (- (ash 1 fixnum-bit) 1 (ash 1 (- fixnum-bit 2))))
 334       (list (- fixnum-min 1) 2 (+ fixnum-bit  2) (- (ash 1 fixnum-bit) 1 (ash 1 (- fixnum-bit 3))))
 335       (list (- fixnum-min 1) (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -2) (- (ash 1 fixnum-bit) 3))
 336       (list (- fixnum-min 1) (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit -1) (- (ash 1 fixnum-bit) 2))
 337       (list (- fixnum-min 1) (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  0) (- (ash 1 fixnum-bit) 1))
 338       (list (- fixnum-min 1) (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  1) (- (ash 1 fixnum-bit) 1))))
 339
 340     (run-tests
 341      (lambda (a b c d)
 342        (string-append "fixnum-bit + 1 bits starting at " (number->string b)))
 343      (lambda (a b c d)
 344        (= (bit-extract a b c) d))
 345      (list
 346       (list (- fixnum-min 1) 0 (+ fixnum-bit  1) (- (ash 1 (+ fixnum-bit 1)) 1 (ash 1 (- fixnum-bit 1))))
 347       (list (- fixnum-min 1) 1 (+ fixnum-bit  2) (- (ash 1 (+ fixnum-bit 1)) 1 (ash 1 (- fixnum-bit 2))))
 348       (list (- fixnum-min 1) 2 (+ fixnum-bit  3) (- (ash 1 (+ fixnum-bit 1)) 1 (ash 1 (- fixnum-bit 3))))
 349       (list (- fixnum-min 1) (+ fixnum-bit -2) (+ fixnum-bit fixnum-bit -1) (- (ash 1 (+ fixnum-bit 1)) 3))
 350       (list (- fixnum-min 1) (+ fixnum-bit -1) (+ fixnum-bit fixnum-bit  0) (- (ash 1 (+ fixnum-bit 1)) 2))
 351       (list (- fixnum-min 1) (+ fixnum-bit  0) (+ fixnum-bit fixnum-bit  1) (- (ash 1 (+ fixnum-bit 1)) 1))
 352       (list (- fixnum-min 1) (+ fixnum-bit  1) (+ fixnum-bit fixnum-bit  2) (- (ash 1 (+ fixnum-bit 1)) 1))))))