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

« back to all changes in this revision

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