X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fclos-1.impure.lisp;h=c839585aba29e4b09230253e8cfed05095af0dd8;hb=ed891a4fd882d1b9fe066ab14bcf2107aea95baa;hp=09b66f019ece7994ac5d140ea18e83fea824bea5;hpb=71922347ca66f2a3ad4c55092ccb3ad86a14c754;p=sbcl.git

diff --git a/tests/clos-1.impure.lisp b/tests/clos-1.impure.lisp
index 09b66f0..c839585 100644
--- a/tests/clos-1.impure.lisp
+++ b/tests/clos-1.impure.lisp
@@ -87,3 +87,36 @@
     (assert (raises-error? (funcall fun *foo*)))
     (assert (= 3 (b-of *foo*)))
     (assert (raises-error? (c-of *foo*)))))
+
+;;; test that :documentation argument to slot specifiers are used as
+;;; the docstrings of accessor methods.
+(defclass foo ()
+  ((a :reader a-of :documentation "docstring for A")
+   (b :writer set-b-of :documentation "docstring for B")
+   (c :accessor c :documentation  "docstring for C")))
+
+(flet ((doc (fun)
+         (documentation fun t)))
+  (assert (string= (doc (find-method #'a-of nil '(foo))) "docstring for A"))
+  (assert (string= (doc (find-method #'set-b-of nil '(t foo))) "docstring for B"))
+  (assert (string= (doc (find-method #'c nil '(foo))) "docstring for C"))
+  (assert (string= (doc (find-method #'(setf c) nil '(t foo))) "docstring for C")))
+
+;;; some nasty tests of NO-NEXT-METHOD.
+(defvar *method-with-no-next-method*)
+(defvar *nnm-count* 0)
+(defun make-nnm-tester (x)
+  (setq *method-with-no-next-method* (defmethod nnm-tester ((y (eql x))) (call-next-method))))
+(make-nnm-tester 1)
+(defmethod no-next-method ((gf (eql #'nnm-tester)) method &rest args)
+  (assert (eql method *method-with-no-next-method*))
+  (incf *nnm-count*))
+(with-test (:name (no-next-method :unknown-specializer))
+  (nnm-tester 1)
+  (assert (= *nnm-count* 1)))
+(let ((gf #'nnm-tester))
+  (reinitialize-instance gf :name 'new-nnm-tester)
+  (setf (fdefinition 'new-nnm-tester) gf))
+(with-test (:name (no-next-method :gf-name-changed))
+  (new-nnm-tester 1)
+  (assert (= *nnm-count* 2)))