X-Git-Url: http://repo.macrolet.net/gitweb/?a=blobdiff_plain;f=tests%2Fclos.impure.lisp;h=d9155ef823998292ad88fd8c2ef005e42e484bdd;hb=9dcd91eba92f6f2db9ae65d7640f2cd2f4ee2a8b;hp=47ad9247f92179f7d232891388936dd7abcbbdc9;hpb=76e5ccc7e653ffe279148bb8f3f6f5b7c4772a4e;p=sbcl.git

diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index 47ad924..d9155ef 100644
--- a/tests/clos.impure.lisp
+++ b/tests/clos.impure.lisp
@@ -1545,5 +1545,26 @@
 (assert (equal '(:foo 13)
                (apply #'test-long-form-with-&rest :foo (make-list 13))))
 
+;;;; slot-missing for non-standard classes on SLOT-VALUE
+;;;;
+;;;; FIXME: This is arguably not right, actually: CLHS seems to say
+;;;; we should just signal an error at least for built-in classes, but
+;;;; for a while we were hitting NO-APPLICABLE-METHOD, which is definitely
+;;;; wrong -- so test this for now at least.
+
+(defvar *magic-symbol* (gensym "MAGIC"))
+
+(set *magic-symbol* 42)
+
+(defmethod slot-missing (class instance (slot-name (eql *magic-symbol*)) op
+                         &optional new)
+  (if (eq 'setf op)
+      (setf (symbol-value *magic-symbol*)  new)
+      (symbol-value *magic-symbol*)))
+
+(assert (eql 42 (slot-value (cons t t) *magic-symbol*)))
+(assert (eql 13 (setf (slot-value 123 *magic-symbol*) 13)))
+(assert (eql 13 (slot-value 'foobar *magic-symbol*)))
+
 
 ;;;; success