bit-eqv.lsp 7.65 KB
Newer Older
1 2 3 4 5 6 7 8
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Jan 26 19:07:23 2003
;;;; Contains: Tests of BIT-EQV


(in-package :cl-test)

9 10
(compile-and-load "bit-aux.lsp")

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

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

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

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

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

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

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


;;; Tests on bit vectors

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

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

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

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

;;; Tests on bit arrays

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

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

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

(deftest bit-eqv.15
  (let* ((a1 (make-array '(2 2) :element-type 'bit
sds's avatar
sds committed
144 145 146 147 148 149
                         :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-eqv a1 a2 a3)))
150 151 152 153 154 155 156 157 158 159
    (values a1 a2 a3 result))
  #2a((0 1)(0 1))
  #2a((0 0)(1 1))
  #2a((1 0)(0 1))
  #2a((1 0)(0 1)))

;;; Adjustable arrays

(deftest bit-eqv.16
  (let* ((a1 (make-array '(2 2) :element-type 'bit
sds's avatar
sds committed
160 161 162 163 164 165
                         :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-eqv a1 a2)))
166 167 168 169 170 171 172 173 174
    (values a1 a2 result))
  #2a((0 1)(0 1))
  #2a((0 0)(1 1))
  #2a((1 0)(0 1)))

;;; Displaced arrays

(deftest bit-eqv.17
  (let* ((a0 (make-array '(8) :element-type 'bit
sds's avatar
sds committed
175 176 177 178 179 180 181 182
                         :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-eqv a1 a2)))
183 184 185 186 187 188 189 190
    (values a0 a1 a2 result))
  #*01010011
  #2a((0 1)(0 1))
  #2a((0 0)(1 1))
  #2a((1 0)(0 1)))

(deftest bit-eqv.18
  (let* ((a0 (make-array '(8) :element-type 'bit
sds's avatar
sds committed
191 192 193 194 195 196 197 198
                         :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-eqv a1 a2 t)))
199 200 201 202 203 204 205 206
    (values a0 a1 a2 result))
  #*10010011
  #2a((1 0)(0 1))
  #2a((0 0)(1 1))
  #2a((1 0)(0 1)))

(deftest bit-eqv.19
  (let* ((a0 (make-array '(12) :element-type 'bit
sds's avatar
sds committed
207 208 209 210 211 212 213 214 215 216 217
                         :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-eqv a1 a2 a3)))
218 219 220 221 222 223
    (values a0 a1 a2 result))
  #*010100111001
  #2a((0 1)(0 1))
  #2a((0 0)(1 1))
  #2a((1 0)(0 1)))

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

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

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

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

247
(def-fold-test bit-eqv.fold.1 (bit-eqv #*01101 #*10100))
248

249 250 251 252 253 254
;;; Random tests

(deftest bit-eqv.random.1
  (bit-random-test-fn #'bit-eqv #'logeqv)
  nil)

255 256 257
;;; Error tests

(deftest bit-eqv.error.1
258 259
  (signals-error (bit-eqv) program-error)
  t)
260 261

(deftest bit-eqv.error.2
262 263
  (signals-error (bit-eqv #*000) program-error)
  t)
264 265

(deftest bit-eqv.error.3
266
  (signals-error (bit-eqv #*000 #*0100 nil nil)
sds's avatar
sds committed
267
                 program-error)
268
  t)