X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Finterface.impure.lisp;h=175edcec9fd52935c61e8416e5fd9b3e4c436758;hb=26e7568488a46369198e336808b4aba57bbe7a63;hp=31cb5171528a5ac599b66cd6dcd2824a031e4da0;hpb=32d3b398d33736e61b51a14afca8c14decec4437;p=sbcl.git diff --git a/tests/interface.impure.lisp b/tests/interface.impure.lisp index 31cb517..175edce 100644 --- a/tests/interface.impure.lisp +++ b/tests/interface.impure.lisp @@ -232,22 +232,21 @@ "bar" (incf x y))) -(with-test (:name (documentation closure)) +(with-test (:name (documentation :closure)) (assert (string= (documentation 'docfoo 'function) "bar")) - (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) "bar")) + (assert (string= (documentation #'docfoo t) "baz")) (assert (string= (setf (documentation #'docfoo t) "zot") "zot")) (assert (string= (documentation #'docfoo t) "zot")) - (assert (string= (documentation 'docfoo 'function) "baz")) + (assert (string= (documentation 'docfoo 'function) "zot")) (assert (not (setf (documentation 'docfoo 'function) nil))) - (assert (string= (documentation 'docfoo 'function) "zot"))) + (assert (not (documentation 'docfoo 'function)))) -(with-test (:name (documentation built-in-macro) :skipped-on '(not :sb-doc)) +(with-test (:name (documentation :built-in-macro) :skipped-on '(not :sb-doc)) (assert (documentation 'trace 'function))) -(with-test (:name (documentation built-in-function) :skipped-on '(not :sb-doc)) +(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) @@ -297,5 +296,28 @@ (assert (or (member :big-endian *features*) (member :little-endian *features*)))) + +(with-test (:name :function-documentation-mismatch) + (defun test () + "X" + nil) + (setf (symbol-function 'test2) #'test) + (setf (documentation 'test 'function) "Y") + (assert (equal (documentation #'test t) + (documentation 'test 'function))) + (setf (documentation 'test2 'function) "Z") + (assert (not + (equal (documentation 'test 'function) + (documentation 'test2 'function))))) + +(with-test (:name :setf-documentation-on-nil) + (assert + (handler-case + (assert (equal (setf (documentation nil 'function) "foo") "foo")) + (style-warning () t) + (:no-error (x) + (declare (ignore x)) + nil)))) + ;;;; success