1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
|
;;;; bitvectors.test --- tests guile's bitvectors -*- scheme -*-
;;;;
;;;; Copyright 2010, 2011, 2013, 2014, 2020 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
;;;; License as published by the Free Software Foundation; either
;;;; version 3 of the License, or (at your option) any later version.
;;;;
;;;; This library is distributed in the hope that it will be useful,
;;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
;;;; Lesser General Public License for more details.
;;;;
;;;; You should have received a copy of the GNU Lesser General Public
;;;; License along with this library; if not, write to the Free Software
;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
(define-module (test-suite test-bitvectors)
#:use-module (test-suite lib)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26))
(with-test-prefix "predicates"
(pass-if (bitvector? #*1010101010))
(pass-if (array? #*1010101010))
(pass-if (eq? (array-type #*1010101010) 'b)))
(with-test-prefix "equality"
(pass-if (equal? #*1010101 #*1010101))
(pass-if (array-equal? #*1010101 #*1010101))
(pass-if (not (equal? #*10101010 #*1010101)))
(pass-if (not (array-equal? #*10101010 #*1010101))))
(with-test-prefix "lists"
(pass-if (equal? (bitvector->list #*10010) '(#t #f #f #t #f)))
(pass-if (equal? (array->list #*10010) '(#t #f #f #t #f)))
(pass-if (equal? #*10010 (list->bitvector '(#t #f #f #t #f)))))
(with-test-prefix "ref and set"
(with-test-prefix "as bitvector"
(let ((bv (list->bitvector '(#f #f #t #f #t))))
(pass-if (eqv? (bitvector-bit-set? bv 0) #f))
(pass-if (eqv? (bitvector-bit-set? bv 2) #t))
(bitvector-set-bit! bv 0)
(pass-if (eqv? (bitvector-bit-set? bv 0) #t))
(pass-if (eqv? (bitvector-bit-clear? bv 0) #f))
(bitvector-clear-bit! bv 0)
(pass-if (eqv? (bitvector-bit-set? bv 0) #f))
(pass-if (eqv? (bitvector-bit-clear? bv 0) #t))))
(with-test-prefix "as array"
(let ((bv (list->bitvector '(#f #f #t #f #t))))
(pass-if (eqv? (array-ref bv 0) #f))
(pass-if (eqv? (array-ref bv 2) #t))
(array-set! bv #t 0)
(pass-if (eqv? (array-ref bv 0) #t)))))
(with-test-prefix "all bits"
(let ((bv (make-bitvector 5)))
(pass-if-equal #*00000 bv)
(bitvector-set-all-bits! bv)
(pass-if-equal #*11111 bv)
(bitvector-clear-all-bits! bv)
(pass-if-equal #*00000 bv)
(bitvector-flip-all-bits! bv)
(pass-if-equal #*11111 bv)
(bitvector-flip-all-bits! bv)
(pass-if-equal #*00000 bv)))
(with-test-prefix "bitvector-set-bits!"
(pass-if "#t"
(let ((v (bitvector #t #t #f #f)))
(bitvector-set-bits! v #*1010)
(equal? v #*1110)))
(pass-if "#t, shorter"
(let ((v (bitvector #t #t #f #f)))
(bitvector-set-bits! v #*101)
(equal? v #*1110))))
(with-test-prefix "bitvector-clear-bits!"
(pass-if "#f"
(let ((v (bitvector #t #t #f #f)))
(bitvector-clear-bits! v #*1010)
(equal? v #*0100)))
(pass-if "#f, shorter"
(let ((v (bitvector #t #t #f #f)))
(bitvector-clear-bits! v #*101)
(equal? v #*0100))))
(with-test-prefix "bitvector-count"
(pass-if-equal 6 (bitvector-count #*01110111))
(pass-if-equal 2 (let ((bv #*01110111))
(- (bitvector-length bv) (bitvector-count bv)))))
(with-test-prefix "bitvector-position"
(pass-if-equal 0 (bitvector-position #*01110111 #f))
(pass-if-equal 1 (bitvector-position #*01110111 #t))
(pass-if-equal 4 (bitvector-position #*01110111 #f 1))
(pass-if-equal 4 (bitvector-position #*01110111 #f 4))
(pass-if-equal 5 (bitvector-position #*01110111 #t 5))
(pass-if-equal #f (bitvector-position #*01110111 #f 5)))
(with-test-prefix "bitvector-count-bits"
(pass-if-equal 3 (bitvector-count-bits #*01110111 #*11001101)))
(with-test-prefix "bitector-copy"
(define bv #*100110001011001100011001010010101100000110010000100111101110101111000011101001101100110100100010011101110001001000101010010101111000100001010000101001110100001101001110001101001000010111101111100111011100111010011101100011010111111101110100011100011100)
(define* (test bv #:optional start end)
(equal? (drop (take (bitvector->list bv) (or end (bitvector-length bv))) (or start 0))
(bitvector->list (cond (end (bitvector-copy bv start end))
(start (bitvector-copy bv start))
(else (bitvector-copy bv))))))
(pass-if "def args 0" (test bv))
(pass-if "def args 1" (test bv 0))
(pass-if "def args 2" (test bv 0 (bitvector-length bv)))
(pass-if "start" (every (cut test bv <>) '(1 4 15 16 31 32 33 64 65 130 250 252)))
(pass-if "end-3" (every (cut test bv 3 <>) '(4 15 16 31 32 33 64 65 130 250 252)))
(pass-if "end-16" (every (cut test bv 16 <>) '(16 31 32 33 64 65 130 250 252)))
(pass-if "empty def args 1" (test bv 252))
(pass-if "empty def args 2" (test bv 252 252)))
|
