1 ;;;; rudimentary tests ("smoke tests") for miscellaneous stuff which
2 ;;;; doesn't seem to deserve specialized files at the moment
4 ;;;; This software is part of the SBCL system. See the README file for
7 ;;;; While most of SBCL is derived from the CMU CL system, the test
8 ;;;; files (like this one) were written from scratch after the fork
11 ;;;; This software is in the public domain and is provided with
12 ;;;; absolutely no warranty. See the COPYING and CREDITS files for
13 ;;;; more information.
15 (cl:in-package
:cl-user
)
17 ;;; ROOM should run without signalling an error. (bug 247)
22 ;;; COPY-SYMBOL should work without signalling an error, even if the
23 ;;; symbol is unbound.
27 (copy-symbol '*baz
* t
)
29 ;;; SETQ should return its value.
30 (assert (typep (setq *baz
* 1) 'integer
))
31 (assert (typep (in-package :cl-user
) 'package
))
33 ;;; PROFILE should run without obvious breakage
34 (defun profiled-fun ()
36 (profile profiled-fun
)
37 (loop repeat
100000 do
(profiled-fun))
40 ;;; DEFCONSTANT should behave as the documentation specifies,
41 ;;; including documented condition type.
42 (defun oidentity (x) x
)
43 (defconstant +const
+ 1)
44 (assert (= (oidentity +const
+) 1))
45 (let ((error (nth-value 1 (ignore-errors (defconstant +const
+ 2)))))
46 (assert (typep error
'sb-ext
:defconstant-uneql
))
47 (assert (= (sb-ext:defconstant-uneql-old-value error
) 1))
48 (assert (= (sb-ext:defconstant-uneql-new-value error
) 2))
49 (assert (eql (sb-ext:defconstant-uneql-name error
) '+const
+)))
50 (assert (= (oidentity +const
+) 1))
52 ((sb-ext:defconstant-uneql
53 (lambda (c) (abort c
))))
54 (defconstant +const
+ 3))
55 (assert (= (oidentity +const
+) 1))
57 ((sb-ext:defconstant-uneql
58 (lambda (c) (continue c
))))
59 (defconstant +const
+ 3))
60 (assert (= (oidentity +const
+) 3))
63 (quit :unix-status
104)