1 ;;;; tests of the CASE family of macros without side effects
3 ;;;; This software is part of the SBCL system. See the README file for
6 ;;;; While most of SBCL is derived from the CMU CL system, the test
7 ;;;; files (like this one) were written from scratch after the fork
10 ;;;; This software is in the public domain and is provided with
11 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
12 ;;;; more information.
14 (with-test (:name
:keyform-always-used
)
15 (checked-compile '(lambda (x) (case x
(t 'thing
)))))
17 (with-test (:name
(case :duplicate-key
:compile-time-warning
))
19 for
(expected kind . clauses
) in
25 ("Duplicate key 1 in CASE form, occurring in the first clause: (1 1), and the second clause: (1 2)"
29 ("Duplicate key 2 in CASE form, occurring in the first clause: ((1 2) 1), and the second clause: ((2 3) 2)"
36 for form
= `(lambda ()
40 (multiple-value-bind (fun failure-p warnings style-warnings
)
41 (checked-compile form
:allow-style-warnings
(when expected t
))
42 (declare (ignore failure-p warnings
))
43 (assert (functionp fun
))
45 (dolist (warning style-warnings
)
46 (assert (search expected
47 (with-standard-io-syntax
48 (let ((*print-right-margin
* nil
)
50 (remove #\Newline
(princ-to-string warning
)))))
52 "~S should have warned ~S, but instead warned: ~A"
53 form expected warning
))
54 (assert style-warnings
()
55 "~S should have warned ~S, but didn't."
58 (with-test (:name
:duplicate-cases-load
)
59 (assert (load "case-test.lisp")))
61 (with-test (:name
:no-notes-e-failure
)
62 (checked-compile '(lambda (x)
63 (when (typep x
'sequence
)
68 (checked-compile '(lambda (x)
69 (when (typep x
'symbol
)