[Sbcl-commits] master: Don't remove safety checks for SLOT-VALUE-USING-CLASS.

[stassats <sta...@us...>]

The branch "master" has been updated in SBCL:
       via  71b5b931d4a3ec6b185e7ce2abd8a8e1135fbbdc (commit)
      from  4bf626e745d5d2e34630ec4dd67b7c17bd9b8f28 (commit)

- Log -----------------------------------------------------------------
commit 71b5b931d4a3ec6b185e7ce2abd8a8e1135fbbdc
Author: Stas Boukarev <sta...@gm...>
Date:   Mon Nov 3 00:10:47 2014 +0300

    Don't remove safety checks for SLOT-VALUE-USING-CLASS.
    
    SLOT-VALUE-USING-CLASS may be called with a slot definition from a
    different class, which is actually sometimes useful, but it may be for
    a slot that doesn't exist. And the code for optimized SVUC used
    (safety 0), avoiding array bounds checks, causing very hard to track
    down issues.
    Just remove the safety declaration.
---
 src/pcl/slots-boot.lisp |    6 ------
 tests/clos.impure.lisp  |   10 ++++++++++
 2 files changed, 10 insertions(+), 6 deletions(-)

diff --git a/src/pcl/slots-boot.lisp b/src/pcl/slots-boot.lisp
index 1bbb501..7bc51e7 100644
--- a/src/pcl/slots-boot.lisp
+++ b/src/pcl/slots-boot.lisp
@@ -172,7 +172,6 @@
 
 (defun make-optimized-std-reader-method-function
     (fsc-p slotd slot-name location)
-  (declare #.*optimize-speed*)
   (set-fun-name
    (etypecase location
      (fixnum
@@ -206,7 +205,6 @@
    `(reader ,slot-name)))
 
 (defun make-optimized-std-writer-method-function (fsc-p slotd slot-name location)
-  (declare #.*optimize-speed*)
   ;; The (WHEN SLOTD ...) gunk is for building early slot definitions.
   (let* ((class (when slotd (slot-definition-class slotd)))
          (safe-p (when slotd (safe-p class)))
@@ -277,7 +275,6 @@
 
 (defun make-optimized-std-boundp-method-function
     (fsc-p slotd slot-name location)
-  (declare #.*optimize-speed*)
   (set-fun-name
    (etypecase location
      (fixnum (if fsc-p
@@ -363,7 +360,6 @@
                (slot-definition-location slotd))))))
 
 (defun make-optimized-std-slot-value-using-class-method-function (fsc-p slotd)
-  (declare #.*optimize-speed*)
   (let ((location (slot-definition-location slotd))
         (slot-name (slot-definition-name slotd)))
     (etypecase location
@@ -398,7 +394,6 @@
 
 (defun make-optimized-std-setf-slot-value-using-class-method-function
     (fsc-p slotd)
-  (declare #.*optimize-speed*)
   (let* ((location (slot-definition-location slotd))
          (class (slot-definition-class slotd))
          (typecheck
@@ -437,7 +432,6 @@
 
 (defun make-optimized-std-slot-boundp-using-class-method-function
     (fsc-p slotd)
-  (declare #.*optimize-speed*)
   (let ((location (slot-definition-location slotd)))
     (etypecase location
       (fixnum
diff --git a/tests/clos.impure.lisp b/tests/clos.impure.lisp
index 83b459e..fd44eb2 100644
--- a/tests/clos.impure.lisp
+++ b/tests/clos.impure.lisp
@@ -2343,4 +2343,14 @@
                                     ()))))))
     (sb-pcl::map-all-classes #'mapper)))
 
+(defclass slot-value-using-class-a () ())
+(defclass slot-value-using-class-b () (x))
+
+(with-test (:name :svuc-with-bad-slotd)
+  (let* ((a (make-instance 'slot-value-using-class-a))
+         (b (make-instance 'slot-value-using-class-b))
+         (slotd (car (sb-mop:class-slots (class-of b)))))
+    (assert-error (sb-mop:slot-value-using-class (class-of a) a slotd))
+    (assert-error (setf (sb-mop:slot-value-using-class (class-of a) a slotd) t))))
+
 ;;;; success

-----------------------------------------------------------------------


hooks/post-receive
-- 
SBCL