source: trunk/source/tests/ansi-tests/bit-ior.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 19:13:34 2003
4;;;; Contains: Tests of BIT-IOR
5
6(in-package :cl-test)
7
8(compile-and-load "bit-aux.lsp")
9
10(deftest bit-ior.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-ior s1 s2) s1 s2))
14  #0a0
15  #0a0
16  #0a0)
17
18(deftest bit-ior.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-ior s1 s2) s1 s2))
22  #0a1
23  #0a1
24  #0a0)
25
26(deftest bit-ior.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-ior s1 s2) s1 s2))
30  #0a1
31  #0a0
32  #0a1)
33
34(deftest bit-ior.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-ior s1 s2) s1 s2))
38  #0a1
39  #0a1
40  #0a1)
41
42(deftest bit-ior.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-ior 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-ior.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-ior 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-ior.7
67  (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
68         (s2 (make-array nil :initial-element 1 :element-type 'bit))
69         (result (bit-ior s1 s2 t)))
70    (values s1 s2 result (eqt s1 result)))
71  #0a1
72  #0a1
73  #0a1
74  t)
75
76
77;;; Tests on bit vectors
78
79(deftest bit-ior.8
80  (let ((a1 (copy-seq #*0011))
81        (a2 (copy-seq #*0101)))
82    (values (check-values (bit-ior a1 a2)) a1 a2))
83  #*0111 #*0011 #*0101)
84
85(deftest bit-ior.9
86  (let* ((a1 (copy-seq #*0011))
87         (a2 (copy-seq #*0101))
88         (result (check-values (bit-ior a1 a2 t))))
89    (values result a1 a2 (eqt result a1)))
90  #*0111 #*0111 #*0101 t)
91
92(deftest bit-ior.10
93  (let* ((a1 (copy-seq #*0011))
94         (a2 (copy-seq #*0101))
95         (a3 (copy-seq #*1110))
96         (result (check-values (bit-ior a1 a2 a3))))
97    (values result a1 a2 a3 (eqt result a3)))
98  #*0111 #*0011 #*0101 #*0111 t)
99
100(deftest bit-ior.11
101  (let ((a1 (copy-seq #*0011))
102        (a2 (copy-seq #*0101)))
103    (values (check-values (bit-ior a1 a2 nil)) a1 a2))
104  #*0111 #*0011 #*0101)
105
106;;; Tests on bit arrays
107
108(deftest bit-ior.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-ior a1 a2)))
114    (values a1 a2 result))
115  #2a((0 1)(0 1))
116  #2a((0 0)(1 1))
117  #2a((0 1)(1 1)))
118
119(deftest bit-ior.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-ior a1 a2 t)))
125    (values a1 a2 result))
126  #2a((0 1)(1 1))
127  #2a((0 0)(1 1))
128  #2a((0 1)(1 1)))
129
130(deftest bit-ior.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-ior a1 a2 nil)))
136    (values a1 a2 result))
137  #2a((0 1)(0 1))
138  #2a((0 0)(1 1))
139  #2a((0 1)(1 1)))
140
141(deftest bit-ior.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-ior a1 a2 a3)))
149    (values a1 a2 a3 result))
150  #2a((0 1)(0 1))
151  #2a((0 0)(1 1))
152  #2a((0 1)(1 1))
153  #2a((0 1)(1 1)))
154
155;;; Adjustable arrays
156
157(deftest bit-ior.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-ior a1 a2)))
165    (values a1 a2 result))
166  #2a((0 1)(0 1))
167  #2a((0 0)(1 1))
168  #2a((0 1)(1 1)))
169
170;;; Displaced arrays
171
172(deftest bit-ior.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-ior 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 1)(1 1)))
187
188(deftest bit-ior.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-ior a1 a2 t)))
198    (values a0 a1 a2 result))
199  #*01110011
200  #2a((0 1)(1 1))
201  #2a((0 0)(1 1))
202  #2a((0 1)(1 1)))
203
204(deftest bit-ior.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-ior a1 a2 a3)))
217    (values a0 a1 a2 result))
218  #*010100110111
219  #2a((0 1)(0 1))
220  #2a((0 0)(1 1))
221  #2a((0 1)(1 1)))
222
223(deftest bit-ior.20
224  (macrolet ((%m (z) z)) (bit-ior (expand-in-current-env (%m #*0011)) #*0101))
225  #*0111)
226
227(deftest bit-ior.21
228  (macrolet ((%m (z) z)) (bit-ior #*1010 (expand-in-current-env (%m #*1100))))
229  #*1110)
230
231(deftest bit-ior.22
232  (macrolet ((%m (z) z)) (bit-ior #*10100011 #*01101010
233                                  (expand-in-current-env (%m nil))))
234  #*11101011)
235
236(deftest bit-ior.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-ior (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-ior.fold.1 (bit-ior #*00101 #*10100))
247
248;;; Random tests
249
250(deftest bit-ior.random.1
251  (bit-random-test-fn #'bit-ior #'logior)
252  nil)
253
254;;; Error tests
255
256(deftest bit-ior.error.1
257  (signals-error (bit-ior) program-error)
258  t)
259
260(deftest bit-ior.error.2
261  (signals-error (bit-ior #*000) program-error)
262  t)
263
264(deftest bit-ior.error.3
265  (signals-error (bit-ior #*000 #*0100 nil nil)
266                 program-error)
267  t)
Note: See TracBrowser for help on using the repository browser.