X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fclos.impure.lisp;h=864e0b614ce76e52746ba989321c78cd2664b4c6;hb=a7e7d0b213aa1133cc419421d611e7e2ad36808c;hp=c415f1a8ffa73d8750a311da34cc6eb428bcbd36;hpb=2b0710d31c3fa1e5448ec842504d5276842e394f;p=sbcl.git

diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index c415f1a..864e0b6 100644
--- a/tests/clos.impure.lisp
+++ b/tests/clos.impure.lisp
@@ -1267,5 +1267,38 @@
                                         (list (find-class 'integer))))))
 (assert (= (remove-method-1 3) 4))
 (assert (= (remove-method-2 3) 2))
+
+;;; ANSI doesn't require these restarts, but now that we have them we
+;;; better test them too.
+(defclass slot-unbound-restart-test () ((x)))
+(let ((test (make-instance 'slot-unbound-restart-test)))
+  (assert (not (slot-boundp test 'x)))
+  (assert (= 42 (handler-bind ((unbound-slot (lambda (c) (use-value 42 c))))
+                  (slot-value test 'x))))
+  (assert (not (slot-boundp test 'x)))
+  (assert (= 13 (handler-bind ((unbound-slot (lambda (c) (store-value 13 c))))
+                  (slot-value test 'x))))
+  (assert (= 13 (slot-value test 'x))))
+
+;;; Using class instances as specializers, reported by Pascal Costanza, ref CLHS 7.6.2
+(defclass class-as-specializer-test ()
+   ())
+(eval `(defmethod class-as-specializer-test1 ((x ,(find-class 'class-as-specializer-test)))
+          'foo))
+(assert (eq 'foo (class-as-specializer-test1 (make-instance 'class-as-specializer-test))))
+(funcall (compile nil `(lambda ()
+                         (defmethod class-as-specializer-test2 ((x ,(find-class 'class-as-specializer-test)))
+                           'bar))))
+(assert (eq 'bar (class-as-specializer-test2 (make-instance 'class-as-specializer-test))))
+
+;;; CHANGE-CLASS and tricky allocation.
+(defclass foo ()
+  ((a :allocation :class :initform 1)))
+(defclass bar (foo) ())
+(defvar *bar* (make-instance 'bar))
+(defclass baz ()
+  ((a :allocation :instance :initform 2)))
+(change-class *bar* 'baz)
+(assert (= (slot-value *bar* 'a) 1))
 
 ;;;; success