source: trunk/source/tests/ansi-tests/elt.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: 10.0 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Oct 12 19:38:29 2002
4;;;; Contains: Tests of ELT
5
6(in-package :cl-test)
7
8(declaim (optimize (safety 3)))
9
10;; elt on lists
11
12(deftest elt.1
13  (signals-error (elt nil  0) type-error)
14  t)
15
16(deftest elt.1a
17  (signals-error (elt nil -10) type-error)
18  t)
19
20(deftest elt.1b
21  (signals-error (locally (elt nil 0) t) type-error)
22  t)
23
24(deftest elt.2
25  (signals-error (elt nil 1000000) type-error)
26  t)
27
28(deftest elt.3 (elt '(a b c d e) 0) a)
29(deftest elt.4 (elt '(a b c d e) 2) c)
30(deftest elt.5 (elt '(a b c d e) 4) e)
31(deftest elt.5a
32  (signals-error (elt '(a b c d e) -4) type-error)
33  t)
34
35(deftest elt.6
36  (let ((x (make-int-list 1000)))
37    (notnot-mv
38     (every
39      #'(lambda (i) (eql i (elt x i)))
40      x)))
41  t)
42
43(deftest elt.7
44  (let* ((x (list 'a 'b 'c 'd))
45         (y (setf (elt x 0) 'e)))
46    (list x y))
47  ((e b c d) e))
48
49(deftest elt.8
50  (let* ((x (list 'a 'b 'c 'd))
51         (y (setf (elt x 1) 'e)))
52    (list x y))
53  ((a e c d) e))
54
55(deftest elt.9
56  (let* ((x (list 'a 'b 'c 'd))
57         (y (setf (elt x 3) 'e)))
58    (list x y))
59  ((a b c e) e))
60
61(deftest elt.10
62  (signals-error
63   (let ((x (list 'a 'b 'c)))
64     (setf (elt x 4) 'd))
65   type-error)
66  t)
67
68(deftest elt.11
69  (let ((x (list 'a 'b 'c 'd 'e)))
70    (let ((y (loop for c on x collect c)))
71      (setf (elt x 2) 'f)
72      (notnot-mv
73       (every #'eq
74              y
75              (loop for c on x collect c)))))
76  t)
77
78(deftest elt.12
79  (let ((x (make-int-list 100000)))
80    (elt x 90000))
81  90000)
82
83(deftest elt.13
84  (let ((x (make-int-list 100000)))
85    (setf (elt x 80000) 'foo)
86    (list (elt x 79999)
87          (elt x 80000)
88          (elt x 80001)))
89  (79999 foo 80001))
90
91(deftest elt.14
92  (signals-error
93   (let ((x (list 'a 'b 'c)))
94     (elt x 10))
95   type-error)
96  t)
97
98(deftest elt.15
99  (signals-error
100   (let ((x (list 'a 'b 'c)))
101     (elt x 'a))
102   type-error)
103  t)
104
105(deftest elt.16
106  (signals-error
107   (let ((x (list 'a 'b 'c)))
108     (elt x 10.0))
109   type-error)
110  t)
111
112(deftest elt.17
113  (signals-error
114   (let ((x (list 'a 'b 'c)))
115     (elt x -1))
116   type-error)
117  t)
118
119(deftest elt.18
120  (signals-error
121   (let ((x (list 'a 'b 'c)))
122     (elt x -100000000000000000))
123   type-error)
124  t)
125
126(deftest elt.19
127  (signals-error
128   (let ((x (list 'a 'b 'c)))
129     (elt x #\w))
130   type-error)
131  t)
132
133(deftest elt.order.1
134  (let ((i 0) x y)
135    (values
136     (elt (progn (setf x (incf i)) '(a b c d e))
137          (progn (setf y (incf i)) 3))
138     i x y))
139  d 2 1 2)
140
141(deftest elt.order.2
142  (let ((i 0) x y z)
143    (let ((a (make-array 1 :initial-element (list 'a 'b 'c 'd 'e))))
144      (values
145       (setf (elt (aref a (progn (setf x (incf i)) 0))
146                  (progn (setf y (incf i)) 3))
147             (progn (setf z (incf i)) 'k))
148       (aref a 0)
149       i x y z)))
150  k (a b c k e) 3 1 2 3)
151
152(deftest elt-v.1
153  (signals-error (elt (make-array '(0)) 0) type-error)
154  t)
155
156;; (deftest elt-v.2 (elt (make-array '(1)) 0) nil)  ;; actually undefined
157(deftest elt-v.3
158  (elt (make-array '(5) :initial-contents '(a b c d e)) 0)
159  a)
160
161(deftest elt-v.4
162  (elt (make-array '(5) :initial-contents '(a b c d e)) 2)
163  c)
164
165(deftest elt-v.5
166  (elt (make-array '(5) :initial-contents '(a b c d e)) 4)
167  e)
168
169(deftest elt-v.6
170    (elt-v-6-body)
171  t)
172
173(deftest elt-v.7
174  (let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd)))
175         (y (setf (elt x 0) 'e)))
176    (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))
177  (e b c d e))
178
179(deftest elt-v.8
180  (let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd)))
181         (y (setf (elt x 1) 'e)))
182    (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))
183  (a e c d e))
184
185(deftest elt-v.9
186  (let* ((x (make-array '(4) :initial-contents (list 'a 'b 'c 'd)))
187         (y (setf (elt x 3) 'e)))
188    (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))
189  (a b c e e))
190
191(deftest elt-v.10
192  (signals-error
193   (let ((x (make-array '(3) :initial-contents (list 'a 'b 'c))))
194     (setf (elt x 4) 'd))
195   type-error)
196  t)
197
198(deftest elt-v.11
199  (signals-error
200   (let ((x (make-array '(3) :initial-contents (list 'a 'b 'c))))
201     (setf (elt x -100) 'd))
202   type-error)
203  t)
204
205(deftest elt-v.12
206    (let ((x (make-int-array 100000)))
207      (elt x 90000))
208  90000)
209
210(deftest elt-v.13
211  (let ((x (make-int-array 100000)))
212    (setf (elt x 80000) 'foo)
213    (list (elt x 79999)
214          (elt x 80000)
215          (elt x 80001)))
216  (79999 foo 80001))
217
218;;;  Adjustable arrays
219
220(deftest elt-adj-array.1
221  (signals-error (elt (make-adj-array '(0)) 0) type-error)
222  t)
223
224;;; (deftest elt-adj-array.2 (elt (make-adj-array '(1)) 0) nil) ;; actually undefined
225
226(deftest elt-adj-array.3
227 (elt (make-adj-array '(5) :initial-contents '(a b c d e)) 0)
228  a)
229
230(deftest elt-adj-array.4
231 (elt (make-adj-array '(5) :initial-contents '(a b c d e)) 2)
232  c)
233
234(deftest elt-adj-array.5
235 (elt (make-adj-array '(5) :initial-contents '(a b c d e)) 4)
236  e)
237
238(deftest elt-adj-array.6
239    (elt-adj-array-6-body)
240  t)
241
242(deftest elt-adj-array.7
243  (let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd)))
244         (y (setf (elt x 0) 'e)))
245    (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))
246  (e b c d e))
247
248(deftest elt-adj-array.8
249  (let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd)))
250         (y (setf (elt x 1) 'e)))
251    (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))
252  (a e c d e))
253
254(deftest elt-adj-array.9
255  (let* ((x (make-adj-array '(4) :initial-contents (list 'a 'b 'c 'd)))
256         (y (setf (elt x 3) 'e)))
257    (list (elt x 0) (elt x 1) (elt x 2) (elt x 3) y))
258  (a b c e e))
259
260(deftest elt-adj-array.10
261  (signals-error
262   (let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c))))
263     (setf (elt x 4) 'd))
264   type-error)
265  t)
266
267(deftest elt-adj-array.11
268  (signals-error
269   (let ((x (make-adj-array '(3) :initial-contents (list 'a 'b 'c))))
270     (setf (elt x -100) 'd))
271   type-error)
272  t)
273
274(deftest elt-adj-array.12
275    (let ((x (make-int-array 100000 #'make-adj-array)))
276      (elt x 90000))
277  90000)
278
279(deftest elt-adj-array.13
280    (let ((x (make-int-array 100000 #'make-adj-array)))
281    (setf (elt x 80000) 'foo)
282    (list (elt x 79999)
283          (elt x 80000)
284          (elt x 80001)))
285  (79999 foo 80001))
286
287;; displaced arrays
288
289(deftest elt-displaced-array.1
290  (signals-error (elt (make-displaced-array '(0) 100) 0) type-error)
291  t)
292
293(deftest elt-displaced-array.2
294  (elt (make-displaced-array '(1) 100) 0)
295  100)
296
297(deftest elt-displaced-array.3
298  (elt (make-displaced-array '(5) 100) 4)
299  104)
300
301;;; Arrays with fill points
302
303(deftest elt-fill-pointer.1
304  (let ((a (make-array '(5) :initial-contents '(a b c d e)
305                       :fill-pointer 3)))
306    (values (elt a 0) (elt a 1) (elt a 2)))
307  a b c)
308
309(deftest elt-fill-pointer.2
310  (let ((a (make-array '(5)
311                       :initial-contents '(0 0 1 0 0)
312                       :element-type 'bit
313                       :fill-pointer 3)))
314    (values (elt a 0) (elt a 1) (elt a 2)))
315  0 0 1)
316
317(deftest elt-fill-pointer.3
318  (signals-error
319   (let ((a (make-array '(5)
320                        :initial-contents '(0 0 1 0 0)
321                        :fill-pointer 3)))
322     (elt a 4))
323   type-error)
324  t)
325
326(deftest elt-fill-pointer.4
327  (signals-error
328   (let ((a (make-array '(5)
329                        :initial-contents '(0 0 1 0 0)
330                        :element-type 'bit
331                        :fill-pointer 3)))
332     (elt a 4))
333   type-error)
334  t)
335
336(deftest elt-fill-pointer.5
337   (let ((a (make-array '(5)
338                        :initial-contents '(#\a #\b #\c #\d #\e)
339                        :element-type 'character
340                        :fill-pointer 3)))
341     (values (elt a 0) (elt a 1) (elt a 2)))
342   #\a #\b #\c)
343
344(deftest elt-fill-pointer.6
345  (signals-error
346   (let ((a (make-array '(5)
347                        :initial-contents '(#\a #\b #\c #\d #\e)
348                        :element-type 'character
349                        :fill-pointer 3)))
350     (elt a 4))
351   type-error)
352  t)
353
354(deftest elt-fill-pointer.7
355   (let ((a (make-array '(5)
356                        :initial-contents '(#\a #\b #\c #\d #\e)
357                        :element-type 'base-char
358                        :fill-pointer 3)))
359     (values (elt a 0) (elt a 1) (elt a 2)))
360   #\a #\b #\c)
361
362(deftest elt-fill-pointer.8
363  (signals-error
364   (let ((a (make-array '(5)
365                        :initial-contents '(#\a #\b #\c #\d #\e)
366                        :element-type 'base-char
367                        :fill-pointer 3)))
368     (elt a 4))
369   type-error)
370  t)
371
372;;; Specialized strings
373
374(deftest elt.special-strings.1
375  (do-special-strings
376   (s "abcde" nil)
377   (assert (char= (elt s 0) #\a))
378   (assert (char= (elt s 3) #\d))
379   (assert (char= (elt s 4) #\e)))
380  nil)
381
382;;; Specialized integer vectors
383
384(deftest elt.special-vectors.1
385  (do-special-integer-vectors
386   (v #(1 1 0 1 0 1) nil)
387   (assert (= (elt v 0) 1))
388   (assert (= (elt v 1) 1))
389   (assert (= (elt v 2) 0))
390   (assert (= (elt v 3) 1))
391   (assert (= (elt v 4) 0))
392   (assert (= (elt v 5) 1)))
393  nil)
394
395(deftest elt.special-vectors.2
396  (do-special-integer-vectors
397   (v #(1 2 0 -1 0 3) nil)
398   (assert (= (elt v 0) 1))
399   (assert (= (elt v 1) 2))
400   (assert (= (elt v 2) 0))
401   (assert (= (elt v 3) -1))
402   (assert (= (elt v 4) 0))
403   (assert (= (elt v 5) 3)))
404  nil)
405
406(deftest elt.special-vectors.3
407  (loop for type in '(short-float single-float long-float double-float)
408        for len = 10
409        for vals = (loop for i from 1 to len collect (coerce i type))
410        for vec = (make-array len :element-type type :initial-contents vals)
411        unless (loop for i below len always (eql (elt vec i)
412                                                 (coerce (1+ i) type)))
413        collect (list type vals vec))
414  nil)
415
416(deftest elt.special-vectors.4
417  (loop for etype in '(short-float single-float long-float double-float
418                                   integer rational)
419        for type = `(complex ,etype)
420        for len = 10
421        for vals = (loop for i from 1 to len collect (complex (coerce i etype)
422                                                              (coerce (- i) etype)))
423        for vec = (make-array len :element-type type :initial-contents vals)
424        unless (loop for i below len always (eql (elt vec i)
425                                                 (elt vals i)))
426        collect (list type vals vec))
427  nil)
428
429
430
431;;; Error tests
432
433(deftest elt.error.1
434  (signals-error (elt) program-error)
435  t)
436
437(deftest elt.error.2
438  (signals-error (elt nil) program-error)
439  t)
440
441(deftest elt.error.3
442  (signals-error (elt nil 0 nil) program-error)
443  t)
444
445(deftest elt.error.4
446  (do-special-integer-vectors
447   (v #(1 1 0 1 0 1) nil)
448   (assert (eql t (eval `(signals-error (elt ,v -1) type-error))))
449   (assert (eql t (eval `(signals-error (elt ,v 6) type-error)))))
450  nil)
451
452(deftest elt.error.5
453  (do-special-strings
454   (s "ABCDEFGH" nil)
455   (assert (eql t (eval `(signals-error (elt ,s -1) type-error))))
456   (assert (eql t (eval `(signals-error (elt ,s 8) type-error)))))
457  nil)
Note: See TracBrowser for help on using the repository browser.