source: trunk/source/tests/ansi-tests/make-sequence.lsp @ 8991

Last change on this file since 8991 was 8991, checked in by gz, 12 years ago

Check in the gcl ansi test suite (original, in preparation for making local changes)

File size: 13.1 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Sep 14 09:58:47 2002
4;;;; Contains: Tests for MAKE-SEQUENCE
5
6(in-package :cl-test)
7
8(deftest make-sequence.1
9  (let ((x (make-sequence 'list 4)))
10    (and (eql (length x) 4)
11         (listp x)
12         #+:ansi-tests-strict-initial-element
13         (loop for e in x always (eql (car x) e))
14         t))
15  t)
16
17(deftest make-sequence.2
18  (make-sequence 'list 4 :initial-element 'a)
19  (a a a a))
20
21(deftest make-sequence.3
22  (let ((x (make-sequence 'cons 4)))
23    (and (eql (length x) 4)
24         (listp x)
25         #+:ansi-tests-strict-initial-element
26         (loop for e in x always (eql (car x) e))
27         t))
28  t)
29
30(deftest make-sequence.4
31  (make-sequence 'cons 4 :initial-element 'a)
32  (a a a a))
33
34(deftest make-sequence.5
35  (make-sequence 'string 10 :initial-element #\a)
36  "aaaaaaaaaa")
37
38(deftest make-sequence.6
39  (let ((s (make-sequence 'string 10)))
40    (and (eql (length s) 10)
41         #+:ansi-tests-strict-initial-element
42         (loop for e across s always (eql e (aref s 0)))
43         t))
44  t)
45
46(deftest make-sequence.7
47  (make-sequence 'simple-string 10 :initial-element #\a)
48  "aaaaaaaaaa")
49
50
51(deftest make-sequence.8
52  (let ((s (make-sequence 'simple-string 10)))
53    (and (eql (length s) 10)
54         #+:ansi-tests-strict-initial-element
55         (loop for e across s always (eql e (aref s 0)))
56         t))
57  t)
58
59(deftest make-sequence.9
60  (make-sequence 'null 0)
61  nil)
62
63(deftest make-sequence.10
64  (let ((x (make-sequence 'vector 10)))
65    (and (eql (length x) 10)
66         #+:ansi-tests-strict-initial-element
67         (loop for e across x always (eql e (aref x 0)))
68         t))
69  t)
70
71(deftest make-sequence.11
72  (let* ((u (list 'a))
73         (x (make-sequence 'vector 10 :initial-element u)))
74    (and (eql (length x) 10)
75         (loop for e across x always (eql e u))
76         t))
77  t)
78
79(deftest make-sequence.12
80  (let ((x (make-sequence 'simple-vector 10)))
81    (and (eql (length x) 10)
82         #+:ansi-tests-strict-initial-element
83         (loop for e across x always (eql e (aref x 0)))
84         t))
85  t)
86
87(deftest make-sequence.13
88  (let* ((u (list 'a))
89         (x (make-sequence 'simple-vector 10 :initial-element u)))
90    (and (eql (length x) 10)
91         (loop for e across x always (eql e u))
92         t))
93  t)
94
95(deftest make-sequence.14
96  (let ((x (make-sequence '(vector *) 10)))
97    (and (eql (length x) 10)
98         #+:ansi-tests-strict-initial-element
99         (loop for e across x always (eql e (aref x 0)))
100         t))
101  t)
102
103(deftest make-sequence.15
104  (let* ((u (list 'a))
105         (x (make-sequence '(vector *) 10 :initial-element u)))
106    (and (eql (length x) 10)
107         (loop for e across x always (eql e u))
108         t))
109  t)
110
111(deftest make-sequence.16
112  (let ((x (make-sequence '(simple-vector *)  10)))
113    (and (eql (length x) 10)
114         #+:ansi-tests-strict-initial-element
115         (loop for e across x always (eql e (aref x 0)))
116         t))
117  t)
118
119(deftest make-sequence.17
120  (let* ((u (list 'a))
121         (x (make-sequence '(simple-vector *) 10 :initial-element u)))
122    (and (eql (length x) 10)
123         (loop for e across x always (eql e u))
124         t))
125  t)
126
127(deftest make-sequence.18
128  (let ((x (make-sequence '(string *) 10)))
129    (and (eql (length x) 10)
130         #+:ansi-tests-strict-initial-element
131         (loop for e across x always (eql e (aref x 0)))
132         t))
133  t)
134
135(deftest make-sequence.19
136  (let* ((u #\a)
137         (x (make-sequence '(string *) 10 :initial-element u)))
138    (and (eql (length x) 10)
139         (loop for e across x always (eql e u))
140         t))
141  t)
142
143(deftest make-sequence.20
144  (let ((x (make-sequence '(simple-string *)  10)))
145    (and (eql (length x) 10)
146         #+:ansi-tests-strict-initial-element
147         (loop for e across x always (eql e (aref x 0)))
148         t))
149  t)
150
151(deftest make-sequence.21
152  (let* ((u #\a)
153         (x (make-sequence '(simple-string *) 10 :initial-element u)))
154    (and (eql (length x) 10)
155         (loop for e across x always (eql e u))
156         t))
157  t)
158
159(deftest make-sequence.22
160  (make-sequence '(vector * 5) 5 :initial-element 'a)
161  #(a a a a a))
162
163(deftest make-sequence.23
164  (make-sequence '(vector fixnum 5) 5 :initial-element 1)
165  #(1 1 1 1 1))
166
167(deftest make-sequence.24
168  (make-sequence '(vector (integer 0 255) 5) 5 :initial-element 17)
169  #(17 17 17 17 17))
170
171(deftest make-sequence.25
172  (make-sequence '(simple-vector 5) 5 :initial-element 'a)
173  #(a a a a a))
174
175#+:ansi-tests-strict-initial-element
176(deftest make-sequence.26
177  (equalp (make-sequence 'string 5) (make-string 5))
178  t)
179
180(deftest make-sequence.27
181  (let ((len 10))
182    (loop for i from 1 to 40
183          for etype = `(unsigned-byte ,i)
184          for type = `(vector ,etype)
185          for vec = (make-sequence type len :initial-element 0)
186          unless (and (typep vec type)
187                      (loop for i below len always (eql (elt vec i) 0)))
188          collect (list i etype type vec)))
189  nil)
190
191(deftest make-sequence.28
192  (let ((len 10))
193    (loop for i from 1 to 40
194          for etype = `(signed-byte ,i)
195          for type = `(vector ,etype)
196          for vec = (make-sequence type len :initial-element 0)
197          unless (and (typep vec type)
198                      (loop for i below len always (eql (elt vec i) 0)))
199          collect (list i etype type vec)))
200  nil)
201
202(deftest make-sequence.29
203  (let ((len 10))
204    (loop for etype in '(short-float single-float double-float long-float)
205          for type = `(vector ,etype)
206          for elem = (coerce 1 etype)
207          for vec = (make-sequence type len :initial-element elem)
208          unless (and (typep vec type)
209                      (loop for i below len always (eql (elt vec i) elem)))
210          collect (list etype type vec)))
211  nil)
212
213(deftest make-sequence.30
214  (let ((len 10))
215    (loop for cetype in '(short-float single-float double-float long-float
216                                      integer rational)
217          for etype = `(complex ,cetype)
218          for type = `(vector ,etype)
219          for elem = (complex (coerce 1 cetype) (coerce -1 cetype))
220          for vec = (make-sequence type len :initial-element elem)
221          unless (and (typep vec type)
222                      (loop for i below len always (eql (elt vec i) elem)))
223          collect (list etype type vec)))
224  nil)
225
226;;; Other type specifiers
227
228(deftest make-sequence.31
229  (make-sequence '(simple-string) 10 :initial-element #\X)
230  "XXXXXXXXXX")
231
232(deftest make-sequence.32
233  (make-sequence '(simple-string 10) 10 :initial-element #\X)
234  "XXXXXXXXXX")
235
236(deftest make-sequence.33
237  (make-sequence '(string) 10 :initial-element #\X)
238  "XXXXXXXXXX")
239
240(deftest make-sequence.34
241  (make-sequence '(vector) 10 :initial-element nil)
242  #(nil nil nil nil nil nil nil nil nil nil))
243
244(deftest make-sequence.35
245  (make-sequence '(simple-vector) 10 :initial-element nil)
246  #(nil nil nil nil nil nil nil nil nil nil))
247
248(deftest make-sequence.36
249  (make-sequence '(vector * *) 10 :initial-element nil)
250  #(nil nil nil nil nil nil nil nil nil nil))
251
252;;; Bit vectors
253
254(deftest make-sequence.37
255  (make-sequence 'bit-vector 5 :initial-element 0)
256  #*00000)
257
258(deftest make-sequence.38
259  (make-sequence 'bit-vector 7 :initial-element 1)
260  #*1111111)
261
262(deftest make-sequence.39
263  (make-sequence 'bit-vector 0)
264  #*)
265
266(deftest make-sequence.40
267  (make-sequence '(bit-vector) 4 :initial-element 1)
268  #*1111)
269
270(deftest make-sequence.41
271  (make-sequence '(bit-vector *) 10 :initial-element 0)
272  #*0000000000)
273
274(deftest make-sequence.42
275  (make-sequence '(bit-vector 5) 5 :initial-element 0)
276  #*00000)
277
278(deftest make-sequence.43
279  (make-sequence 'simple-bit-vector 5 :initial-element 0)
280  #*00000)
281
282(deftest make-sequence.44
283  (make-sequence 'simple-bit-vector 7 :initial-element 1)
284  #*1111111)
285
286(deftest make-sequence.45
287  (make-sequence 'simple-bit-vector 0)
288  #*)
289
290(deftest make-sequence.46
291  (make-sequence '(simple-bit-vector) 4 :initial-element 1)
292  #*1111)
293
294(deftest make-sequence.47
295  (make-sequence '(simple-bit-vector *) 10 :initial-element 0)
296  #*0000000000)
297
298(deftest make-sequence.48
299  (make-sequence '(simple-bit-vector 5) 5 :initial-element 0)
300  #*00000)
301
302(deftest make-sequence.49
303  (if (subtypep (class-of nil) 'sequence)
304      (make-sequence (class-of nil) 0)
305    nil)
306  nil)
307
308(deftest make-sequence.50
309  (if (subtypep (class-of '(nil nil nil)) 'sequence)
310      (make-sequence (class-of '(nil nil nil)) 3 :initial-element nil)
311    '(nil nil nil))
312  (nil nil nil))
313
314(deftest make-sequence.51
315  (loop for i from 1 to 40
316        for vec = (make-array 1 :element-type `(unsigned-byte ,i)
317                              :initial-element 1)
318        for class = (class-of vec)
319        nconc
320        (if (subtypep class 'vector)
321            (let ((vec2 (make-sequence class 1 :initial-element 1)))
322              (unless (equalp vec vec)
323                (list (list i vec class vec2))))
324          nil))
325  nil)
326
327(deftest make-sequence.52
328  (let ((class (class-of "aaaa")))
329    (if (subtypep class 'vector)
330        (make-sequence class 4 :initial-element #\a)
331      "aaaa"))
332  "aaaa")
333
334(deftest make-sequence.53
335  (let ((class (class-of (make-array 4 :element-type 'base-char
336                                     :fill-pointer 4
337                                     :adjustable t
338                                     :initial-contents "aaaa"))))
339    (if (subtypep class 'vector)
340        (make-sequence class 4 :initial-element #\a)
341      "aaaa"))
342  "aaaa")
343
344(deftest make-sequence.54
345  (let ((class (class-of (make-array 4 :element-type 'character
346                                     :fill-pointer 4
347                                     :adjustable t
348                                     :initial-contents "aaaa"))))
349    (if (subtypep class 'vector)
350        (make-sequence class 4 :initial-element #\a)
351      "aaaa"))
352  "aaaa")
353
354(deftest make-sequence.55
355  (let ((class (class-of (make-array 4 :element-type 'character
356                                     :initial-contents "aaaa"))))
357    (if (subtypep class 'vector)
358        (make-sequence class 4 :initial-element #\a)
359      "aaaa"))
360  "aaaa")
361
362(deftest make-sequence.56
363  (loop for i from 1 to 40
364        for vec = (make-array 1 :element-type `(unsigned-byte ,i)
365                              :adjustable t :fill-pointer 1
366                              :initial-element 1)
367        for class = (class-of vec)
368        nconc
369        (if (subtypep class 'vector)
370            (let ((vec2 (make-sequence class 1 :initial-element 1)))
371              (unless (equalp vec vec)
372                (list (list i vec class vec2))))
373          nil))
374  nil)
375
376(deftest make-sequence.57
377  (make-sequence (find-class 'list) 4 :initial-element 'x)
378  (x x x x))
379
380(deftest make-sequence.58
381  (make-sequence (find-class 'cons) 4 :initial-element 'x)
382  (x x x x))
383
384;;; Keyword tests
385
386(deftest make-sequence.allow-other-keys.1
387  (make-sequence 'list 5 :allow-other-keys t :initial-element 'a :bad t)
388  (a a a a a))
389
390(deftest make-sequence.allow-other-keys.2
391  (make-sequence 'list 5 :initial-element 'a :bad t :allow-other-keys t)
392  (a a a a a))
393
394(deftest make-sequence.allow-other-keys.3
395  (make-sequence 'list 5 :initial-element 'a :allow-other-keys t)
396  (a a a a a))
397
398(deftest make-sequence.allow-other-keys.4
399  (make-sequence 'list 5 :initial-element 'a :allow-other-keys nil)
400  (a a a a a))
401
402(deftest make-sequence.allow-other-keys.5
403  (make-sequence 'list 5 :initial-element 'a :allow-other-keys t
404                 :allow-other-keys nil :bad t)
405  (a a a a a))
406
407(deftest make-sequence.keywords.6
408  (make-sequence 'list 5 :initial-element 'a :initial-element 'b)
409  (a a a a a))
410
411;;; Tests for errors
412
413(deftest make-sequence.error.1
414  (signals-error-always (make-sequence 'symbol 10) type-error)
415  t t)
416
417(deftest make-sequence.error.2
418  (signals-error (make-sequence 'null 1) type-error)
419  t)
420
421(deftest make-sequence.error.3
422  (signals-error (make-sequence '(vector * 4) 3) type-error)
423  t)
424
425(deftest make-sequence.error.4
426  (signals-error (make-sequence '(vector * 2) 3) type-error)
427  t)
428
429(deftest make-sequence.error.5
430  (signals-error (make-sequence '(string 4) 3) type-error)
431  t)
432
433(deftest make-sequence.error.6
434  (signals-error (make-sequence '(simple-string 2) 3) type-error)
435  t)
436
437(deftest make-sequence.error.7
438  (signals-error (make-sequence 'cons 0) type-error)
439  t)
440
441(deftest make-sequence.error.8
442  (signals-error (make-sequence) program-error)
443  t)
444
445(deftest make-sequence.error.9
446  (signals-error (make-sequence 'list) program-error)
447  t)
448
449(deftest make-sequence.error.10
450  (signals-error (make-sequence 'list 10 :bad t) program-error)
451  t)
452
453(deftest make-sequence.error.11
454  (signals-error (make-sequence 'list 10 :bad t :allow-other-keys nil)
455                 program-error)
456  t)
457
458(deftest make-sequence.error.12
459  (signals-error (make-sequence 'list 10 :initial-element)
460                 program-error)
461  t)
462
463(deftest make-sequence.error.13
464  (signals-error (make-sequence 'list 10 0 0) program-error)
465  t)
466
467(deftest make-sequence.error.14
468  (signals-error-always (locally (make-sequence 'symbol 10) t)
469                        type-error)
470  t t)
471
472(deftest make-sequence.error.15
473  :notes (:result-type-element-type-by-subtype)
474  (if (subtypep '(or (vector bit) (vector t)) 'vector)
475      (signals-error (make-sequence '(or (vector bit) (vector t)) 10 :initial-element 0) error)
476    t)
477  t)
478
479(deftest make-sequence.error.16
480  (signals-error-always (make-sequence (find-class 'integer) 0) type-error)
481  t t) 
482
483;;; Order of execution tests
484
485(deftest make-sequence.order.1
486  (let ((i 0) a b c)
487    (values
488     (make-sequence (progn (setf a (incf i)) 'list)
489                    (progn (setf b (incf i)) 5)
490                    :initial-element (progn (setf c (incf i)) 'a))
491     i a b c))
492  (a a a a a) 3 1 2 3)
493
494(deftest make-sequence.order.2
495  (let ((i 0) a b c d e)
496    (values
497     (make-sequence (progn (setf a (incf i)) 'list)
498                    (progn (setf b (incf i)) 5)
499                    :allow-other-keys (setf c (incf i))
500                    :initial-element (progn (setf d (incf i)) 'a)
501                    :foo (setf e (incf i)))
502     i a b c d e))
503  (a a a a a) 5 1 2 3 4 5)
504
505;;; Const fold tests
506
507(def-fold-test make-sequence.fold.1
508  (make-sequence 'list 5 :initial-element 'a))
509(def-fold-test make-sequence.fold.2
510  (make-sequence 'vector 5 :initial-element 'a))
511(def-fold-test make-sequence.fold.3
512  (make-sequence 'bit-vector 5 :initial-element 0))
513(def-fold-test make-sequence.fold.4
514  (make-sequence 'string 5 :initial-element #\a))
515
516;;; FIXME: Add tests for upgrading of character subtypes
Note: See TracBrowser for help on using the repository browser.