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