bit-not.lsp 3.79 KB
Newer Older
1 2 3 4 5
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sun Jan 26 19:40:13 2003
;;;; Contains: Tests of BIT-NOT

6

7 8 9 10 11

(deftest bit-not.1
  (let ((a1 (make-array nil :element-type 'bit :initial-element 0)))
    (values (bit-not a1) a1))
  #0a1 #0a0)
sds's avatar
sds committed
12

13 14 15 16 17 18 19 20 21
(deftest bit-not.2
  (let ((a1 (make-array nil :element-type 'bit :initial-element 1)))
    (values (bit-not a1) a1))
  #0a0 #0a1)

(deftest bit-not.3
  (let ((a1 (make-array nil :element-type 'bit :initial-element 0)))
    (values (bit-not a1 t) a1))
  #0a1 #0a1)
sds's avatar
sds committed
22

23 24 25 26 27 28 29
(deftest bit-not.4
  (let ((a1 (make-array nil :element-type 'bit :initial-element 1)))
    (values (bit-not a1 t) a1))
  #0a0 #0a0)

(deftest bit-not.5
  (let* ((a1 (make-array nil :element-type 'bit :initial-element 1))
sds's avatar
sds committed
30 31
         (a2 (make-array nil :element-type 'bit :initial-element 1))
         (result (bit-not a1 a2)))
32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55
    (values a1 a2 (eqt a2 result)))
  #0a1 #0a0 t)

(deftest bit-not.6
  (let ((a1 (make-array nil :element-type 'bit :initial-element 0)))
    (values (bit-not a1 nil) a1))
  #0a1 #0a0)

;;; Tests on bit vectors

(deftest bit-not.7
  (let ((a1 (copy-seq #*0011010110)))
    (values (bit-not a1) a1))
  #*1100101001
  #*0011010110)

(deftest bit-not.8
  (let ((a1 (copy-seq #*0011010110)))
    (values (bit-not a1 t) a1))
  #*1100101001
  #*1100101001)

(deftest bit-not.9
  (let ((a1 (copy-seq #*0011010110))
sds's avatar
sds committed
56
        (a2 (copy-seq #*0000000000)))
57 58 59 60 61 62 63 64 65
    (values (bit-not a1 a2) a1 a2))
  #*1100101001
  #*0011010110
  #*1100101001)

;;; Arrays

(deftest bit-not.10
  (let ((a1 (make-array '(2 2) :element-type 'bit
sds's avatar
sds committed
66
                        :initial-contents '((0 1)(1 0)))))
67 68 69 70 71 72
    (values (bit-not a1) a1))
  #2a((1 0)(0 1))
  #2a((0 1)(1 0)))

(deftest bit-not.11
  (let ((a1 (make-array '(2 2) :element-type 'bit
sds's avatar
sds committed
73
                        :initial-contents '((0 1)(1 0)))))
74 75 76 77 78 79
    (values (bit-not a1 nil) a1))
  #2a((1 0)(0 1))
  #2a((0 1)(1 0)))

(deftest bit-not.12
  (let ((a1 (make-array '(2 2) :element-type 'bit
sds's avatar
sds committed
80
                        :initial-contents '((0 1)(1 0)))))
81 82 83 84 85 86
    (values (bit-not a1 t) a1))
  #2a((1 0)(0 1))
  #2a((1 0)(0 1)))

(deftest bit-not.13
  (let ((a1 (make-array '(2 2) :element-type 'bit
sds's avatar
sds committed
87 88 89
                        :initial-contents '((0 1)(1 0))))
        (a2 (make-array '(2 2) :element-type 'bit
                        :initial-element 0)))
90 91 92 93 94 95 96 97 98
    (values (bit-not a1 a2) a1 a2))
  #2a((1 0)(0 1))
  #2a((0 1)(1 0))
  #2a((1 0)(0 1)))

;;; Adjustable array

(deftest bit-not.14
  (let ((a1 (make-array '(2 2) :element-type 'bit
sds's avatar
sds committed
99 100
                        :adjustable t
                        :initial-contents '((0 1)(1 0)))))
101 102 103 104 105 106 107 108
    (values (bit-not a1) a1))
  #2a((1 0)(0 1))
  #2a((0 1)(1 0)))

;;; Displaced arrays

(deftest bit-not.15
  (let* ((a0 (make-array '(12) :element-type 'bit
sds's avatar
sds committed
109 110 111 112 113 114 115
                         :initial-contents '(0 0 0 1 1 0 0 0 0 0 0 0)))
         (a1 (make-array '(2 2) :element-type 'bit
                         :displaced-to a0
                         :displaced-index-offset 2))
         (a2 (make-array '(2 2) :element-type 'bit
                         :displaced-to a0
                         :displaced-index-offset 6)))
116 117 118 119 120 121
    (values (bit-not a1 a2) a0 a1 a2))
  #2a((1 0)(0 1))
  #*000110100100
  #2a((0 1)(1 0))
  #2a((1 0)(0 1)))

122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137
;;; Macro env tests

(deftest bit-not.16
  (macrolet
   ((%m (z) z))
   (bit-not (expand-in-current-env (%m #*10010011))))
  #*01101100)

(deftest bit-not.17
  (macrolet
   ((%m (z) z))
   (bit-not #*1101011010 (expand-in-current-env (%m nil))))
  #*0010100101)

;;;

138 139
(deftest bit-not.order.1
  (let ((a (copy-seq #*001101))
sds's avatar
sds committed
140
        (i 0) x)
141 142 143 144 145
    (values
     (bit-not (progn (setf x (incf i)) a))
     i x))
  #*110010 1 1)

146
(def-fold-test bit-not.fold.1 (bit-not #*00101))
147

148 149 150
;;; Error tests

(deftest bit-not.error.1
151 152
  (signals-error (bit-not) program-error)
  t)
153 154

(deftest bit-not.error.2
155 156
  (signals-error (bit-not #*000 nil nil) program-error)
  t)