vector-push.lsp 8.3 KB
Newer Older
1
2
3
4
5
6
7
8
9
;-*- Mode:     Lisp -*-
;;;; Author:   Paul Dietz
;;;; Created:  Sat Jan 25 00:55:43 2003
;;;; Contains: Tests for VECTOR-PUSH

(in-package :cl-test)

(deftest vector-push.1
  (let ((a (make-array '(5) :fill-pointer 2
sds's avatar
sds committed
10
11
                       :initial-contents '(a b c d e)))
        (i 0) x y)
12
13
    (values
     (fill-pointer a)
14
     (vector-push (progn (setf x (incf i)) 'x)
sds's avatar
sds committed
15
                  (progn (setf y (incf i)) a))
16
     (fill-pointer a)
17
18
     a i x y))
  2 2 3 #(a b x) 2 1 2)
19
20
21
22


(deftest vector-push.2
  (let ((a (make-array '(5) :fill-pointer 5
sds's avatar
sds committed
23
                       :initial-contents '(a b c d e))))
24
25
26
27
28
29
30
31
32
    (values
     (fill-pointer a)
     (vector-push 'x a)
     (fill-pointer a)
     a))
  5 nil 5 #(a b c d e))

(deftest vector-push.3
  (let ((a (make-array '(5) :fill-pointer 2
sds's avatar
sds committed
33
34
                       :initial-contents "abcde"
                       :element-type 'base-char)))
35
36
37
38
39
40
41
42
43
    (values
     (fill-pointer a)
     (vector-push #\x a)
     (fill-pointer a)
     a))
  2 2 3 "abx")

(deftest vector-push.4
  (let ((a (make-array '(5) :fill-pointer 5
sds's avatar
sds committed
44
45
                       :initial-contents "abcde"
                       :element-type 'base-char)))
46
47
48
49
50
51
52
53
54
    (values
     (fill-pointer a)
     (vector-push #\x a)
     (fill-pointer a)
     a))
  5 nil 5 "abcde")

(deftest vector-push.5
  (let ((a (make-array '(5) :fill-pointer 2
sds's avatar
sds committed
55
56
                       :initial-contents "abcde"
                       :element-type 'character)))
57
58
59
60
61
62
63
64
65
    (values
     (fill-pointer a)
     (vector-push #\x a)
     (fill-pointer a)
     a))
  2 2 3 "abx")

(deftest vector-push.6
  (let ((a (make-array '(5) :fill-pointer 5
sds's avatar
sds committed
66
67
                       :initial-contents "abcde"
                       :element-type 'character)))
68
69
70
71
72
73
74
75
76
    (values
     (fill-pointer a)
     (vector-push #\x a)
     (fill-pointer a)
     a))
  5 nil 5 "abcde")

(deftest vector-push.7
  (let ((a (make-array '(5) :fill-pointer 2
sds's avatar
sds committed
77
78
                       :initial-contents '(0 1 1 0 0)
                       :element-type 'bit)))
79
80
81
82
83
84
85
86
87
    (values
     (fill-pointer a)
     (vector-push 0 a)
     (fill-pointer a)
     a))
  2 2 3 #*010)

(deftest vector-push.8
  (let ((a (make-array '(5) :fill-pointer 5
sds's avatar
sds committed
88
89
                       :initial-contents '(0 0 0 0 0)
                       :element-type 'bit)))
90
91
92
93
94
95
96
97
98
    (values
     (fill-pointer a)
     (vector-push 1 a)
     (fill-pointer a)
     a))
  5 nil 5 #*00000)

(deftest vector-push.9
  (let ((a (make-array '(5) :fill-pointer 2
sds's avatar
sds committed
99
100
                       :initial-contents '(1 2 3 4 5)
                       :element-type 'fixnum)))
101
102
103
104
105
106
107
108
109
    (values
     (fill-pointer a)
     (vector-push 0 a)
     (fill-pointer a)
     a))
  2 2 3 #(1 2 0))

(deftest vector-push.10
  (let ((a (make-array '(5) :fill-pointer 5
sds's avatar
sds committed
110
111
                       :initial-contents '(1 2 3 4 5)
                       :element-type 'fixnum)))
112
113
114
115
116
117
118
119
120
    (values
     (fill-pointer a)
     (vector-push 0 a)
     (fill-pointer a)
     a))
  5 nil 5 #(1 2 3 4 5))

(deftest vector-push.11
  (let ((a (make-array '(5) :fill-pointer 2
sds's avatar
sds committed
121
122
                       :initial-contents '(1 2 3 4 5)
                       :element-type '(integer 0 (256)))))
123
124
125
126
127
128
129
130
131
    (values
     (fill-pointer a)
     (vector-push 0 a)
     (fill-pointer a)
     a))
  2 2 3 #(1 2 0))

(deftest vector-push.12
  (let ((a (make-array '(5) :fill-pointer 5
sds's avatar
sds committed
132
133
                       :initial-contents '(1 2 3 4 5)
                       :element-type '(integer 0 (256)))))
134
135
136
137
138
139
140
141
142
    (values
     (fill-pointer a)
     (vector-push 0 a)
     (fill-pointer a)
     a))
  5 nil 5 #(1 2 3 4 5))

(deftest vector-push.13
  (let ((a (make-array '(5) :fill-pointer 2
sds's avatar
sds committed
143
144
                       :initial-contents '(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0)
                       :element-type 'short-float)))
145
146
147
148
149
150
151
152
153
    (values
     (fill-pointer a)
     (vector-push 0.0s0 a)
     (fill-pointer a)
     a))
  2 2 3 #(1.0s0 2.0s0 0.0s0))

(deftest vector-push.14
  (let ((a (make-array '(5) :fill-pointer 5
sds's avatar
sds committed
154
155
                       :initial-contents '(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0)
                       :element-type 'short-float)))
156
157
158
159
160
161
162
163
164
    (values
     (fill-pointer a)
     (vector-push 0.0s0 a)
     (fill-pointer a)
     a))
  5 nil 5 #(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0))

(deftest vector-push.15
  (let ((a (make-array '(5) :fill-pointer 2
sds's avatar
sds committed
165
166
                       :initial-contents '(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0)
                       :element-type 'single-float)))
167
168
169
170
171
172
173
174
175
    (values
     (fill-pointer a)
     (vector-push 0.0f0 a)
     (fill-pointer a)
     a))
  2 2 3 #(1.0f0 2.0f0 0.0f0))

(deftest vector-push.16
  (let ((a (make-array '(5) :fill-pointer 5
sds's avatar
sds committed
176
177
                       :initial-contents '(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0)
                       :element-type 'single-float)))
178
179
180
181
182
183
184
185
186
187
    (values
     (fill-pointer a)
     (vector-push 0.0f0 a)
     (fill-pointer a)
     a))
  5 nil 5 #(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0))


(deftest vector-push.17
  (let ((a (make-array '(5) :fill-pointer 2
sds's avatar
sds committed
188
189
                       :initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)
                       :element-type 'double-float)))
190
191
192
193
194
195
196
197
198
    (values
     (fill-pointer a)
     (vector-push 0.0d0 a)
     (fill-pointer a)
     a))
  2 2 3 #(1.0d0 2.0d0 0.0d0))

(deftest vector-push.18
  (let ((a (make-array '(5) :fill-pointer 5
sds's avatar
sds committed
199
200
                       :initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)
                       :element-type 'double-float)))
201
202
203
204
205
206
207
208
209
    (values
     (fill-pointer a)
     (vector-push 0.0d0 a)
     (fill-pointer a)
     a))
  5 nil 5 #(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0))

(deftest vector-push.19
  (let ((a (make-array '(5) :fill-pointer 2
sds's avatar
sds committed
210
211
                       :initial-contents '(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0)
                       :element-type 'long-float)))
212
213
214
215
216
217
218
219
220
    (values
     (fill-pointer a)
     (vector-push 0.0l0 a)
     (fill-pointer a)
     a))
  2 2 3 #(1.0l0 2.0l0 0.0l0))

(deftest vector-push.20
  (let ((a (make-array '(5) :fill-pointer 5
sds's avatar
sds committed
221
222
                       :initial-contents '(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0)
                       :element-type 'long-float)))
223
224
225
226
227
228
229
230
231
232
233
234
    (values
     (fill-pointer a)
     (vector-push 0.0l0 a)
     (fill-pointer a)
     a))
  5 nil 5 #(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0))



;;; Error tests

(defun vector-push-error-test (seq val)
pfdietz's avatar
pfdietz committed
235
  (declare (optimize (safety 3)))
236
237
  (handler-case
   (eval `(let ((a (copy-seq ,seq)))
sds's avatar
sds committed
238
239
240
            (declare (optimize (safety 3)))
            (or (notnot (array-has-fill-pointer-p a))
                (vector-push ',val a))))
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
   (error () t)))

(deftest vector-push.error.1
  (vector-push-error-test #(a b c d) 'x)
  t)

(deftest vector-push.error.2
  (vector-push-error-test #*00000 1)
  t)

(deftest vector-push.error.3
  (vector-push-error-test "abcde" #\x)
  t)

(deftest vector-push.error.4
  (vector-push-error-test #() 'x)
  t)

(deftest vector-push.error.5
  (vector-push-error-test #* 1)
  t)

(deftest vector-push.error.6
  (vector-push-error-test "" #\x)
  t)

(deftest vector-push.error.7
  (vector-push-error-test (make-array '5 :element-type 'base-char
sds's avatar
sds committed
269
270
                                      :initial-element #\a)
                          #\x)
271
272
273
274
  t)

(deftest vector-push.error.8
  (vector-push-error-test (make-array '5 :element-type '(integer 0 (256))
sds's avatar
sds committed
275
276
                                      :initial-element 0)
                          17)
277
278
279
280
  t)

(deftest vector-push.error.9
  (vector-push-error-test (make-array '5 :element-type 'float
sds's avatar
sds committed
281
282
                                      :initial-element 1.0)
                          2.0)
283
284
285
286
  t)

(deftest vector-push.error.10
  (vector-push-error-test (make-array '5 :element-type 'short-float
sds's avatar
sds committed
287
288
                                      :initial-element 1.0s0)
                          2.0s0)
289
290
291
292
  t)

(deftest vector-push.error.11
  (vector-push-error-test (make-array '5 :element-type 'long-float
sds's avatar
sds committed
293
294
                                      :initial-element 1.0l0)
                          2.0l0)
295
296
297
298
  t)

(deftest vector-push.error.12
  (vector-push-error-test (make-array '5 :element-type 'single-float
sds's avatar
sds committed
299
300
                                      :initial-element 1.0f0)
                          2.0f0)
301
302
303
304
  t)

(deftest vector-push.error.13
  (vector-push-error-test (make-array '5 :element-type 'double-float
sds's avatar
sds committed
305
306
                                      :initial-element 1.0d0)
                          2.0d0)
307
308
309
  t)

(deftest vector-push.error.14
310
311
  (signals-error (vector-push) program-error)
  t)
312
313

(deftest vector-push.error.15
314
315
  (signals-error (vector-push (vector 1 2 3)) program-error)
  t)
316
317

(deftest vector-push.error.16
318
319
  (signals-error (vector-push (vector 1 2 3) 4 nil) program-error)
  t)