← Back to branch summary

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

« back to all changes in this revision

Viewing changes to ansi-tests/position-if-not.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/position-if-not.lsp
 
1
;-*- Mode:     Lisp -*-
 
2
;;;; Author:   Paul Dietz
 
3
;;;; Created:  Sat Aug 24 07:10:05 2002
 
4
;;;; Contains: Tests for POSITION-IF-NOT-NOT
 
5
 
 
6
(in-package :cl-test)
 
7
 
 
8
(deftest position-if-not-list.1
 
9
  (position-if-not #'oddp '(1 3 1 4 3 2 1 8 9))
 
10
  3)
 
11
 
 
12
(deftest position-if-not-list.2
 
13
  (position-if-not 'oddp '(1 3 1 4 3 2 1 8 9))
 
14
  3)
 
15
 
 
16
(deftest position-if-not-list.3
 
17
  (position-if-not #'oddp '(1 3 1 4 3 2 1 8 9) :start 4)
 
18
  5)
 
19
 
 
20
(deftest position-if-not-list.4
 
21
  (position-if-not #'oddp '(1 3 1 4 3 2 1 8 9) :from-end t)
 
22
  7)
 
23
 
 
24
(deftest position-if-not-list.5
 
25
  (position-if-not #'oddp '(1 3 1 4 3 2 1 8 9) :from-end nil)
 
26
  3)
 
27
 
 
28
(deftest position-if-not-list.6
 
29
  (position-if-not #'oddp '(1 3 1 4 3 2 1 8 9) :start 4
 
30
               :from-end t)
 
31
  7)
 
32
 
 
33
(deftest position-if-not-list.7
 
34
  (position-if-not #'oddp '(1 3 1 4 3 2 1 8 9) :end nil)
 
35
  3)
 
36
 
 
37
(deftest position-if-not-list.8
 
38
  (position-if-not #'oddp '(1 3 1 4 3 2 1 8 9) :end 3)
 
39
  nil)
 
40
 
 
41
(deftest position-if-not-list.9
 
42
  (loop for i from 0 to 8
 
43
        collect
 
44
        (loop for j from (1+ i) to 9
 
45
              collect
 
46
              (position-if-not #'oddp '(1 3 1 4 3 2 1 8 9) :start i :end j)))
 
47
  ((nil nil nil 3 3 3 3 3 3)
 
48
   (nil nil 3 3 3 3 3 3)
 
49
   (nil 3 3 3 3 3 3)
 
50
   (3 3 3 3 3 3)
 
51
   (nil 5 5 5 5)
 
52
   (5 5 5 5)
 
53
   (nil 7 7)
 
54
   (7 7)
 
55
   (nil)))
 
56
 
 
57
(deftest position-if-not-list.10
 
58
  (loop for i from 0 to 8
 
59
        collect
 
60
        (loop for j from (1+ i) to 9
 
61
              collect
 
62
              (position-if-not #'oddp '(1 3 1 4 3 2 1 8 9) :start i :end j
 
63
                           :from-end t)))
 
64
  ((nil nil nil 3 3 5 5 7 7)
 
65
   (nil nil 3 3 5 5 7 7)
 
66
   (nil 3 3 5 5 7 7)
 
67
   (3 3 5 5 7 7)
 
68
   (nil 5 5 7 7)
 
69
   (5 5 7 7)
 
70
   (nil 7 7)
 
71
   (7 7)
 
72
   (nil)))
 
73
 
 
74
(deftest position-if-not-list.11
 
75
  (loop for i from 0 to 8
 
76
        collect
 
77
        (loop for j from (1+ i) to 9
 
78
              collect
 
79
              (position-if-not #'evenp '(1 3 1 4 3 2 1 8 9) :start i :end j
 
80
                           :key '1+)))
 
81
  ((nil nil nil 3 3 3 3 3 3)
 
82
   (nil nil 3 3 3 3 3 3)
 
83
   (nil 3 3 3 3 3 3)
 
84
   (3 3 3 3 3 3)
 
85
   (nil 5 5 5 5)
 
86
   (5 5 5 5)
 
87
   (nil 7 7)
 
88
   (7 7)
 
89
   (nil)))
 
90
 
 
91
(deftest position-if-not-list.12
 
92
  (loop for i from 0 to 8
 
93
        collect
 
94
        (loop for j from (1+ i) to 9
 
95
              collect
 
96
              (position-if-not #'evenp '(1 3 1 4 3 2 1 8 9) :start i :end j
 
97
                           :key #'1+ :from-end t)))
 
98
  ((nil nil nil 3 3 5 5 7 7)
 
99
   (nil nil 3 3 5 5 7 7)
 
100
   (nil 3 3 5 5 7 7)
 
101
   (3 3 5 5 7 7)
 
102
   (nil 5 5 7 7)
 
103
   (5 5 7 7)
 
104
   (nil 7 7)
 
105
   (7 7)
 
106
   (nil)))
 
107
 
 
108
;;; Vector tests
 
109
 
 
110
(deftest position-if-not-vector.1
 
111
  (position-if-not #'oddp #(1 3 1 4 3 2 1 8 9))
 
112
  3)
 
113
 
 
114
(deftest position-if-not-vector.2
 
115
  (position-if-not 'oddp #(1 3 1 4 3 2 1 8 9))
 
116
  3)
 
117
 
 
118
(deftest position-if-not-vector.3
 
119
  (position-if-not #'oddp #(1 3 1 4 3 2 1 8 9) :start 4)
 
120
  5)
 
121
 
 
122
(deftest position-if-not-vector.4
 
123
  (position-if-not #'oddp #(1 3 1 4 3 2 1 8 9) :from-end t)
 
124
  7)
 
125
 
 
126
(deftest position-if-not-vector.5
 
127
  (position-if-not #'oddp #(1 3 1 4 3 2 1 8 9) :from-end nil)
 
128
  3)
 
129
 
 
130
(deftest position-if-not-vector.6
 
131
  (position-if-not #'oddp #(1 3 1 4 3 2 1 8 9) :start 4
 
132
               :from-end t)
 
133
  7)
 
134
 
 
135
(deftest position-if-not-vector.7
 
136
  (position-if-not #'oddp #(1 3 1 4 3 2 1 8 9) :end nil)
 
137
  3)
 
138
 
 
139
(deftest position-if-not-vector.8
 
140
  (position-if-not #'oddp #(1 3 1 4 3 2 1 8 9) :end 3)
 
141
  nil)
 
142
 
 
143
(deftest position-if-not-vector.9
 
144
  (loop for i from 0 to 8
 
145
        collect
 
146
        (loop for j from (1+ i) to 9
 
147
              collect
 
148
              (position-if-not #'oddp #(1 3 1 4 3 2 1 8 9) :start i :end j)))
 
149
  ((nil nil nil 3 3 3 3 3 3)
 
150
   (nil nil 3 3 3 3 3 3)
 
151
   (nil 3 3 3 3 3 3)
 
152
   (3 3 3 3 3 3)
 
153
   (nil 5 5 5 5)
 
154
   (5 5 5 5)
 
155
   (nil 7 7)
 
156
   (7 7)
 
157
   (nil)))
 
158
 
 
159
(deftest position-if-not-vector.10
 
160
  (loop for i from 0 to 8
 
161
        collect
 
162
        (loop for j from (1+ i) to 9
 
163
              collect
 
164
              (position-if-not #'oddp #(1 3 1 4 3 2 1 8 9) :start i :end j
 
165
                           :from-end t)))
 
166
  ((nil nil nil 3 3 5 5 7 7)
 
167
   (nil nil 3 3 5 5 7 7)
 
168
   (nil 3 3 5 5 7 7)
 
169
   (3 3 5 5 7 7)
 
170
   (nil 5 5 7 7)
 
171
   (5 5 7 7)
 
172
   (nil 7 7)
 
173
   (7 7)
 
174
   (nil)))
 
175
 
 
176
(deftest position-if-not-vector.11
 
177
  (loop for i from 0 to 8
 
178
        collect
 
179
        (loop for j from (1+ i) to 9
 
180
              collect
 
181
              (position-if-not #'evenp #(1 3 1 4 3 2 1 8 9) :start i :end j
 
182
                           :key '1+)))
 
183
  ((nil nil nil 3 3 3 3 3 3)
 
184
   (nil nil 3 3 3 3 3 3)
 
185
   (nil 3 3 3 3 3 3)
 
186
   (3 3 3 3 3 3)
 
187
   (nil 5 5 5 5)
 
188
   (5 5 5 5)
 
189
   (nil 7 7)
 
190
   (7 7)
 
191
   (nil)))
 
192
 
 
193
(deftest position-if-not-vector.12
 
194
  (loop for i from 0 to 8
 
195
        collect
 
196
        (loop for j from (1+ i) to 9
 
197
              collect
 
198
              (position-if-not #'evenp #(1 3 1 4 3 2 1 8 9) :start i :end j
 
199
                           :key #'1+ :from-end t)))
 
200
  ((nil nil nil 3 3 5 5 7 7)
 
201
   (nil nil 3 3 5 5 7 7)
 
202
   (nil 3 3 5 5 7 7)
 
203
   (3 3 5 5 7 7)
 
204
   (nil 5 5 7 7)
 
205
   (5 5 7 7)
 
206
   (nil 7 7)
 
207
   (7 7)
 
208
   (nil)))
 
209
 
 
210
(deftest position-if-not-vector.13
 
211
  (let ((a (make-array '(10) :initial-contents '(1 2 3 4 5 a b c d e)
 
212
                       :fill-pointer 5)))
 
213
    (values
 
214
     (position-if-not #'numberp a)
 
215
     (position-if-not #'symbolp a)
 
216
     (position-if-not #'numberp a :from-end t)
 
217
     (position-if-not #'symbolp a :from-end t)))
 
218
  nil 0 nil 4)
 
219
 
 
220
;;; Bit vector tests
 
221
 
 
222
(deftest position-if-not-bit-vector.1
 
223
  (position-if-not #'oddp #*111010101)
 
224
  3)
 
225
 
 
226
(deftest position-if-not-bit-vector.2
 
227
  (position-if-not 'oddp #*111010101)
 
228
  3)
 
229
 
 
230
(deftest position-if-not-bit-vector.3
 
231
  (position-if-not #'oddp #*111010101 :start 4)
 
232
  5)
 
233
 
 
234
(deftest position-if-not-bit-vector.4
 
235
  (position-if-not #'oddp #*111010101 :from-end t)
 
236
  7)
 
237
 
 
238
(deftest position-if-not-bit-vector.5
 
239
  (position-if-not #'oddp #*111010101 :from-end nil)
 
240
  3)
 
241
 
 
242
(deftest position-if-not-bit-vector.6
 
243
  (position-if-not #'oddp #*111010101 :start 4
 
244
               :from-end t)
 
245
  7)
 
246
 
 
247
(deftest position-if-not-bit-vector.7
 
248
  (position-if-not #'oddp #*111010101 :end nil)
 
249
  3)
 
250
 
 
251
(deftest position-if-not-bit-vector.8
 
252
  (position-if-not #'oddp #*111010101 :end 3)
 
253
  nil)
 
254
 
 
255
(deftest position-if-not-bit-vector.9
 
256
  (loop for i from 0 to 8
 
257
        collect
 
258
        (loop for j from (1+ i) to 9
 
259
              collect
 
260
              (position-if-not #'oddp #*111010101 :start i :end j)))
 
261
  ((nil nil nil 3 3 3 3 3 3)
 
262
   (nil nil 3 3 3 3 3 3)
 
263
   (nil 3 3 3 3 3 3)
 
264
   (3 3 3 3 3 3)
 
265
   (nil 5 5 5 5)
 
266
   (5 5 5 5)
 
267
   (nil 7 7)
 
268
   (7 7)
 
269
   (nil)))
 
270
 
 
271
(deftest position-if-not-bit-vector.10
 
272
  (loop for i from 0 to 8
 
273
        collect
 
274
        (loop for j from (1+ i) to 9
 
275
              collect
 
276
              (position-if-not #'oddp #*111010101 :start i :end j
 
277
                           :from-end t)))
 
278
  ((nil nil nil 3 3 5 5 7 7)
 
279
   (nil nil 3 3 5 5 7 7)
 
280
   (nil 3 3 5 5 7 7)
 
281
   (3 3 5 5 7 7)
 
282
   (nil 5 5 7 7)
 
283
   (5 5 7 7)
 
284
   (nil 7 7)
 
285
   (7 7)
 
286
   (nil)))
 
287
 
 
288
(deftest position-if-not-bit-vector.11
 
289
  (loop for i from 0 to 8
 
290
        collect
 
291
        (loop for j from (1+ i) to 9
 
292
              collect
 
293
              (position-if-not #'evenp #*111010101 :start i :end j
 
294
                           :key #'1+)))
 
295
  ((nil nil nil 3 3 3 3 3 3)
 
296
   (nil nil 3 3 3 3 3 3)
 
297
   (nil 3 3 3 3 3 3)
 
298
   (3 3 3 3 3 3)
 
299
   (nil 5 5 5 5)
 
300
   (5 5 5 5)
 
301
   (nil 7 7)
 
302
   (7 7)
 
303
   (nil)))
 
304
 
 
305
(deftest position-if-not-bit-vector.12
 
306
  (loop for i from 0 to 8
 
307
        collect
 
308
        (loop for j from (1+ i) to 9
 
309
              collect
 
310
              (position-if-not #'evenp #*111010101 :start i :end j
 
311
                           :key '1+ :from-end t)))
 
312
  ((nil nil nil 3 3 5 5 7 7)
 
313
   (nil nil 3 3 5 5 7 7)
 
314
   (nil 3 3 5 5 7 7)
 
315
   (3 3 5 5 7 7)
 
316
   (nil 5 5 7 7)
 
317
   (5 5 7 7)
 
318
   (nil 7 7)
 
319
   (7 7)
 
320
   (nil)))
 
321
 
 
322
(deftest position-if-not-bit-vector.13
 
323
  (let ((a (make-array '(10) :initial-contents '(1 1 1 1 1 0 0 0 0 0)
 
324
                       :fill-pointer 5
 
325
                       :element-type 'bit)))
 
326
    (values
 
327
     (position-if-not #'zerop a)
 
328
     (position-if-not (complement #'zerop) a)
 
329
     (position-if-not #'zerop a :from-end t)
 
330
     (position-if-not (complement #'zerop) a :from-end t)))
 
331
  0 nil 4 nil)  
 
332
 
 
333
;;; string tests
 
334
 
 
335
(deftest position-if-not-string.1
 
336
  (position-if-not #'odddigitp "131432189")
 
337
  3)
 
338
 
 
339
(deftest position-if-not-string.2
 
340
  (position-if-not 'odddigitp "131432189")
 
341
  3)
 
342
 
 
343
(deftest position-if-not-string.3
 
344
  (position-if-not #'odddigitp "131432189" :start 4)
 
345
  5)
 
346
 
 
347
(deftest position-if-not-string.4
 
348
  (position-if-not #'odddigitp "131432189" :from-end t)
 
349
  7)
 
350
 
 
351
(deftest position-if-not-string.5
 
352
  (position-if-not #'odddigitp "131432189" :from-end nil)
 
353
  3)
 
354
 
 
355
(deftest position-if-not-string.6
 
356
  (position-if-not #'odddigitp "131432189" :start 4
 
357
               :from-end t)
 
358
  7)
 
359
 
 
360
(deftest position-if-not-string.7
 
361
  (position-if-not #'odddigitp "131432189" :end nil)
 
362
  3)
 
363
 
 
364
(deftest position-if-not-string.8
 
365
  (position-if-not #'odddigitp "131432189" :end 3)
 
366
  nil)
 
367
 
 
368
(deftest position-if-not-string.9
 
369
  (loop for i from 0 to 8
 
370
        collect
 
371
        (loop for j from (1+ i) to 9
 
372
              collect
 
373
              (position-if-not #'odddigitp "131432189" :start i :end j)))
 
374
  ((nil nil nil 3 3 3 3 3 3)
 
375
   (nil nil 3 3 3 3 3 3)
 
376
   (nil 3 3 3 3 3 3)
 
377
   (3 3 3 3 3 3)
 
378
   (nil 5 5 5 5)
 
379
   (5 5 5 5)
 
380
   (nil 7 7)
 
381
   (7 7)
 
382
   (nil)))
 
383
 
 
384
(deftest position-if-not-string.10
 
385
  (loop for i from 0 to 8
 
386
        collect
 
387
        (loop for j from (1+ i) to 9
 
388
              collect
 
389
              (position-if-not #'odddigitp "131432189" :start i :end j
 
390
                           :from-end t)))
 
391
  ((nil nil nil 3 3 5 5 7 7)
 
392
   (nil nil 3 3 5 5 7 7)
 
393
   (nil 3 3 5 5 7 7)
 
394
   (3 3 5 5 7 7)
 
395
   (nil 5 5 7 7)
 
396
   (5 5 7 7)
 
397
   (nil 7 7)
 
398
   (7 7)
 
399
   (nil)))
 
400
 
 
401
(deftest position-if-not-string.11
 
402
  (loop for i from 0 to 8
 
403
        collect
 
404
        (loop for j from (1+ i) to 9
 
405
              collect
 
406
              (position-if-not #'evendigitp "131432183" :start i :end j
 
407
                           :key #'nextdigit)))
 
408
  ((nil nil nil 3 3 3 3 3 3)
 
409
   (nil nil 3 3 3 3 3 3)
 
410
   (nil 3 3 3 3 3 3)
 
411
   (3 3 3 3 3 3)
 
412
   (nil 5 5 5 5)
 
413
   (5 5 5 5)
 
414
   (nil 7 7)
 
415
   (7 7)
 
416
   (nil)))
 
417
 
 
418
(deftest position-if-not-string.12
 
419
  (loop for i from 0 to 8
 
420
        collect
 
421
        (loop for j from (1+ i) to 9
 
422
              collect
 
423
              (position-if-not #'evendigitp "131432183" :start i :end j
 
424
                           :key 'nextdigit :from-end t)))
 
425
  ((nil nil nil 3 3 5 5 7 7)
 
426
   (nil nil 3 3 5 5 7 7)
 
427
   (nil 3 3 5 5 7 7)
 
428
   (3 3 5 5 7 7)
 
429
   (nil 5 5 7 7)
 
430
   (5 5 7 7)
 
431
   (nil 7 7)
 
432
   (7 7)
 
433
   (nil)))
 
434
 
 
435
(deftest position-if-not-string.13
 
436
  (let ((a (make-array '(10) :initial-contents "55555aaaaa"
 
437
                       :fill-pointer 5
 
438
                       :element-type 'character)))
 
439
    (and (stringp a)
 
440
         (values
 
441
          (position-if-not #'digit-char-p a)
 
442
          (position-if-not (complement #'digit-char-p) a)
 
443
          (position-if-not #'digit-char-p a :from-end t)
 
444
          (position-if-not (complement #'digit-char-p) a :from-end t))))
 
445
  nil 0 nil 4)
 
446
 
 
447
(deftest position-if-not.order.1
 
448
  (let ((i 0) a b c d e f)
 
449
    (values
 
450
     (position-if-not
 
451
      (progn (setf a (incf i)) (complement #'zerop))
 
452
      (progn (setf b (incf i)) '(3 1 8 2 1 2 3 4))
 
453
      :from-end (setf c (incf i))
 
454
      :start (progn (setf d (incf i)) 1)
 
455
      :end (progn (setf e (incf i)) 6)
 
456
      :key (progn (setf f (incf i)) #'1-))
 
457
     i a b c d e f))
 
458
  4 6 1 2 3 4 5 6)
 
459
 
 
460
(deftest position-if-not.order.2
 
461
  (let ((i 0) a b c d e f)
 
462
    (values
 
463
     (position-if-not
 
464
      (progn (setf a (incf i)) (complement #'zerop))
 
465
      (progn (setf b (incf i)) '(3 1 8 2 1 2 3 4))
 
466
      :key (progn (setf c (incf i)) #'1-)
 
467
      :end (progn (setf d (incf i)) 6)
 
468
      :start (progn (setf e (incf i)) 1)
 
469
      :from-end (setf f (incf i)))
 
470
     i a b c d e f))
 
471
  4 6 1 2 3 4 5 6)
 
472
 
 
473
;;; Keyword tests
 
474
 
 
475
(deftest position-if-not.allow-other-keys.1
 
476
  (position-if-not #'zerop '(0 0 3 2 0 1) :allow-other-keys t)
 
477
  2)
 
478
 
 
479
(deftest position-if-not.allow-other-keys.2
 
480
  (position-if-not #'zerop '(0 0 3 2 0 1) :allow-other-keys nil)
 
481
  2)
 
482
 
 
483
(deftest position-if-not.allow-other-keys.3
 
484
  (position-if-not #'zerop '(0 0 1 2 3 0) :allow-other-keys t :bad t)
 
485
  2)
 
486
 
 
487
(deftest position-if-not.allow-other-keys.4
 
488
  (position-if-not #'zerop '(0 0 1 2 3 0) :bad t :allow-other-keys t)
 
489
  2)
 
490
 
 
491
(deftest position-if-not.allow-other-keys.5
 
492
  (position-if-not #'zerop '(0 0 1 2 3 0) :bad t :allow-other-keys t :key #'1-)
 
493
  0)
 
494
 
 
495
(deftest position-if-not.keywords.6
 
496
  (position-if-not #'zerop '(0 0 1 2 3 0) :key #'1- :key #'identity)
 
497
  0)
 
498
 
 
499
(deftest position-if-not.allow-other-keys.7
 
500
  (position-if-not #'zerop '(0 0 1 2 3 0) :bad t :allow-other-keys t
 
501
               :allow-other-keys nil)
 
502
  2)
 
503
 
 
504
(deftest position-if-not.allow-other-keys.8
 
505
  (position-if-not #'zerop '(0 0 1 2 3 0) :allow-other-keys t :bad t
 
506
               :allow-other-keys nil)
 
507
  2)
 
508
 
 
509
(deftest position-if-not.allow-other-keys.9
 
510
  (position-if-not #'zerop '(0 0 1 2 3 0) :allow-other-keys t
 
511
               :allow-other-keys nil :bad t)
 
512
  2)
 
513
 
 
514
 
 
515
;;; Error tests
 
516
 
 
517
(deftest position-if-not.error.1
 
518
  (signals-error (position-if-not #'identity 'b) type-error)
 
519
  t)
 
520
 
 
521
(deftest position-if-not.error.2
 
522
  (signals-error (position-if-not #'identity 10) type-error)
 
523
  t)
 
524
 
 
525
(deftest position-if-not.error.3
 
526
  (signals-error (position-if-not 'null 1.4) type-error)
 
527
  t)
 
528
 
 
529
(deftest position-if-not.error.4
 
530
  (signals-error (position-if-not 'identity '(a b c . d)) type-error)
 
531
  t)
 
532
 
 
533
(deftest position-if-not.error.5
 
534
  (signals-error (position-if-not) program-error)
 
535
  t)
 
536
 
 
537
(deftest position-if-not.error.6
 
538
  (signals-error (position-if-not #'null) program-error)
 
539
  t)
 
540
 
 
541
(deftest position-if-not.error.7
 
542
  (signals-error (position-if-not #'null nil :key) program-error)
 
543
  t)
 
544
 
 
545
(deftest position-if-not.error.8
 
546
  (signals-error (position-if-not #'null nil 'bad t) program-error)
 
547
  t)
 
548
 
 
549
(deftest position-if-not.error.9
 
550
  (signals-error (position-if-not #'null nil 'bad t :allow-other-keys nil) program-error)
 
551
  t)
 
552
 
 
553
(deftest position-if-not.error.10
 
554
  (signals-error (position-if-not #'null nil 1 2) program-error)
 
555
  t)
 
556
 
 
557
(deftest position-if-not.error.11
 
558
  (signals-error (locally (position-if-not #'identity 'b) t) type-error)
 
559
  t)
 
560
 
 
561
(deftest position-if-not.error.12
 
562
  (signals-error (position-if-not #'cons '(a b c d)) program-error)
 
563
  t)
 
564
 
 
565
(deftest position-if-not.error.13
 
566
  (signals-error (position-if-not #'car '(a b c d)) type-error)
 
567
  t)
 
568
 
 
569
(deftest position-if-not.error.14
 
570
  (signals-error (position-if-not #'identity '(a b c d) :key #'cdr) type-error)
 
571
  t)
 
572
 
 
573
(deftest position-if-not.error.15
 
574
  (signals-error (position-if-not #'identity '(a b c d) :key #'cons) program-error)
 
575
  t)