X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fsmoke.impure.lisp;h=d5e86b3b8710f2dbed09aae45a6e40de89ff8954;hb=4f102592a1c122f17231563671930456c7c85f5c;hp=5f59c48feddec8db3ee1a1cf9fd8a34a447dc5df;hpb=d76c81b0ca4dcfc99f0cd805f5c20493fa80b2b6;p=sbcl.git diff --git a/tests/smoke.impure.lisp b/tests/smoke.impure.lisp index 5f59c48..d5e86b3 100644 --- a/tests/smoke.impure.lisp +++ b/tests/smoke.impure.lisp @@ -19,16 +19,6 @@ (room t) (room nil) -;;; DESCRIBE should run without signalling an error. -(defstruct to-be-described a b) -(describe (make-to-be-described)) -(describe 12) -(describe "a string") -(describe 'symbolism) -(describe (find-package :cl)) -(describe '(a list)) -(describe #(a vector)) - ;;; COPY-SYMBOL should work without signalling an error, even if the ;;; symbol is unbound. (copy-symbol 'foo) @@ -40,5 +30,34 @@ (assert (typep (setq *baz* 1) 'integer)) (assert (typep (in-package :cl-user) 'package)) +;;; PROFILE should run without obvious breakage +(defun profiled-fun () + (random 1d0)) +(profile profiled-fun) +(loop repeat 100000 do (profiled-fun)) +(report) + +;;; DEFCONSTANT should behave as the documentation specifies, +;;; including documented condition type. +(defun oidentity (x) x) +(defconstant +const+ 1) +(assert (= (oidentity +const+) 1)) +(let ((error (nth-value 1 (ignore-errors (defconstant +const+ 2))))) + (assert (typep error 'sb-ext:defconstant-uneql)) + (assert (= (sb-ext:defconstant-uneql-old-value error) 1)) + (assert (= (sb-ext:defconstant-uneql-new-value error) 2)) + (assert (eql (sb-ext:defconstant-uneql-name error) '+const+))) +(assert (= (oidentity +const+) 1)) +(handler-bind + ((sb-ext:defconstant-uneql + (lambda (c) (abort c)))) + (defconstant +const+ 3)) +(assert (= (oidentity +const+) 1)) +(handler-bind + ((sb-ext:defconstant-uneql + (lambda (c) (continue c)))) + (defconstant +const+ 3)) +(assert (= (oidentity +const+) 3)) + ;;; success (quit :unix-status 104)