~ubuntu-branches/ubuntu/quantal/gclcvs/quantal

« back to all changes in this revision

Viewing changes to ansi-tests/bit-eqv.lsp

  • Committer: Bazaar Package Importer
  • Author(s): Camm Maguire
  • Date: 2004-06-24 15:13:46 UTC
  • Revision ID: james.westby@ubuntu.com-20040624151346-xh0xaaktyyp7aorc
Tags: 2.7.0-26
C_GC_OFFSET is 2 on m68k-linux

Show diffs side-by-side

added added

removed removed

Lines of Context:
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Sun Jan 26 19:07:23 2003
 
4
;;;; Contains: Tests of BIT-EQV
 
5
 
 
6
 
 
7
(in-package :cl-test)
 
8
 
 
9
(deftest bit-eqv.1
 
10
  (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
 
11
         (s2 (make-array nil :initial-element 0 :element-type 'bit)))
 
12
    (values (bit-eqv s1 s2) s1 s2))
 
13
  #0a1
 
14
  #0a0
 
15
  #0a0)
 
16
 
 
17
(deftest bit-eqv.2
 
18
  (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit))
 
19
         (s2 (make-array nil :initial-element 0 :element-type 'bit)))
 
20
    (values (bit-eqv s1 s2) s1 s2))
 
21
  #0a0
 
22
  #0a1
 
23
  #0a0)
 
24
 
 
25
(deftest bit-eqv.3
 
26
  (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
 
27
         (s2 (make-array nil :initial-element 1 :element-type 'bit)))
 
28
    (values (bit-eqv s1 s2) s1 s2))
 
29
  #0a0
 
30
  #0a0
 
31
  #0a1)
 
32
 
 
33
(deftest bit-eqv.4
 
34
  (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit))
 
35
         (s2 (make-array nil :initial-element 1 :element-type 'bit)))
 
36
    (values (bit-eqv s1 s2) s1 s2))
 
37
  #0a1
 
38
  #0a1
 
39
  #0a1)
 
40
 
 
41
(deftest bit-eqv.5
 
42
  (let* ((s1 (make-array nil :initial-element 0 :element-type 'bit))
 
43
         (s2 (make-array nil :initial-element 0 :element-type 'bit))
 
44
         (s3 (make-array nil :initial-element 0 :element-type 'bit))
 
45
         (result (bit-eqv s1 s2 s3)))
 
46
    (values s1 s2 s3 result (eqt s3 result)))
 
47
  #0a0
 
48
  #0a0
 
49
  #0a1
 
50
  #0a1
 
51
  t)
 
52
 
 
53
(deftest bit-eqv.6
 
54
  (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit))
 
55
         (s2 (make-array nil :initial-element 1 :element-type 'bit))
 
56
         (s3 (make-array nil :initial-element 0 :element-type 'bit))
 
57
         (result (bit-eqv s1 s2 s3)))
 
58
    (values s1 s2 s3 result (eqt s3 result)))
 
59
  #0a1
 
60
  #0a1
 
61
  #0a1
 
62
  #0a1
 
63
  t)
 
64
 
 
65
(deftest bit-eqv.7
 
66
  (let* ((s1 (make-array nil :initial-element 1 :element-type 'bit))
 
67
         (s2 (make-array nil :initial-element 0 :element-type 'bit))
 
68
         (result (bit-eqv s1 s2 t)))
 
69
    (values s1 s2 result (eqt s1 result)))
 
70
  #0a0
 
71
  #0a0
 
72
  #0a0
 
73
  t)
 
74
 
 
75
 
 
76
;;; Tests on bit vectors
 
77
 
 
78
(deftest bit-eqv.8
 
79
  (let ((a1 (copy-seq #*0011))
 
80
        (a2 (copy-seq #*0101)))
 
81
    (values (check-values (bit-eqv a1 a2)) a1 a2))
 
82
  #*1001 #*0011 #*0101)
 
83
 
 
84
(deftest bit-eqv.9
 
85
  (let* ((a1 (copy-seq #*0011))
 
86
         (a2 (copy-seq #*0101))
 
87
         (result (check-values (bit-eqv a1 a2 t))))
 
88
    (values result a1 a2 (eqt result a1)))
 
89
  #*1001 #*1001 #*0101 t)
 
90
 
 
91
(deftest bit-eqv.10
 
92
  (let* ((a1 (copy-seq #*0011))
 
93
         (a2 (copy-seq #*0101))
 
94
         (a3 (copy-seq #*0000))
 
95
         (result (check-values (bit-eqv a1 a2 a3))))
 
96
    (values result a1 a2 a3 (eqt result a3)))
 
97
  #*1001 #*0011 #*0101 #*1001 t)
 
98
 
 
99
(deftest bit-eqv.11
 
100
  (let ((a1 (copy-seq #*0011))
 
101
        (a2 (copy-seq #*0101)))
 
102
    (values (check-values (bit-eqv a1 a2 nil)) a1 a2))
 
103
  #*1001 #*0011 #*0101)
 
104
 
 
105
;;; Tests on bit arrays
 
106
 
 
107
(deftest bit-eqv.12
 
108
  (let* ((a1 (make-array '(2 2) :element-type 'bit
 
109
                         :initial-contents '((0 1)(0 1))))
 
110
         (a2 (make-array '(2 2) :element-type 'bit
 
111
                         :initial-contents '((0 0)(1 1))))
 
112
         (result (bit-eqv a1 a2)))
 
113
    (values a1 a2 result))
 
114
  #2a((0 1)(0 1))
 
115
  #2a((0 0)(1 1))
 
116
  #2a((1 0)(0 1)))
 
117
 
 
118
(deftest bit-eqv.13
 
119
  (let* ((a1 (make-array '(2 2) :element-type 'bit
 
120
                         :initial-contents '((0 1)(0 1))))
 
121
         (a2 (make-array '(2 2) :element-type 'bit
 
122
                         :initial-contents '((0 0)(1 1))))
 
123
         (result (bit-eqv a1 a2 t)))
 
124
    (values a1 a2 result))
 
125
  #2a((1 0)(0 1))
 
126
  #2a((0 0)(1 1))
 
127
  #2a((1 0)(0 1)))
 
128
 
 
129
(deftest bit-eqv.14
 
130
  (let* ((a1 (make-array '(2 2) :element-type 'bit
 
131
                         :initial-contents '((0 1)(0 1))))
 
132
         (a2 (make-array '(2 2) :element-type 'bit
 
133
                         :initial-contents '((0 0)(1 1))))
 
134
         (result (bit-eqv a1 a2 nil)))
 
135
    (values a1 a2 result))
 
136
  #2a((0 1)(0 1))
 
137
  #2a((0 0)(1 1))
 
138
  #2a((1 0)(0 1)))
 
139
 
 
140
(deftest bit-eqv.15
 
141
  (let* ((a1 (make-array '(2 2) :element-type 'bit
 
142
                         :initial-contents '((0 1)(0 1))))
 
143
         (a2 (make-array '(2 2) :element-type 'bit
 
144
                         :initial-contents '((0 0)(1 1))))
 
145
         (a3 (make-array '(2 2) :element-type 'bit
 
146
                         :initial-contents '((0 0)(0 0))))
 
147
         (result (bit-eqv a1 a2 a3)))
 
148
    (values a1 a2 a3 result))
 
149
  #2a((0 1)(0 1))
 
150
  #2a((0 0)(1 1))
 
151
  #2a((1 0)(0 1))
 
152
  #2a((1 0)(0 1)))
 
153
 
 
154
;;; Adjustable arrays
 
155
 
 
156
(deftest bit-eqv.16
 
157
  (let* ((a1 (make-array '(2 2) :element-type 'bit
 
158
                         :initial-contents '((0 1)(0 1))
 
159
                         :adjustable t))
 
160
         (a2 (make-array '(2 2) :element-type 'bit
 
161
                         :initial-contents '((0 0)(1 1))
 
162
                         :adjustable t))
 
163
         (result (bit-eqv a1 a2)))
 
164
    (values a1 a2 result))
 
165
  #2a((0 1)(0 1))
 
166
  #2a((0 0)(1 1))
 
167
  #2a((1 0)(0 1)))
 
168
 
 
169
;;; Displaced arrays
 
170
 
 
171
(deftest bit-eqv.17
 
172
  (let* ((a0 (make-array '(8) :element-type 'bit
 
173
                         :initial-contents '(0 1 0 1 0 0 1 1)))
 
174
         (a1 (make-array '(2 2) :element-type 'bit
 
175
                         :displaced-to a0
 
176
                         :displaced-index-offset 0))
 
177
         (a2 (make-array '(2 2) :element-type 'bit
 
178
                         :displaced-to a0
 
179
                         :displaced-index-offset 4))
 
180
         (result (bit-eqv a1 a2)))
 
181
    (values a0 a1 a2 result))
 
182
  #*01010011
 
183
  #2a((0 1)(0 1))
 
184
  #2a((0 0)(1 1))
 
185
  #2a((1 0)(0 1)))
 
186
 
 
187
(deftest bit-eqv.18
 
188
  (let* ((a0 (make-array '(8) :element-type 'bit
 
189
                         :initial-contents '(0 1 0 1 0 0 1 1)))
 
190
         (a1 (make-array '(2 2) :element-type 'bit
 
191
                         :displaced-to a0
 
192
                         :displaced-index-offset 0))
 
193
         (a2 (make-array '(2 2) :element-type 'bit
 
194
                         :displaced-to a0
 
195
                         :displaced-index-offset 4))
 
196
         (result (bit-eqv a1 a2 t)))
 
197
    (values a0 a1 a2 result))
 
198
  #*10010011
 
199
  #2a((1 0)(0 1))
 
200
  #2a((0 0)(1 1))
 
201
  #2a((1 0)(0 1)))
 
202
 
 
203
(deftest bit-eqv.19
 
204
  (let* ((a0 (make-array '(12) :element-type 'bit
 
205
                         :initial-contents '(0 1 0 1 0 0 1 1 1 1 1 0)))
 
206
         (a1 (make-array '(2 2) :element-type 'bit
 
207
                         :displaced-to a0
 
208
                         :displaced-index-offset 0))
 
209
         (a2 (make-array '(2 2) :element-type 'bit
 
210
                         :displaced-to a0
 
211
                         :displaced-index-offset 4))
 
212
         (a3 (make-array '(2 2) :element-type 'bit
 
213
                         :displaced-to a0
 
214
                         :displaced-index-offset 8))
 
215
         (result (bit-eqv a1 a2 a3)))
 
216
    (values a0 a1 a2 result))
 
217
  #*010100111001
 
218
  #2a((0 1)(0 1))
 
219
  #2a((0 0)(1 1))
 
220
  #2a((1 0)(0 1)))
 
221
 
 
222
(deftest bit-eqv.order.1
 
223
  (let* ((s1 (make-array 1 :initial-element 0 :element-type 'bit))
 
224
         (s2 (make-array 1 :initial-element 0 :element-type 'bit))
 
225
         (x 0) y z)
 
226
    (values
 
227
     (bit-eqv (progn (setf y (incf x)) s1)
 
228
              (progn (setf z (incf x)) s2))
 
229
     x y z))
 
230
  #*1 2 1 2)
 
231
 
 
232
;;; Error tests
 
233
 
 
234
(deftest bit-eqv.error.1
 
235
  (signals-error (bit-eqv) program-error)
 
236
  t)
 
237
 
 
238
(deftest bit-eqv.error.2
 
239
  (signals-error (bit-eqv #*000) program-error)
 
240
  t)
 
241
 
 
242
(deftest bit-eqv.error.3
 
243
  (signals-error (bit-eqv #*000 #*0100 nil nil)
 
244
                 program-error)
 
245
  t)