1;;; arithmetic-bitwise.test --- Test suite for R6RS (rnrs arithmetic bitwise) 2 3;; Copyright (C) 2010, 2013 Free Software Foundation, Inc. 4;; 5;; This library is free software; you can redistribute it and/or 6;; modify it under the terms of the GNU Lesser General Public 7;; License as published by the Free Software Foundation; either 8;; version 3 of the License, or (at your option) any later version. 9;; 10;; This library is distributed in the hope that it will be useful, 11;; but WITHOUT ANY WARRANTY; without even the implied warranty of 12;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU 13;; Lesser General Public License for more details. 14;; 15;; You should have received a copy of the GNU Lesser General Public 16;; License along with this library; if not, write to the Free Software 17;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA 18 19 20(define-module (test-suite test-r6rs-arithmetic-bitwise) 21 :use-module ((rnrs arithmetic bitwise) :version (6)) 22 :use-module (test-suite lib)) 23 24(with-test-prefix "bitwise-not" 25 (pass-if "bitwise-not simple" 26 (eqv? (bitwise-not 3) -4))) 27 28(with-test-prefix "bitwise-and" 29 (pass-if "bitwise-and simple" 30 (eqv? (bitwise-and #b101 #b110) #b100))) 31 32(with-test-prefix "bitwise-ior" 33 (pass-if "bitwise-ior simple" 34 (eqv? (bitwise-ior #b010 #b100) #b110))) 35 36(with-test-prefix "bitwise-xor" 37 (pass-if "bitwise-xor simple" 38 (eqv? (bitwise-xor #b101 #b100) #b001))) 39 40(with-test-prefix "bitwise-if" 41 (pass-if "bitwise-if simple" 42 (eqv? (bitwise-if #b101 #b011 #b100) #b001))) 43 44(with-test-prefix "bitwise-bit-count" 45 (pass-if "bitwise-bit-count simple" 46 (eqv? (bitwise-bit-count #b101) 2)) 47 (pass-if "bitwise-bit-count negative" 48 (eqv? (bitwise-bit-count #b-101) -2))) 49 50(with-test-prefix "bitwise-length" 51 (pass-if "bitwise-length simple" 52 (eqv? (bitwise-length #b101) 3)) 53 (pass-if "bitwise-length leading zeros" 54 (eqv? (bitwise-length #b001) 1))) 55 56(with-test-prefix "bitwise-first-bit-set" 57 (pass-if "bitwise-first-bit-set simple" 58 (and (eqv? (bitwise-first-bit-set 1) 0) 59 (eqv? (bitwise-first-bit-set -4) 2))) 60 (pass-if "bitwise-first-bit-set zero" 61 (and (eqv? (bitwise-first-bit-set 0) -1)))) 62 63(with-test-prefix "bitwise-copy-bit" 64 (pass-if "bitwise-copy-bit simple" 65 (eqv? (bitwise-copy-bit #b010 2 1) #b110))) 66 67(with-test-prefix "bitwise-bit-field" 68 (pass-if "bitwise-bit-field simple" 69 (eqv? (bitwise-bit-field #b110010 1 4) #b001))) 70 71(with-test-prefix "bitwise-copy-bit-field" 72 (pass-if "bitwise-copy-bit-field simple" 73 (eqv? (bitwise-copy-bit-field #b11111111 2 6 #b1010) #b11101011))) 74 75(with-test-prefix "bitwise-arithmetic-shift" 76 (pass-if "bitwise-arithmetic-shift simple" 77 (and (eqv? (bitwise-arithmetic-shift -6 -1) -3) 78 (eqv? (bitwise-arithmetic-shift -5 -1) -3) 79 (eqv? (bitwise-arithmetic-shift -4 -1) -2) 80 (eqv? (bitwise-arithmetic-shift -3 -1) -2) 81 (eqv? (bitwise-arithmetic-shift -2 -1) -1) 82 (eqv? (bitwise-arithmetic-shift -1 -1) -1)))) 83 84(with-test-prefix "bitwise-arithmetic-shift-left" 85 (pass-if "bitwise-arithmetic-shift-left simple" 86 (eqv? (bitwise-arithmetic-shift-left -6 -1) -3))) 87 88(with-test-prefix "bitwise-arithmetic-shift-right" 89 (pass-if "bitwise-arithmetic-shift-right simple" 90 (eqv? (bitwise-arithmetic-shift-right -6 1) -3))) 91 92(with-test-prefix "bitwise-rotate-bit-field" 93 (pass-if "bitwise-rotate-bit-field simple" 94 (eqv? (bitwise-rotate-bit-field #b11100011 2 6 2) #b11001011))) 95 96(with-test-prefix "bitwise-reverse-bit-field" 97 (pass-if "bitwise-reverse-bit-field simple" 98 (eqv? (bitwise-reverse-bit-field #b1010010 1 4) #b1011000))) 99 100