X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Finterface.impure.lisp;h=33f7886cf922a78672dced9e2ed6d2a4a00dc6d9;hb=ab5427d31da2bd95805cccc8e47b8f43d3dd606d;hp=38370601939043600a38623ef4d129990e558d1f;hpb=5951caad8c14912c4dd859a49d2b240fa247b51d;p=sbcl.git diff --git a/tests/interface.impure.lisp b/tests/interface.impure.lisp index 3837060..33f7886 100644 --- a/tests/interface.impure.lisp +++ b/tests/interface.impure.lisp @@ -83,15 +83,20 @@ ;;; support for DESCRIBE tests (defstruct to-be-described a b) (defclass forward-describe-class (forward-describe-ref) (a)) +(let ((sb-ext:*evaluator-mode* :compile)) + (eval `(let (x) (defun closure-to-describe () (incf x))))) ;;; DESCRIBE should run without signalling an error. -(describe (make-to-be-described)) -(describe 12) -(describe "a string") -(describe 'symbolism) -(describe (find-package :cl)) -(describe '(a list)) -(describe #(a vector)) +(with-test (:name (describe :no-error)) + (describe (make-to-be-described)) + (describe 12) + (describe "a string") + (describe 'symbolism) + (describe (find-package :cl)) + (describe '(a list)) + (describe #(a vector)) +;; bug 824974 + (describe 'closure-to-describe)) ;;; The DESCRIBE-OBJECT methods for built-in CL stuff should do ;;; FRESH-LINE and TERPRI neatly. @@ -232,14 +237,17 @@ (assert (string= (documentation #'docfoo t) "bar")) (assert (string= (setf (documentation 'docfoo 'function) "baz") "baz")) (assert (string= (documentation 'docfoo 'function) "baz")) - (assert (string= (documentation #'docfoo t) "baz"))) + (assert (string= (documentation #'docfoo t) "bar")) + (assert (string= (setf (documentation #'docfoo t) "zot") "zot")) + (assert (string= (documentation #'docfoo t) "zot")) + (assert (string= (documentation 'docfoo 'function) "baz")) + (assert (not (setf (documentation 'docfoo 'function) nil))) + (assert (string= (documentation 'docfoo 'function) "zot"))) -#+sb-doc -(with-test (:name (documentation built-in-macro)) +(with-test (:name (documentation built-in-macro) :skipped-on '(not :sb-doc)) (assert (documentation 'trace 'function))) -#+sb-doc -(with-test (:name (documentation built-in-function)) +(with-test (:name (documentation built-in-function) :skipped-on '(not :sb-doc)) (assert (documentation 'cons 'function))) (with-test (:name :describe-generic-function-with-assumed-type) @@ -256,5 +264,13 @@ (assert (equal "foo" (documentation 'bug-643958-test 'function))) (setf (documentation 'bug-643958-test 'function) "bar") (assert (equal "bar" (documentation 'bug-643958-test 'function)))) + +(with-test (:name :bug-881445 + :skipped-on '(not :x86-64)) + (let ((x (make-array (1- (expt 2 32)) :element-type '(unsigned-byte 8)))) + (assert (> (sb-kernel:dynamic-usage) (length x))) + ;; prevent compiler from getting too smart... + (eval x) + t)) ;;;; success