source: trunk/source/tests/ansi-tests/vector-push.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: 7.4 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Jan 25 00:55:43 2003
4;;;; Contains: Tests for VECTOR-PUSH
5
6(in-package :cl-test)
7
8(deftest vector-push.1
9  (let ((a (make-array '(5) :fill-pointer 2
10                       :initial-contents '(a b c d e)))
11        (i 0) x y)
12    (values
13     (fill-pointer a)
14     (vector-push (progn (setf x (incf i)) 'x)
15                  (progn (setf y (incf i)) a))
16     (fill-pointer a)
17     a i x y))
18  2 2 3 #(a b x) 2 1 2)
19
20
21(deftest vector-push.2
22  (let ((a (make-array '(5) :fill-pointer 5
23                       :initial-contents '(a b c d e))))
24    (values
25     (fill-pointer a)
26     (vector-push 'x a)
27     (fill-pointer a)
28     a))
29  5 nil 5 #(a b c d e))
30
31(deftest vector-push.3
32  (let ((a (make-array '(5) :fill-pointer 2
33                       :initial-contents "abcde"
34                       :element-type 'base-char)))
35    (values
36     (fill-pointer a)
37     (vector-push #\x a)
38     (fill-pointer a)
39     a))
40  2 2 3 "abx")
41
42(deftest vector-push.4
43  (let ((a (make-array '(5) :fill-pointer 5
44                       :initial-contents "abcde"
45                       :element-type 'base-char)))
46    (values
47     (fill-pointer a)
48     (vector-push #\x a)
49     (fill-pointer a)
50     a))
51  5 nil 5 "abcde")
52
53(deftest vector-push.5
54  (let ((a (make-array '(5) :fill-pointer 2
55                       :initial-contents "abcde"
56                       :element-type 'character)))
57    (values
58     (fill-pointer a)
59     (vector-push #\x a)
60     (fill-pointer a)
61     a))
62  2 2 3 "abx")
63
64(deftest vector-push.6
65  (let ((a (make-array '(5) :fill-pointer 5
66                       :initial-contents "abcde"
67                       :element-type 'character)))
68    (values
69     (fill-pointer a)
70     (vector-push #\x a)
71     (fill-pointer a)
72     a))
73  5 nil 5 "abcde")
74
75(deftest vector-push.7
76  (let ((a (make-array '(5) :fill-pointer 2
77                       :initial-contents '(0 1 1 0 0)
78                       :element-type 'bit)))
79    (values
80     (fill-pointer a)
81     (vector-push 0 a)
82     (fill-pointer a)
83     a))
84  2 2 3 #*010)
85
86(deftest vector-push.8
87  (let ((a (make-array '(5) :fill-pointer 5
88                       :initial-contents '(0 0 0 0 0)
89                       :element-type 'bit)))
90    (values
91     (fill-pointer a)
92     (vector-push 1 a)
93     (fill-pointer a)
94     a))
95  5 nil 5 #*00000)
96
97(deftest vector-push.9
98  (let ((a (make-array '(5) :fill-pointer 2
99                       :initial-contents '(1 2 3 4 5)
100                       :element-type 'fixnum)))
101    (values
102     (fill-pointer a)
103     (vector-push 0 a)
104     (fill-pointer a)
105     a))
106  2 2 3 #(1 2 0))
107
108(deftest vector-push.10
109  (let ((a (make-array '(5) :fill-pointer 5
110                       :initial-contents '(1 2 3 4 5)
111                       :element-type 'fixnum)))
112    (values
113     (fill-pointer a)
114     (vector-push 0 a)
115     (fill-pointer a)
116     a))
117  5 nil 5 #(1 2 3 4 5))
118
119(deftest vector-push.11
120  (let ((a (make-array '(5) :fill-pointer 2
121                       :initial-contents '(1 2 3 4 5)
122                       :element-type '(integer 0 (256)))))
123    (values
124     (fill-pointer a)
125     (vector-push 0 a)
126     (fill-pointer a)
127     a))
128  2 2 3 #(1 2 0))
129
130(deftest vector-push.12
131  (let ((a (make-array '(5) :fill-pointer 5
132                       :initial-contents '(1 2 3 4 5)
133                       :element-type '(integer 0 (256)))))
134    (values
135     (fill-pointer a)
136     (vector-push 0 a)
137     (fill-pointer a)
138     a))
139  5 nil 5 #(1 2 3 4 5))
140
141(deftest vector-push.13
142  (let ((a (make-array '(5) :fill-pointer 2
143                       :initial-contents '(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0)
144                       :element-type 'short-float)))
145    (values
146     (fill-pointer a)
147     (vector-push 0.0s0 a)
148     (fill-pointer a)
149     a))
150  2 2 3 #(1.0s0 2.0s0 0.0s0))
151
152(deftest vector-push.14
153  (let ((a (make-array '(5) :fill-pointer 5
154                       :initial-contents '(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0)
155                       :element-type 'short-float)))
156    (values
157     (fill-pointer a)
158     (vector-push 0.0s0 a)
159     (fill-pointer a)
160     a))
161  5 nil 5 #(1.0s0 2.0s0 3.0s0 4.0s0 5.0s0))
162
163(deftest vector-push.15
164  (let ((a (make-array '(5) :fill-pointer 2
165                       :initial-contents '(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0)
166                       :element-type 'single-float)))
167    (values
168     (fill-pointer a)
169     (vector-push 0.0f0 a)
170     (fill-pointer a)
171     a))
172  2 2 3 #(1.0f0 2.0f0 0.0f0))
173
174(deftest vector-push.16
175  (let ((a (make-array '(5) :fill-pointer 5
176                       :initial-contents '(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0)
177                       :element-type 'single-float)))
178    (values
179     (fill-pointer a)
180     (vector-push 0.0f0 a)
181     (fill-pointer a)
182     a))
183  5 nil 5 #(1.0f0 2.0f0 3.0f0 4.0f0 5.0f0))
184
185
186(deftest vector-push.17
187  (let ((a (make-array '(5) :fill-pointer 2
188                       :initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)
189                       :element-type 'double-float)))
190    (values
191     (fill-pointer a)
192     (vector-push 0.0d0 a)
193     (fill-pointer a)
194     a))
195  2 2 3 #(1.0d0 2.0d0 0.0d0))
196
197(deftest vector-push.18
198  (let ((a (make-array '(5) :fill-pointer 5
199                       :initial-contents '(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0)
200                       :element-type 'double-float)))
201    (values
202     (fill-pointer a)
203     (vector-push 0.0d0 a)
204     (fill-pointer a)
205     a))
206  5 nil 5 #(1.0d0 2.0d0 3.0d0 4.0d0 5.0d0))
207
208(deftest vector-push.19
209  (let ((a (make-array '(5) :fill-pointer 2
210                       :initial-contents '(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0)
211                       :element-type 'long-float)))
212    (values
213     (fill-pointer a)
214     (vector-push 0.0l0 a)
215     (fill-pointer a)
216     a))
217  2 2 3 #(1.0l0 2.0l0 0.0l0))
218
219(deftest vector-push.20
220  (let ((a (make-array '(5) :fill-pointer 5
221                       :initial-contents '(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0)
222                       :element-type 'long-float)))
223    (values
224     (fill-pointer a)
225     (vector-push 0.0l0 a)
226     (fill-pointer a)
227     a))
228  5 nil 5 #(1.0l0 2.0l0 3.0l0 4.0l0 5.0l0))
229
230
231
232;;; Error tests
233
234(defun vector-push-error-test (seq val)
235  (declare (optimize (safety 3)))
236  (handler-case
237   (eval `(let ((a (copy-seq ,seq)))
238            (declare (optimize (safety 3)))
239            (or (notnot (array-has-fill-pointer-p a))
240                (vector-push ',val a))))
241   (error () t)))
242
243(deftest vector-push.error.1
244  (vector-push-error-test #(a b c d) 'x)
245  t)
246
247(deftest vector-push.error.2
248  (vector-push-error-test #*00000 1)
249  t)
250
251(deftest vector-push.error.3
252  (vector-push-error-test "abcde" #\x)
253  t)
254
255(deftest vector-push.error.4
256  (vector-push-error-test #() 'x)
257  t)
258
259(deftest vector-push.error.5
260  (vector-push-error-test #* 1)
261  t)
262
263(deftest vector-push.error.6
264  (vector-push-error-test "" #\x)
265  t)
266
267(deftest vector-push.error.7
268  (vector-push-error-test (make-array '5 :element-type 'base-char
269                                      :initial-element #\a)
270                          #\x)
271  t)
272
273(deftest vector-push.error.8
274  (vector-push-error-test (make-array '5 :element-type '(integer 0 (256))
275                                      :initial-element 0)
276                          17)
277  t)
278
279(deftest vector-push.error.9
280  (vector-push-error-test (make-array '5 :element-type 'float
281                                      :initial-element 1.0)
282                          2.0)
283  t)
284
285(deftest vector-push.error.10
286  (vector-push-error-test (make-array '5 :element-type 'short-float
287                                      :initial-element 1.0s0)
288                          2.0s0)
289  t)
290
291(deftest vector-push.error.11
292  (vector-push-error-test (make-array '5 :element-type 'long-float
293                                      :initial-element 1.0l0)
294                          2.0l0)
295  t)
296
297(deftest vector-push.error.12
298  (vector-push-error-test (make-array '5 :element-type 'single-float
299                                      :initial-element 1.0f0)
300                          2.0f0)
301  t)
302
303(deftest vector-push.error.13
304  (vector-push-error-test (make-array '5 :element-type 'double-float
305                                      :initial-element 1.0d0)
306                          2.0d0)
307  t)
308
309(deftest vector-push.error.14
310  (signals-error (vector-push) program-error)
311  t)
312
313(deftest vector-push.error.15
314  (signals-error (vector-push (vector 1 2 3)) program-error)
315  t)
316
317(deftest vector-push.error.16
318  (signals-error (vector-push (vector 1 2 3) 4 nil) program-error)
319  t)
Note: See TracBrowser for help on using the repository browser.