1.0.7.36: FIND-SLOT-DEFINITION to return NIL when called with non-slot-classes

 * Add a default method to CLASS-SLOT-VECTOR that returns #(NIL), restoring
   the pre-1.0.7.26 behaviour of calling SLOT-MISSING when trying to access
   slots in non-SLOT-CLASS instances.

 * Add a slightly dubious test-case.

diff --git a/src/pcl/slots-boot.lisp b/src/pcl/slots-boot.lisp
index 752b190..9f416cf 100644 (file)
--- a/src/pcl/slots-boot.lisp
+++ b/src/pcl/slots-boot.lisp
@@ -551,7 +551,7 @@
 ;;;    empty vector separately: it just returns a NIL.
 
 (defun find-slot-definition (class slot-name)
-  (declare (symbol slot-name) (inline getf))
+  (declare (symbol slot-name))
   (let* ((vector (class-slot-vector class))
          (index (rem (sxhash slot-name) (length vector))))
     (declare (simple-vector vector) (index index)

diff --git a/src/pcl/std-class.lisp b/src/pcl/std-class.lisp
index b63d660..cdffa52 100644 (file)
--- a/src/pcl/std-class.lisp
+++ b/src/pcl/std-class.lisp
@@ -1557,6 +1557,11 @@
   (def class-direct-default-initargs)
   (def class-default-initargs))
 
+(defmethod class-slot-vector (class)
+  ;; Default method to cause FIND-SLOT-DEFINITION return NIL for all
+  ;; non SLOT-CLASS classes.
+  #(nil))
+
 (defmethod validate-superclass ((c class) (s built-in-class))
   (or (eq s *the-class-t*) (eq s *the-class-stream*)
       ;; FIXME: bad things happen if someone tries to mix in both

diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index 47ad924..d9155ef 100644 (file)
--- 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*)))
+
 \f
 ;;;; success

diff --git a/version.lisp-expr b/version.lisp-expr
index fe8d58b..8895fc4 100644 (file)
--- a/version.lisp-expr
+++ b/version.lisp-expr
@@ -17,4 +17,4 @@
 ;;; checkins which aren't released. (And occasionally for internal
 ;;; versions, especially for internal versions off the main CVS
 ;;; branch, it gets hairier, e.g. "0.pre7.14.flaky4.13".)
-"1.0.7.35"
+"1.0.7.36"