source: trunk/source/tests/ansi-tests/bit-not.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: 3.5 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sun Jan 26 19:40:13 2003
4;;;; Contains: Tests of BIT-NOT
5
6(in-package :cl-test)
7
8(deftest bit-not.1
9  (let ((a1 (make-array nil :element-type 'bit :initial-element 0)))
10    (values (bit-not a1) a1))
11  #0a1 #0a0)
12     
13(deftest bit-not.2
14  (let ((a1 (make-array nil :element-type 'bit :initial-element 1)))
15    (values (bit-not a1) a1))
16  #0a0 #0a1)
17
18(deftest bit-not.3
19  (let ((a1 (make-array nil :element-type 'bit :initial-element 0)))
20    (values (bit-not a1 t) a1))
21  #0a1 #0a1)
22     
23(deftest bit-not.4
24  (let ((a1 (make-array nil :element-type 'bit :initial-element 1)))
25    (values (bit-not a1 t) a1))
26  #0a0 #0a0)
27
28(deftest bit-not.5
29  (let* ((a1 (make-array nil :element-type 'bit :initial-element 1))
30         (a2 (make-array nil :element-type 'bit :initial-element 1))
31         (result (bit-not a1 a2)))
32    (values a1 a2 (eqt a2 result)))
33  #0a1 #0a0 t)
34
35(deftest bit-not.6
36  (let ((a1 (make-array nil :element-type 'bit :initial-element 0)))
37    (values (bit-not a1 nil) a1))
38  #0a1 #0a0)
39
40;;; Tests on bit vectors
41
42(deftest bit-not.7
43  (let ((a1 (copy-seq #*0011010110)))
44    (values (bit-not a1) a1))
45  #*1100101001
46  #*0011010110)
47
48(deftest bit-not.8
49  (let ((a1 (copy-seq #*0011010110)))
50    (values (bit-not a1 t) a1))
51  #*1100101001
52  #*1100101001)
53
54(deftest bit-not.9
55  (let ((a1 (copy-seq #*0011010110))
56        (a2 (copy-seq #*0000000000)))
57    (values (bit-not a1 a2) a1 a2))
58  #*1100101001
59  #*0011010110
60  #*1100101001)
61
62;;; Arrays
63
64(deftest bit-not.10
65  (let ((a1 (make-array '(2 2) :element-type 'bit
66                        :initial-contents '((0 1)(1 0)))))
67    (values (bit-not a1) a1))
68  #2a((1 0)(0 1))
69  #2a((0 1)(1 0)))
70
71(deftest bit-not.11
72  (let ((a1 (make-array '(2 2) :element-type 'bit
73                        :initial-contents '((0 1)(1 0)))))
74    (values (bit-not a1 nil) a1))
75  #2a((1 0)(0 1))
76  #2a((0 1)(1 0)))
77
78(deftest bit-not.12
79  (let ((a1 (make-array '(2 2) :element-type 'bit
80                        :initial-contents '((0 1)(1 0)))))
81    (values (bit-not a1 t) a1))
82  #2a((1 0)(0 1))
83  #2a((1 0)(0 1)))
84
85(deftest bit-not.13
86  (let ((a1 (make-array '(2 2) :element-type 'bit
87                        :initial-contents '((0 1)(1 0))))
88        (a2 (make-array '(2 2) :element-type 'bit
89                        :initial-element 0)))
90    (values (bit-not a1 a2) a1 a2))
91  #2a((1 0)(0 1))
92  #2a((0 1)(1 0))
93  #2a((1 0)(0 1)))
94
95;;; Adjustable array
96
97(deftest bit-not.14
98  (let ((a1 (make-array '(2 2) :element-type 'bit
99                        :adjustable t
100                        :initial-contents '((0 1)(1 0)))))
101    (values (bit-not a1) a1))
102  #2a((1 0)(0 1))
103  #2a((0 1)(1 0)))
104
105;;; Displaced arrays
106
107(deftest bit-not.15
108  (let* ((a0 (make-array '(12) :element-type 'bit
109                         :initial-contents '(0 0 0 1 1 0 0 0 0 0 0 0)))
110         (a1 (make-array '(2 2) :element-type 'bit
111                         :displaced-to a0
112                         :displaced-index-offset 2))
113         (a2 (make-array '(2 2) :element-type 'bit
114                         :displaced-to a0
115                         :displaced-index-offset 6)))
116    (values (bit-not a1 a2) a0 a1 a2))
117  #2a((1 0)(0 1))
118  #*000110100100
119  #2a((0 1)(1 0))
120  #2a((1 0)(0 1)))
121
122;;; Macro env tests
123
124(deftest bit-not.16
125  (macrolet
126   ((%m (z) z))
127   (bit-not (expand-in-current-env (%m #*10010011))))
128  #*01101100)
129
130(deftest bit-not.17
131  (macrolet
132   ((%m (z) z))
133   (bit-not #*1101011010 (expand-in-current-env (%m nil))))
134  #*0010100101)
135
136;;;
137
138(deftest bit-not.order.1
139  (let ((a (copy-seq #*001101))
140        (i 0) x)
141    (values
142     (bit-not (progn (setf x (incf i)) a))
143     i x))
144  #*110010 1 1)
145
146(def-fold-test bit-not.fold.1 (bit-not #*00101))
147
148;;; Error tests
149
150(deftest bit-not.error.1
151  (signals-error (bit-not) program-error)
152  t)
153
154(deftest bit-not.error.2
155  (signals-error (bit-not #*000 nil nil) program-error)
156  t)
Note: See TracBrowser for help on using the repository browser.