2
;;;; Author: Paul Dietz
3
;;;; Created: Sun Jan 26 19:25:28 2003
4
;;;; Contains: Tests of BIT-ORC1
9
(let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
10
(s2 (make-array nil :initial-element 0 :element-type 'bit)))
11
(values (bit-orc1 s1 s2) s1 s2))
17
(let* ((s1 (make-array nil :initial-element 1 :element-type 'bit))
18
(s2 (make-array nil :initial-element 0 :element-type 'bit)))
19
(values (bit-orc1 s1 s2) s1 s2))
25
(let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
26
(s2 (make-array nil :initial-element 1 :element-type 'bit)))
27
(values (bit-orc1 s1 s2) s1 s2))
33
(let* ((s1 (make-array nil :initial-element 1 :element-type 'bit))
34
(s2 (make-array nil :initial-element 1 :element-type 'bit)))
35
(values (bit-orc1 s1 s2) s1 s2))
41
(let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
42
(s2 (make-array nil :initial-element 0 :element-type 'bit))
43
(s3 (make-array nil :initial-element 0 :element-type 'bit))
44
(result (bit-orc1 s1 s2 s3)))
45
(values s1 s2 s3 result (eqt s3 result)))
53
(let* ((s1 (make-array nil :initial-element 1 :element-type 'bit))
54
(s2 (make-array nil :initial-element 1 :element-type 'bit))
55
(s3 (make-array nil :initial-element 0 :element-type 'bit))
56
(result (bit-orc1 s1 s2 s3)))
57
(values s1 s2 s3 result (eqt s3 result)))
65
(let* ((s1 (make-array nil :initial-element 1 :element-type 'bit))
66
(s2 (make-array nil :initial-element 0 :element-type 'bit))
67
(result (bit-orc1 s1 s2 t)))
68
(values s1 s2 result (eqt s1 result)))
75
;;; Tests on bit vectors
78
(let ((a1 (copy-seq #*0011))
79
(a2 (copy-seq #*0101)))
80
(values (check-values (bit-orc1 a1 a2)) a1 a2))
84
(let* ((a1 (copy-seq #*0011))
85
(a2 (copy-seq #*0101))
86
(result (check-values (bit-orc1 a1 a2 t))))
87
(values result a1 a2 (eqt result a1)))
88
#*1101 #*1101 #*0101 t)
91
(let* ((a1 (copy-seq #*0011))
92
(a2 (copy-seq #*0101))
93
(a3 (copy-seq #*1110))
94
(result (check-values (bit-orc1 a1 a2 a3))))
95
(values result a1 a2 a3 (eqt result a3)))
96
#*1101 #*0011 #*0101 #*1101 t)
99
(let ((a1 (copy-seq #*0011))
100
(a2 (copy-seq #*0101)))
101
(values (check-values (bit-orc1 a1 a2 nil)) a1 a2))
102
#*1101 #*0011 #*0101)
104
;;; Tests on bit arrays
107
(let* ((a1 (make-array '(2 2) :element-type 'bit
108
:initial-contents '((0 1)(0 1))))
109
(a2 (make-array '(2 2) :element-type 'bit
110
:initial-contents '((0 0)(1 1))))
111
(result (bit-orc1 a1 a2)))
112
(values a1 a2 result))
118
(let* ((a1 (make-array '(2 2) :element-type 'bit
119
:initial-contents '((0 1)(0 1))))
120
(a2 (make-array '(2 2) :element-type 'bit
121
:initial-contents '((0 0)(1 1))))
122
(result (bit-orc1 a1 a2 t)))
123
(values a1 a2 result))
129
(let* ((a1 (make-array '(2 2) :element-type 'bit
130
:initial-contents '((0 1)(0 1))))
131
(a2 (make-array '(2 2) :element-type 'bit
132
:initial-contents '((0 0)(1 1))))
133
(result (bit-orc1 a1 a2 nil)))
134
(values a1 a2 result))
140
(let* ((a1 (make-array '(2 2) :element-type 'bit
141
:initial-contents '((0 1)(0 1))))
142
(a2 (make-array '(2 2) :element-type 'bit
143
:initial-contents '((0 0)(1 1))))
144
(a3 (make-array '(2 2) :element-type 'bit
145
:initial-contents '((0 0)(0 0))))
146
(result (bit-orc1 a1 a2 a3)))
147
(values a1 a2 a3 result))
153
;;; Adjustable arrays
156
(let* ((a1 (make-array '(2 2) :element-type 'bit
157
:initial-contents '((0 1)(0 1))
159
(a2 (make-array '(2 2) :element-type 'bit
160
:initial-contents '((0 0)(1 1))
162
(result (bit-orc1 a1 a2)))
163
(values a1 a2 result))
171
(let* ((a0 (make-array '(8) :element-type 'bit
172
:initial-contents '(0 1 0 1 0 0 1 1)))
173
(a1 (make-array '(2 2) :element-type 'bit
175
:displaced-index-offset 0))
176
(a2 (make-array '(2 2) :element-type 'bit
178
:displaced-index-offset 4))
179
(result (bit-orc1 a1 a2)))
180
(values a0 a1 a2 result))
187
(let* ((a0 (make-array '(8) :element-type 'bit
188
:initial-contents '(0 1 0 1 0 0 1 1)))
189
(a1 (make-array '(2 2) :element-type 'bit
191
:displaced-index-offset 0))
192
(a2 (make-array '(2 2) :element-type 'bit
194
:displaced-index-offset 4))
195
(result (bit-orc1 a1 a2 t)))
196
(values a0 a1 a2 result))
203
(let* ((a0 (make-array '(12) :element-type 'bit
204
:initial-contents '(0 1 0 1 0 0 1 1 1 1 1 0)))
205
(a1 (make-array '(2 2) :element-type 'bit
207
:displaced-index-offset 0))
208
(a2 (make-array '(2 2) :element-type 'bit
210
:displaced-index-offset 4))
211
(a3 (make-array '(2 2) :element-type 'bit
213
:displaced-index-offset 8))
214
(result (bit-orc1 a1 a2 a3)))
215
(values a0 a1 a2 result))
221
(deftest bit-orc1.order.1
222
(let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit))
223
(s2 (make-array 1 :initial-element 0 :element-type 'bit))
226
(bit-orc1 (progn (setf y (incf x)) s1)
227
(progn (setf z (incf x)) s2))
233
(deftest bit-orc1.error.1
234
(signals-error (bit-orc1) program-error)
237
(deftest bit-orc1.error.2
238
(signals-error (bit-orc1 #*000) program-error)
241
(deftest bit-orc1.error.3
242
(signals-error (bit-orc1 #*000 #*0100 nil nil)