← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ansi-tests/make-sequence.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:
ansi-tests/make-sequence.lsp
 
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
;;; Keyword tests
 
181
 
 
182
(deftest make-sequence.allow-other-keys.1
 
183
  (make-sequence 'list 5 :allow-other-keys t :initial-element 'a :bad t)
 
184
  (a a a a a))
 
185
 
 
186
(deftest make-sequence.allow-other-keys.2
 
187
  (make-sequence 'list 5 :initial-element 'a :bad t :allow-other-keys t)
 
188
  (a a a a a))
 
189
 
 
190
(deftest make-sequence.allow-other-keys.3
 
191
  (make-sequence 'list 5 :initial-element 'a :allow-other-keys t)
 
192
  (a a a a a))
 
193
 
 
194
(deftest make-sequence.allow-other-keys.4
 
195
  (make-sequence 'list 5 :initial-element 'a :allow-other-keys nil)
 
196
  (a a a a a))
 
197
 
 
198
(deftest make-sequence.allow-other-keys.5
 
199
  (make-sequence 'list 5 :initial-element 'a :allow-other-keys t
 
200
                 :allow-other-keys nil :bad t)
 
201
  (a a a a a))
 
202
 
 
203
(deftest make-sequence.keywords.6
 
204
  (make-sequence 'list 5 :initial-element 'a :initial-element 'b)
 
205
  (a a a a a))
 
206
 
 
207
;;; Tests for errors
 
208
 
 
209
(deftest make-sequence.error.1
 
210
  (signals-error (make-sequence 'symbol 10) type-error)
 
211
  t)
 
212
 
 
213
(deftest make-sequence.error.2
 
214
  (signals-error (make-sequence 'null 1) type-error)
 
215
  t)
 
216
 
 
217
(deftest make-sequence.error.3
 
218
  (signals-error (make-sequence '(vector * 4) 3) type-error)
 
219
  t)
 
220
 
 
221
(deftest make-sequence.error.4
 
222
  (signals-error (make-sequence '(vector * 2) 3) type-error)
 
223
  t)
 
224
 
 
225
(deftest make-sequence.error.5
 
226
  (signals-error (make-sequence '(string 4) 3) type-error)
 
227
  t)
 
228
 
 
229
(deftest make-sequence.error.6
 
230
  (signals-error (make-sequence '(simple-string 2) 3) type-error)
 
231
  t)
 
232
 
 
233
(deftest make-sequence.error.7
 
234
  (signals-error (make-sequence 'cons 0) type-error)
 
235
  t)
 
236
 
 
237
(deftest make-sequence.error.8
 
238
  (signals-error (make-sequence) program-error)
 
239
  t)
 
240
 
 
241
(deftest make-sequence.error.9
 
242
  (signals-error (make-sequence 'list) program-error)
 
243
  t)
 
244
 
 
245
(deftest make-sequence.error.10
 
246
  (signals-error (make-sequence 'list 10 :bad t) program-error)
 
247
  t)
 
248
 
 
249
(deftest make-sequence.error.11
 
250
  (signals-error (make-sequence 'list 10 :bad t :allow-other-keys nil)
 
251
                 program-error)
 
252
  t)
 
253
 
 
254
(deftest make-sequence.error.12
 
255
  (signals-error (make-sequence 'list 10 :initial-element)
 
256
                 program-error)
 
257
  t)
 
258
 
 
259
(deftest make-sequence.error.13
 
260
  (signals-error (make-sequence 'list 10 0 0) program-error)
 
261
  t)
 
262
 
 
263
(deftest make-sequence.error.14
 
264
  (signals-error (locally (make-sequence 'symbol 10) t)
 
265
                 type-error)
 
266
  t)
 
267
 
 
268
;;; Order of execution tests
 
269
 
 
270
(deftest make-sequence.order.1
 
271
  (let ((i 0) a b c)
 
272
    (values
 
273
     (make-sequence (progn (setf a (incf i)) 'list)
 
274
                    (progn (setf b (incf i)) 5)
 
275
                    :initial-element (progn (setf c (incf i)) 'a))
 
276
     i a b c))
 
277
  (a a a a a) 3 1 2 3)
 
278
 
 
279
(deftest make-sequence.order.2
 
280
  (let ((i 0) a b c d e)
 
281
    (values
 
282
     (make-sequence (progn (setf a (incf i)) 'list)
 
283
                    (progn (setf b (incf i)) 5)
 
284
                    :allow-other-keys (setf c (incf i))
 
285
                    :initial-element (progn (setf d (incf i)) 'a)
 
286
                    :foo (setf e (incf i)))
 
287
     i a b c d e))
 
288
  (a a a a a) 5 1 2 3 4 5)