bit-orc2.lsp 7.82 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Jan 26 19:31:35 2003
;;;; Contains: Tests of BIT-ORC2

6

7

8

9

10 11
(deftest bit-orc2.1
  (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
sds's avatar
sds committed
12
         (s2 (make-array nil :initial-element 0 :element-type 'bit)))
13 14 15 16 17 18 19
    (values (bit-orc2 s1 s2) s1 s2))
  #0a1
  #0a0
  #0a0)

(deftest bit-orc2.2
  (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit))
sds's avatar
sds committed
20
         (s2 (make-array nil :initial-element 0 :element-type 'bit)))
21 22 23 24 25 26 27
    (values (bit-orc2 s1 s2) s1 s2))
  #0a1
  #0a1
  #0a0)

(deftest bit-orc2.3
  (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
sds's avatar
sds committed
28
         (s2 (make-array nil :initial-element 1 :element-type 'bit)))
29
    (values (bit-orc2 s1 s2) s1 s2))
30 31 32 33 34 35
  #0a0
  #0a0
  #0a1)

(deftest bit-orc2.4
  (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit))
sds's avatar
sds committed
36
         (s2 (make-array nil :initial-element 1 :element-type 'bit)))
37 38 39 40 41 42 43
    (values (bit-orc2 s1 s2) s1 s2))
  #0a1
  #0a1
  #0a1)

(deftest bit-orc2.5
  (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
sds's avatar
sds committed
44 45 46
         (s2 (make-array nil :initial-element 0 :element-type 'bit))
         (s3 (make-array nil :initial-element 0 :element-type 'bit))
         (result (bit-orc2 s1 s2 s3)))
47 48 49 50 51 52 53 54 55
    (values s1 s2 s3 result (eqt s3 result)))
  #0a0
  #0a0
  #0a1
  #0a1
  t)

(deftest bit-orc2.6
  (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit))
sds's avatar
sds committed
56 57 58
         (s2 (make-array nil :initial-element 1 :element-type 'bit))
         (s3 (make-array nil :initial-element 0 :element-type 'bit))
         (result (bit-orc2 s1 s2 s3)))
59 60 61 62 63 64 65 66 67
    (values s1 s2 s3 result (eqt s3 result)))
  #0a1
  #0a1
  #0a1
  #0a1
  t)

(deftest bit-orc2.7
  (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit))
sds's avatar
sds committed
68 69
         (s2 (make-array nil :initial-element 0 :element-type 'bit))
         (result (bit-orc2 s1 s2 t)))
70 71 72 73 74 75 76 77 78 79 80
    (values s1 s2 result (eqt s1 result)))
  #0a1
  #0a0
  #0a1
  t)


;;; Tests on bit vectors

(deftest bit-orc2.8
  (let ((a1 (copy-seq #*0011))
sds's avatar
sds committed
81
        (a2 (copy-seq #*0101)))
82 83 84 85 86
    (values (check-values (bit-orc2 a1 a2)) a1 a2))
  #*1011 #*0011 #*0101)

(deftest bit-orc2.9
  (let* ((a1 (copy-seq #*0011))
sds's avatar
sds committed
87 88
         (a2 (copy-seq #*0101))
         (result (check-values (bit-orc2 a1 a2 t))))
89 90 91 92 93
    (values result a1 a2 (eqt result a1)))
  #*1011 #*1011 #*0101 t)

(deftest bit-orc2.10
  (let* ((a1 (copy-seq #*0011))
sds's avatar
sds committed
94 95 96
         (a2 (copy-seq #*0101))
         (a3 (copy-seq #*1110))
         (result (check-values (bit-orc2 a1 a2 a3))))
97 98 99 100 101
    (values result a1 a2 a3 (eqt result a3)))
  #*1011 #*0011 #*0101 #*1011 t)

(deftest bit-orc2.11
  (let ((a1 (copy-seq #*0011))
sds's avatar
sds committed
102
        (a2 (copy-seq #*0101)))
103 104 105 106 107 108 109
    (values (check-values (bit-orc2 a1 a2 nil)) a1 a2))
  #*1011 #*0011 #*0101)

;;; Tests on bit arrays

(deftest bit-orc2.12
  (let* ((a1 (make-array '(2 2) :element-type 'bit
sds's avatar
sds committed
110 111 112 113
                         :initial-contents '((0 1)(0 1))))
         (a2 (make-array '(2 2) :element-type 'bit
                         :initial-contents '((0 0)(1 1))))
         (result (bit-orc2 a1 a2)))
114 115 116 117 118 119 120
    (values a1 a2 result))
  #2a((0 1)(0 1))
  #2a((0 0)(1 1))
  #2a((1 1)(0 1)))

(deftest bit-orc2.13
  (let* ((a1 (make-array '(2 2) :element-type 'bit
sds's avatar
sds committed
121 122 123 124
                         :initial-contents '((0 1)(0 1))))
         (a2 (make-array '(2 2) :element-type 'bit
                         :initial-contents '((0 0)(1 1))))
         (result (bit-orc2 a1 a2 t)))
125 126 127 128 129 130 131
    (values a1 a2 result))
  #2a((1 1)(0 1))
  #2a((0 0)(1 1))
  #2a((1 1)(0 1)))

(deftest bit-orc2.14
  (let* ((a1 (make-array '(2 2) :element-type 'bit
sds's avatar
sds committed
132 133 134 135
                         :initial-contents '((0 1)(0 1))))
         (a2 (make-array '(2 2) :element-type 'bit
                         :initial-contents '((0 0)(1 1))))
         (result (bit-orc2 a1 a2 nil)))
136 137 138 139 140 141 142
    (values a1 a2 result))
  #2a((0 1)(0 1))
  #2a((0 0)(1 1))
  #2a((1 1)(0 1)))

(deftest bit-orc2.15
  (let* ((a1 (make-array '(2 2) :element-type 'bit
sds's avatar
sds committed
143 144 145 146 147 148
                         :initial-contents '((0 1)(0 1))))
         (a2 (make-array '(2 2) :element-type 'bit
                         :initial-contents '((0 0)(1 1))))
         (a3 (make-array '(2 2) :element-type 'bit
                         :initial-contents '((0 0)(0 0))))
         (result (bit-orc2 a1 a2 a3)))
149 150 151 152 153 154 155 156 157 158
    (values a1 a2 a3 result))
  #2a((0 1)(0 1))
  #2a((0 0)(1 1))
  #2a((1 1)(0 1))
  #2a((1 1)(0 1)))

;;; Adjustable arrays

(deftest bit-orc2.16
  (let* ((a1 (make-array '(2 2) :element-type 'bit
sds's avatar
sds committed
159 160 161 162 163 164
                         :initial-contents '((0 1)(0 1))
                         :adjustable t))
         (a2 (make-array '(2 2) :element-type 'bit
                         :initial-contents '((0 0)(1 1))
                         :adjustable t))
         (result (bit-orc2 a1 a2)))
165 166 167 168 169 170 171 172 173
    (values a1 a2 result))
  #2a((0 1)(0 1))
  #2a((0 0)(1 1))
  #2a((1 1)(0 1)))

;;; Displaced arrays

(deftest bit-orc2.17
  (let* ((a0 (make-array '(8) :element-type 'bit
sds's avatar
sds committed
174 175 176 177 178 179 180 181
                         :initial-contents '(0 1 0 1 0 0 1 1)))
         (a1 (make-array '(2 2) :element-type 'bit
                         :displaced-to a0
                         :displaced-index-offset 0))
         (a2 (make-array '(2 2) :element-type 'bit
                         :displaced-to a0
                         :displaced-index-offset 4))
         (result (bit-orc2 a1 a2)))
182 183 184 185 186 187 188 189
    (values a0 a1 a2 result))
  #*01010011
  #2a((0 1)(0 1))
  #2a((0 0)(1 1))
  #2a((1 1)(0 1)))

(deftest bit-orc2.18
  (let* ((a0 (make-array '(8) :element-type 'bit
sds's avatar
sds committed
190 191 192 193 194 195 196 197
                         :initial-contents '(0 1 0 1 0 0 1 1)))
         (a1 (make-array '(2 2) :element-type 'bit
                         :displaced-to a0
                         :displaced-index-offset 0))
         (a2 (make-array '(2 2) :element-type 'bit
                         :displaced-to a0
                         :displaced-index-offset 4))
         (result (bit-orc2 a1 a2 t)))
198 199 200 201 202 203 204 205
    (values a0 a1 a2 result))
  #*11010011
  #2a((1 1)(0 1))
  #2a((0 0)(1 1))
  #2a((1 1)(0 1)))

(deftest bit-orc2.19
  (let* ((a0 (make-array '(12) :element-type 'bit
sds's avatar
sds committed
206 207 208 209 210 211 212 213 214 215 216
                         :initial-contents '(0 1 0 1 0 0 1 1 1 1 1 0)))
         (a1 (make-array '(2 2) :element-type 'bit
                         :displaced-to a0
                         :displaced-index-offset 0))
         (a2 (make-array '(2 2) :element-type 'bit
                         :displaced-to a0
                         :displaced-index-offset 4))
         (a3 (make-array '(2 2) :element-type 'bit
                         :displaced-to a0
                         :displaced-index-offset 8))
         (result (bit-orc2 a1 a2 a3)))
217 218 219 220 221 222
    (values a0 a1 a2 result))
  #*010100111101
  #2a((0 1)(0 1))
  #2a((0 0)(1 1))
  #2a((1 1)(0 1)))

223 224 225 226 227 228 229 230 231 232
(deftest bit-orc2.20
  (macrolet ((%m (z) z)) (bit-orc2 (expand-in-current-env (%m #*0011)) #*0101))
  #*1011)

(deftest bit-orc2.21
  (macrolet ((%m (z) z)) (bit-orc2 #*1010 (expand-in-current-env (%m #*1100))))
  #*1011)

(deftest bit-orc2.22
  (macrolet ((%m (z) z)) (bit-orc2 #*10100011 #*01101010
sds's avatar
sds committed
233
                                   (expand-in-current-env (%m nil))))
234 235
  #*10110111)

236
(deftest bit-orc2.order.1
237
  (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit))
sds's avatar
sds committed
238 239
         (s2 (make-array 1 :initial-element 0 :element-type 'bit))
         (x 0) y z)
240 241
    (values
     (bit-orc2 (progn (setf y (incf x)) s1)
sds's avatar
sds committed
242
               (progn (setf z (incf x)) s2))
243 244 245
     x y z))
  #*1 2 1 2)

246 247
(deftest bit-orc2.fold.1
  (flet ((%f () (declare (optimize speed (safety 0) (space 0)))
sds's avatar
sds committed
248
             (bit-orc2 #*00101 #*01011)))
249 250 251
    (values (%f) (let ((bv (%f))) (setf (elt bv 0) 0) bv) (%f)))
  #*10101 #*00101 #*10101)

252 253 254 255 256 257
;;; Random tests

(deftest bit-orc2.random.1
  (bit-random-test-fn #'bit-orc2 #'logorc2)
  nil)

258 259 260
;;; Error tests

(deftest bit-orc2.error.1
261 262
  (signals-error (bit-orc2) program-error)
  t)
263 264

(deftest bit-orc2.error.2
265 266
  (signals-error (bit-orc2 #*000) program-error)
  t)
267 268

(deftest bit-orc2.error.3
269
  (signals-error (bit-orc2 #*000 #*0100 nil nil)
sds's avatar
sds committed
270
                 program-error)
271
  t)
272 273