source: trunk/source/tests/ansi-tests/bit-and.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 11 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 6.7 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Jan 26 18:18:47 2003
4;;;; Contains: Tests of BIT-AND
5
6(in-package :cl-test)
7
8(compile-and-load "bit-aux.lsp")
9
10(deftest bit-and.1
11  (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
12         (s2 (make-array nil :initial-element 0 :element-type 'bit)))
13    (values (bit-and s1 s2) s1 s2))
14  #0a0
15  #0a0
16  #0a0)
17
18(deftest bit-and.2
19  (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit))
20         (s2 (make-array nil :initial-element 0 :element-type 'bit)))
21    (values (bit-and s1 s2) s1 s2))
22  #0a0
23  #0a1
24  #0a0)
25
26(deftest bit-and.3
27  (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
28         (s2 (make-array nil :initial-element 1 :element-type 'bit)))
29    (values (bit-and s1 s2) s1 s2))
30  #0a0
31  #0a0
32  #0a1)
33
34(deftest bit-and.4
35  (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit))
36         (s2 (make-array nil :initial-element 1 :element-type 'bit)))
37    (values (bit-and s1 s2) s1 s2))
38  #0a1
39  #0a1
40  #0a1)
41
42(deftest bit-and.5
43  (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
44         (s2 (make-array nil :initial-element 0 :element-type 'bit))
45         (s3 (make-array nil :initial-element 1 :element-type 'bit))
46         (result (bit-and s1 s2 s3)))
47    (values s1 s2 s3 result (eqt s3 result)))
48  #0a0
49  #0a0
50  #0a0
51  #0a0
52  t)
53
54(deftest bit-and.6
55  (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit))
56         (s2 (make-array nil :initial-element 1 :element-type 'bit))
57         (s3 (make-array nil :initial-element 0 :element-type 'bit))
58         (result (bit-and s1 s2 s3)))
59    (values s1 s2 s3 result (eqt s3 result)))
60  #0a1
61  #0a1
62  #0a1
63  #0a1
64  t)
65
66(deftest bit-and.7
67  (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit))
68         (s2 (make-array nil :initial-element 0 :element-type 'bit))
69         (result (bit-and s1 s2 t)))
70    (values s1 s2 result (eqt s1 result)))
71  #0a0
72  #0a0
73  #0a0
74  t)
75
76
77;;; Tests on bit vectors
78
79(deftest bit-and.8
80  (let ((a1 (copy-seq #*0011))
81        (a2 (copy-seq #*0101)))
82    (values (check-values (bit-and a1 a2)) a1 a2))
83  #*0001 #*0011 #*0101)
84
85(deftest bit-and.9
86  (let* ((a1 (copy-seq #*0011))
87         (a2 (copy-seq #*0101))
88         (result (check-values (bit-and a1 a2 t))))
89    (values result a1 a2 (eqt result a1)))
90  #*0001 #*0001 #*0101 t)
91
92(deftest bit-and.10
93  (let* ((a1 (copy-seq #*0011))
94         (a2 (copy-seq #*0101))
95         (a3 (copy-seq #*1110))
96         (result (check-values (bit-and a1 a2 a3))))
97    (values result a1 a2 a3 (eqt result a3)))
98  #*0001 #*0011 #*0101 #*0001 t)
99
100(deftest bit-and.11
101  (let ((a1 (copy-seq #*0011))
102        (a2 (copy-seq #*0101)))
103    (values (check-values (bit-and a1 a2 nil)) a1 a2))
104  #*0001 #*0011 #*0101)
105
106;;; Tests on bit arrays
107
108(deftest bit-and.12
109  (let* ((a1 (make-array '(2 2) :element-type 'bit
110                         :initial-contents '((0 1)(0 1))))
111         (a2 (make-array '(2 2) :element-type 'bit
112                         :initial-contents '((0 0)(1 1))))
113         (result (bit-and a1 a2)))
114    (values a1 a2 result))
115  #2a((0 1)(0 1))
116  #2a((0 0)(1 1))
117  #2a((0 0)(0 1)))
118
119(deftest bit-and.13
120  (let* ((a1 (make-array '(2 2) :element-type 'bit
121                         :initial-contents '((0 1)(0 1))))
122         (a2 (make-array '(2 2) :element-type 'bit
123                         :initial-contents '((0 0)(1 1))))
124         (result (bit-and a1 a2 t)))
125    (values a1 a2 result))
126  #2a((0 0)(0 1))
127  #2a((0 0)(1 1))
128  #2a((0 0)(0 1)))
129
130(deftest bit-and.14
131  (let* ((a1 (make-array '(2 2) :element-type 'bit
132                         :initial-contents '((0 1)(0 1))))
133         (a2 (make-array '(2 2) :element-type 'bit
134                         :initial-contents '((0 0)(1 1))))
135         (result (bit-and a1 a2 nil)))
136    (values a1 a2 result))
137  #2a((0 1)(0 1))
138  #2a((0 0)(1 1))
139  #2a((0 0)(0 1)))
140
141(deftest bit-and.15
142  (let* ((a1 (make-array '(2 2) :element-type 'bit
143                         :initial-contents '((0 1)(0 1))))
144         (a2 (make-array '(2 2) :element-type 'bit
145                         :initial-contents '((0 0)(1 1))))
146         (a3 (make-array '(2 2) :element-type 'bit
147                         :initial-contents '((0 0)(0 0))))
148         (result (bit-and a1 a2 a3)))
149    (values a1 a2 a3 result))
150  #2a((0 1)(0 1))
151  #2a((0 0)(1 1))
152  #2a((0 0)(0 1))
153  #2a((0 0)(0 1)))
154
155;;; Adjustable arrays
156
157(deftest bit-and.16
158  (let* ((a1 (make-array '(2 2) :element-type 'bit
159                         :initial-contents '((0 1)(0 1))
160                         :adjustable t))
161         (a2 (make-array '(2 2) :element-type 'bit
162                         :initial-contents '((0 0)(1 1))
163                         :adjustable t))
164         (result (bit-and a1 a2)))
165    (values a1 a2 result))
166  #2a((0 1)(0 1))
167  #2a((0 0)(1 1))
168  #2a((0 0)(0 1)))
169
170;;; Displaced arrays
171
172(deftest bit-and.17
173  (let* ((a0 (make-array '(8) :element-type 'bit
174                         :initial-contents '(0 1 0 1 0 0 1 1)))
175         (a1 (make-array '(2 2) :element-type 'bit
176                         :displaced-to a0
177                         :displaced-index-offset 0))
178         (a2 (make-array '(2 2) :element-type 'bit
179                         :displaced-to a0
180                         :displaced-index-offset 4))
181         (result (bit-and a1 a2)))
182    (values a0 a1 a2 result))
183  #*01010011
184  #2a((0 1)(0 1))
185  #2a((0 0)(1 1))
186  #2a((0 0)(0 1)))
187
188(deftest bit-and.18
189  (let* ((a0 (make-array '(8) :element-type 'bit
190                         :initial-contents '(0 1 0 1 0 0 1 1)))
191         (a1 (make-array '(2 2) :element-type 'bit
192                         :displaced-to a0
193                         :displaced-index-offset 0))
194         (a2 (make-array '(2 2) :element-type 'bit
195                         :displaced-to a0
196                         :displaced-index-offset 4))
197         (result (bit-and a1 a2 t)))
198    (values a0 a1 a2 result))
199  #*00010011
200  #2a((0 0)(0 1))
201  #2a((0 0)(1 1))
202  #2a((0 0)(0 1)))
203
204(deftest bit-and.19
205  (let* ((a0 (make-array '(12) :element-type 'bit
206                         :initial-contents '(0 1 0 1 0 0 1 1 1 1 1 0)))
207         (a1 (make-array '(2 2) :element-type 'bit
208                         :displaced-to a0
209                         :displaced-index-offset 0))
210         (a2 (make-array '(2 2) :element-type 'bit
211                         :displaced-to a0
212                         :displaced-index-offset 4))
213         (a3 (make-array '(2 2) :element-type 'bit
214                         :displaced-to a0
215                         :displaced-index-offset 8))
216         (result (bit-and a1 a2 a3)))
217    (values a0 a1 a2 result))
218  #*010100110001
219  #2a((0 1)(0 1))
220  #2a((0 0)(1 1))
221  #2a((0 0)(0 1)))
222
223(deftest bit-and.20
224  (macrolet ((%m (z) z)) (bit-and (expand-in-current-env (%m #*0011)) #*0101))
225  #*0001)
226
227(deftest bit-and.21
228  (macrolet ((%m (z) z)) (bit-and #*1010 (expand-in-current-env (%m #*1100))))
229  #*1000)
230
231(deftest bit-and.22
232  (macrolet ((%m (z) z)) (bit-and #*10100011 #*01101010
233                                  (expand-in-current-env (%m nil))))
234  #*00100010)
235
236(deftest bit-and.order.1
237  (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit))
238         (s2 (make-array 1 :initial-element 0 :element-type 'bit))
239         (x 0) y z)
240    (values
241     (bit-and (progn (setf y (incf x)) s1)
242              (progn (setf z (incf x)) s2))
243     x y z))
244  #*0 2 1 2)
245
246(def-fold-test bit-and.fold.1 (bit-and #*01101 #*01011))
247
248;;; Randomized tests
249
250(deftest bit-and.random.1
251  (bit-random-test-fn #'bit-and #'logand)
252  nil)
253
254;;; Error tests
255
256(deftest bit-and.error.1
257  (signals-error (bit-and) program-error)
258  t)
259
260(deftest bit-and.error.2
261  (signals-error (bit-and #*000) program-error)
262  t)
263
264(deftest bit-and.error.3
265  (signals-error (bit-and #*000 #*0100 nil nil)
266                 program-error)
267  t)
268
Note: See TracBrowser for help on using the repository browser.