source: trunk/tests/ansi-tests/cxr.lsp @ 9045

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

Assorted cleanup:

In infrastructure:

  • add *test-verbose* and :verbose argument to do-test and do-tests. Avoid random output if false, only show failures
  • muffle-wawrnings and/or bind *suppress-compiler-warnings* in some tests that unavoidably generate them (mainly with duplicate typecase/case clauses)
  • Add record-source-file for tests so meta-. can find them
  • If *catch-errors* (or the :catch-errors arg) is :break, enter a breakloop when catch an error
  • Make test fns created by *compile-tests* have names, so can find them in backtraces
  • fix misc compiler warnings
  • Fixed cases of duplicate test numbers
  • Disable note :make-condition-with-compound-name for openmcl.

In tests themselves:

I commented out the following tests with #+bogus-test, because they just seemed wrong to me:

lambda.47
lambda.50
upgraded-array-element-type.8
upgraded-array-element-type.nil.1
pathname-match-p.5
load.17
load.18
macrolet.47
ctypecase.15

In addition, I commented out the following tests with #+bogus-test because I was too lazy to make a note
for "doesn't signal underflow":

exp.error.8 exp.error.9 exp.error.10 exp.error.11 expt.error.8 expt.error.9 expt.error.10 expt.error.11

Finally, I entered bug reports in trac, and then commented out the tests
below with #+known-bug-NNN, where nnn is the ticket number in trac:

ticket#268: encode-universal-time.3 encode-universal-time.3.1
ticket#269: macrolet.36
ticket#270: values.20 values.21
ticket#271: defclass.error.13 defclass.error.22
ticket#272: phase.10 phase.12 asin.5 asin.6 asin.8
ticket#273: phase.18 phase.19 acos.8
ticket#274: exp.error.4 exp.error.5 exp.error.6 exp.error.7
ticket#275: car.error.2 cdr.error.2
ticket#276: map.error.11
ticket#277: subtypep.cons.43
ticket#278: subtypep-function.3
ticket#279: subtypep-complex.8
ticket#280: open.output.19 open.io.19 file-position.8 file-length.4 file-length.5 read-byte.4 stream-element-type.2 stream-element-type.3
ticket#281: open.65
ticket#288: set-syntax-from-char.sharp.1

File size: 10.9 KB
Line 
1;-*- Mode:     Lisp -*-
2;;;; Author:   Paul Dietz
3;;;; Created:  Sat Apr 19 21:28:38 2003
4;;;; Contains: Tests of C*R functions
5
6(in-package :cl-test)
7
8(compile-and-load "cons-aux.lsp")
9
10;; Tests of car, cdr and compound forms
11(deftest cons.23
12  (car '(a))
13  a)
14
15(deftest cons.24
16  (cdr '(a . b))
17  b)
18
19(deftest cons.25
20  (caar '((a)))
21  a)
22
23(deftest cons.26
24  (cdar '((a . b)))
25  b)
26
27(deftest cons.27
28  (cadr '(a b))
29  b)
30
31(deftest cons.28
32  (cddr '(a b . c))
33  c)
34
35(deftest cons.29
36  (caaar '(((a))))
37  a)
38
39(deftest cons.30
40  (cdaar '(((a . b))))
41  b)
42
43(deftest cons.31
44  (cadar (cons (cons 'a (cons 'b 'c)) 'd))
45  b)
46
47(deftest cons.32
48  (cddar (cons (cons 'a (cons 'b 'c)) 'd))
49  c)
50
51(deftest cons.33
52  (caadr (cons 'a (cons (cons 'b 'c) 'd)))
53  b)
54
55(deftest cons.34
56  (caddr (cons 'a (cons 'b (cons 'c 'd))))
57  c)
58
59(deftest cons.36
60  (cdadr (cons 'a (cons (cons 'b 'c) 'd)))
61  c)
62
63(deftest cons.37
64  (cdddr (cons 'a (cons 'b (cons 'c 'd))))
65  d)
66
67(defvar *cons-test-4*
68  (cons (cons (cons (cons 'a 'b)
69                    (cons 'c 'd))
70              (cons (cons 'e 'f)
71                    (cons 'g 'h)))
72        (cons (cons (cons 'i 'j)
73                    (cons 'k 'l))
74              (cons (cons 'm 'n)
75                    (cons 'o 'p)))))
76
77(deftest cons.38
78  (caaaar *cons-test-4*)
79  a)
80
81(deftest cons.39
82  (cdaaar *cons-test-4*)
83  b)
84
85(deftest cons.40
86  (cadaar *cons-test-4*)
87  c)
88
89(deftest cons.41
90  (cddaar *cons-test-4*)
91  d)
92
93(deftest cons.42
94  (caadar *cons-test-4*)
95  e)
96
97(deftest cons.43
98  (cdadar *cons-test-4*)
99  f)
100
101(deftest cons.44
102  (caddar *cons-test-4*)
103  g)
104
105(deftest cons.45
106  (cdddar *cons-test-4*)
107  h)
108
109;;;
110
111(deftest cons.46
112  (caaadr *cons-test-4*)
113  i)
114
115(deftest cons.47
116  (cdaadr *cons-test-4*)
117  j)
118
119(deftest cons.48
120  (cadadr *cons-test-4*)
121  k)
122
123(deftest cons.49
124  (cddadr *cons-test-4*)
125  l)
126
127(deftest cons.50
128  (caaddr *cons-test-4*)
129  m)
130
131(deftest cons.51
132  (cdaddr *cons-test-4*)
133  n)
134
135(deftest cons.52
136  (cadddr *cons-test-4*)
137  o)
138
139(deftest cons.53
140  (cddddr *cons-test-4*)
141  p)
142
143(deftest car.1
144  (car '(a))
145  a)
146
147(deftest car-nil
148  (car nil)
149  nil)
150
151(deftest car.error.1
152  (check-type-error #'car #'listp)
153  nil)
154
155#+known-bug-275
156(deftest car.error.2
157  (signals-error (locally (car 'a) t) type-error)
158  t)
159
160(deftest car.order.1
161  (let ((i 0))
162    (values (car (progn (incf i) '(a b))) i))
163  a 1)
164
165(deftest cdr.1
166  (cdr '(a b))
167  (b))
168
169(deftest cdr-nil
170  (cdr ())
171  nil)
172
173(deftest cdr.order.1
174  (let ((i 0))
175    (values (cdr (progn (incf i) '(a b))) i))
176  (b) 1)
177
178(deftest cdr.error.1
179  (check-type-error #'cdr #'listp)
180  nil)
181
182#+known-bug-275
183(deftest cdr.error.2
184  (signals-error (locally (cdr 'a) t) type-error)
185  t)
186
187;;; Error checking of c*r functions
188
189(deftest caar.error.1
190  (signals-error (caar 'a) type-error)
191  t)
192
193(deftest caar.error.2
194  (signals-error (caar '(a)) type-error)
195  t)
196
197(deftest cadr.error.1
198  (signals-error (cadr 'a) type-error)
199  t)
200
201(deftest cadr.error.2
202  (signals-error (cadr '(a . b)) type-error)
203  t)
204
205(deftest cdar.error.1
206  (signals-error (cdar 'a) type-error)
207  t)
208
209(deftest cdar.error.2
210  (signals-error (cdar '(a . b)) type-error)
211  t)
212
213(deftest cddr.error.1
214  (signals-error (cddr 'a) type-error)
215  t)
216
217(deftest cddr.error.2
218  (signals-error (cddr '(a . b)) type-error)
219  t)
220
221(deftest caaar.error.1
222  (signals-error (caaar 'a) type-error)
223  t)
224
225(deftest caaar.error.2
226  (signals-error (caaar '(a)) type-error)
227  t)
228
229(deftest caaar.error.3
230  (signals-error (caaar '((a))) type-error)
231  t)
232
233(deftest caadr.error.1
234  (signals-error (caadr 'a) type-error)
235  t)
236
237(deftest caadr.error.2
238  (signals-error (caadr '(a . b)) type-error)
239  t)
240
241(deftest caadr.error.3
242  (signals-error (caadr '(a . (b))) type-error)
243  t)
244
245(deftest cadar.error.1
246  (signals-error (cadar 'a) type-error)
247  t)
248
249(deftest cadar.error.2
250  (signals-error (cadar '(a . b)) type-error)
251  t)
252
253(deftest cadar.error.3
254  (signals-error (cadar '((a . c) . b)) type-error)
255  t)
256
257(deftest caddr.error.1
258  (signals-error (caddr 'a) type-error)
259  t)
260
261(deftest caddr.error.2
262  (signals-error (caddr '(a . b)) type-error)
263  t)
264
265(deftest caddr.error.3
266  (signals-error (caddr '(a c . b)) type-error)
267  t)
268
269(deftest cdaar.error.1
270  (signals-error (cdaar 'a) type-error)
271  t)
272
273(deftest cdaar.error.2
274  (signals-error (cdaar '(a)) type-error)
275  t)
276
277(deftest cdaar.error.3
278  (signals-error (cdaar '((a . b))) type-error)
279  t)
280
281(deftest cdadr.error.1
282  (signals-error (cdadr 'a) type-error)
283  t)
284
285(deftest cdadr.error.2
286  (signals-error (cdadr '(a . b)) type-error)
287  t)
288
289(deftest cdadr.error.3
290  (signals-error (cdadr '(a b . c)) type-error)
291  t)
292
293(deftest cddar.error.1
294  (signals-error (cddar 'a) type-error)
295  t)
296
297(deftest cddar.error.2
298  (signals-error (cddar '(a . b)) type-error)
299  t)
300
301(deftest cddar.error.3
302  (signals-error (cddar '((a . b) . b)) type-error)
303  t)
304
305(deftest cdddr.error.1
306  (signals-error (cdddr 'a) type-error)
307  t)
308
309(deftest cdddr.error.2
310  (signals-error (cdddr '(a . b)) type-error)
311  t)
312
313(deftest cdddr.error.3
314  (signals-error (cdddr '(a c . b)) type-error)
315  t)
316
317;;
318
319(deftest caaaar.error.1
320  (signals-error (caaaar 'a) type-error)
321  t)
322
323(deftest caaaar.error.2
324  (signals-error (caaaar '(a)) type-error)
325  t)
326
327(deftest caaaar.error.3
328  (signals-error (caaaar '((a))) type-error)
329  t)
330
331(deftest caaaar.error.4
332  (signals-error (caaaar '(((a)))) type-error)
333  t)
334
335(deftest caaadr.error.1
336  (signals-error (caaadr 'a) type-error)
337  t)
338
339(deftest caaadr.error.2
340  (signals-error (caaadr '(a . b)) type-error)
341  t)
342
343(deftest caaadr.error.3
344  (signals-error (caaadr '(a . (b))) type-error)
345  t)
346
347(deftest caaadr.error.4
348  (signals-error (caaadr '(a . ((b)))) type-error)
349  t)
350
351(deftest caadar.error.1
352  (signals-error (caadar 'a) type-error)
353  t)
354
355(deftest caadar.error.2
356  (signals-error (caadar '(a . b)) type-error)
357  t)
358
359(deftest caadar.error.3
360  (signals-error (caadar '((a . c) . b)) type-error)
361  t)
362
363(deftest caadar.error.4
364  (signals-error (caadar '((a . (c)) . b)) type-error)
365  t)
366
367(deftest caaddr.error.1
368  (signals-error (caaddr 'a) type-error)
369  t)
370
371(deftest caaddr.error.2
372  (signals-error (caaddr '(a . b)) type-error)
373  t)
374
375(deftest caaddr.error.3
376  (signals-error (caaddr '(a c . b)) type-error)
377  t)
378
379(deftest caaddr.error.4
380  (signals-error (caaddr '(a c . (b))) type-error)
381  t)
382
383(deftest cadaar.error.1
384  (signals-error (cadaar 'a) type-error)
385  t)
386
387(deftest cadaar.error.2
388  (signals-error (cadaar '(a)) type-error)
389  t)
390
391(deftest cadaar.error.3
392  (signals-error (cadaar '((a . b))) type-error)
393  t)
394
395(deftest cadaar.error.4
396  (signals-error (cadaar '((a . (b)))) type-error)
397  t)
398
399(deftest cadadr.error.1
400  (signals-error (cadadr 'a) type-error)
401  t)
402
403(deftest cadadr.error.2
404  (signals-error (cadadr '(a . b)) type-error)
405  t)
406
407(deftest cadadr.error.3
408  (signals-error (cadadr '(a b . c)) type-error)
409  t)
410
411(deftest cadadr.error.4
412  (signals-error (cadadr '(a (b . e) . c)) type-error)
413  t)
414
415(deftest caddar.error.1
416  (signals-error (caddar 'a) type-error)
417  t)
418
419(deftest caddar.error.2
420  (signals-error (caddar '(a . b)) type-error)
421  t)
422
423(deftest caddar.error.3
424  (signals-error (caddar '((a . b) . b)) type-error)
425  t)
426
427(deftest caddar.error.4
428  (signals-error (caddar '((a  b . c) . b)) type-error)
429  t)
430
431(deftest cadddr.error.1
432  (signals-error (cadddr 'a) type-error)
433  t)
434
435(deftest cadddr.error.2
436  (signals-error (cadddr '(a . b)) type-error)
437  t)
438
439(deftest cadddr.error.3
440  (signals-error (cadddr '(a c . b)) type-error)
441  t)
442
443(deftest cadddr.error.4
444  (signals-error (cadddr '(a c e . b)) type-error)
445  t)
446
447(deftest cdaaar.error.1
448  (signals-error (cdaaar 'a) type-error)
449  t)
450
451(deftest cdaaar.error.2
452  (signals-error (cdaaar '(a)) type-error)
453  t)
454
455(deftest cdaaar.error.3
456  (signals-error (cdaaar '((a))) type-error)
457  t)
458
459(deftest cdaaar.error.4
460  (signals-error (cdaaar '(((a . b)))) type-error)
461  t)
462
463(deftest cdaadr.error.1
464  (signals-error (cdaadr 'a) type-error)
465  t)
466
467(deftest cdaadr.error.2
468  (signals-error (cdaadr '(a . b)) type-error)
469  t)
470
471(deftest cdaadr.error.3
472  (signals-error (cdaadr '(a . (b))) type-error)
473  t)
474
475(deftest cdaadr.error.4
476  (signals-error (cdaadr '(a . ((b . c)))) type-error)
477  t)
478
479(deftest cdadar.error.1
480  (signals-error (cdadar 'a) type-error)
481  t)
482
483(deftest cdadar.error.2
484  (signals-error (cdadar '(a . b)) type-error)
485  t)
486
487(deftest cdadar.error.3
488  (signals-error (cdadar '((a . c) . b)) type-error)
489  t)
490
491(deftest cdadar.error.4
492  (signals-error (cdadar '((a . (c . d)) . b)) type-error)
493  t)
494
495(deftest cdaddr.error.1
496  (signals-error (cdaddr 'a) type-error)
497  t)
498
499(deftest cdaddr.error.2
500  (signals-error (cdaddr '(a . b)) type-error)
501  t)
502
503(deftest cdaddr.error.3
504  (signals-error (cdaddr '(a c . b)) type-error)
505  t)
506
507(deftest cdaddr.error.4
508  (signals-error (cdaddr '(a c b . d)) type-error)
509  t)
510
511(deftest cddaar.error.1
512  (signals-error (cddaar 'a) type-error)
513  t)
514
515(deftest cddaar.error.2
516  (signals-error (cddaar '(a)) type-error)
517  t)
518
519(deftest cddaar.error.3
520  (signals-error (cddaar '((a . b))) type-error)
521  t)
522
523(deftest cddaar.error.4
524  (signals-error (cddaar '((a . (b)))) type-error)
525  t)
526
527(deftest cddadr.error.1
528  (signals-error (cddadr 'a) type-error)
529  t)
530
531(deftest cddadr.error.2
532  (signals-error (cddadr '(a . b)) type-error)
533  t)
534
535(deftest cddadr.error.3
536  (signals-error (cddadr '(a b . c)) type-error)
537  t)
538
539(deftest cddadr.error.4
540  (signals-error (cddadr '(a (b . e) . c)) type-error)
541  t)
542
543(deftest cdddar.error.1
544  (signals-error (cdddar 'a) type-error)
545  t)
546
547(deftest cdddar.error.2
548  (signals-error (cdddar '(a . b)) type-error)
549  t)
550
551(deftest cdddar.error.3
552  (signals-error (cdddar '((a . b) . b)) type-error)
553  t)
554
555(deftest cdddar.error.4
556  (signals-error (cdddar '((a  b . c) . b)) type-error)
557  t)
558
559(deftest cddddr.error.1
560  (signals-error (cddddr 'a) type-error)
561  t)
562
563(deftest cddddr.error.2
564  (signals-error (cddddr '(a . b)) type-error)
565  t)
566
567(deftest cddddr.error.3
568  (signals-error (cddddr '(a c . b)) type-error)
569  t)
570
571(deftest cddddr.error.4
572  (signals-error (cddddr '(a c e . b)) type-error)
573  t)
574
575;;; Need to add 'locally' wrapped forms of these
576
577;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
578;;; setting of C*R accessors
579
580(loop
581    for fn in '(car cdr caar cadr cdar cddr
582                caaar caadr cadar caddr cdaar cdadr cddar cdddr
583                caaaar caaadr caadar caaddr cadaar cadadr caddar cadddr
584                cdaaar cdaadr cdadar cdaddr cddaar cddadr cdddar cddddr)
585    do
586      (let ((level (- (length (symbol-name fn)) 2)))
587        (eval `(deftest ,(intern
588                          (concatenate 'string
589                            (symbol-name fn)
590                            "-SET-ALT")
591                          :cl-test)
592                   (let ((x (create-c*r-test ,level)))
593                     (and
594                      (setf (,fn x) 'a)
595                      (eql (,fn x) 'a)
596                      (setf (,fn x) 'none)
597                      (equalt x (create-c*r-test ,level))
598                      ))
599                 t))))
600
601(loop
602    for (fn len) in '((first 1) (second 2) (third 3) (fourth 4)
603                      (fifth 5) (sixth 6) (seventh 7) (eighth 8)
604                      (ninth 9) (tenth 10))
605    do
606      (eval
607       `(deftest ,(intern
608                   (concatenate 'string
609                     (symbol-name fn)
610                     "-SET-ALT")
611                   :cl-test)
612            (let ((x (make-list 20 :initial-element nil)))
613              (and
614               (setf (,fn x) 'a)
615               (loop
616                   for i from 1 to 20
617                   do (when (and (not (eql i ,len))
618                                 (nth (1- i) x))
619                        (return nil))
620                   finally (return t))
621               (eql (,fn x) 'a)
622               (nth ,(1- len) x)))
623          a)))
Note: See TracBrowser for help on using the repository browser.