Update of /project/rjain-utils/cvsroot/prototypes In directory cl-net:/tmp/cvs-serv4504 Modified Files: prototypes.lisp Log Message: use CLOSER-MOP allow slot-unbound errors to propagate out of slot-value accessors add test case for above change --- /project/rjain-utils/cvsroot/prototypes/prototypes.lisp 2009/11/24 10:43:30 1.5 +++ /project/rjain-utils/cvsroot/prototypes/prototypes.lisp 2009/11/25 10:46:36 1.6 @@ -4,7 +4,7 @@ #:prototype-add-delegate #:prototype-remove-delegate #:make-prototype) - (:use :cl #+sbcl :sb-mop #-sbcl :mop)) + (:use :cl :closer-mop)) (in-package :prototypes) @@ -104,14 +104,20 @@ &optional new-value) (declare (ignore new-value)) (dolist (delegate (prototype-delegates object) + ;; if no slot is found in all the delegates, we + ;; call the default method to signal a + ;; slot-missing error (call-next-method)) - (ignore-errors - ;; if OPERATION succeeds on the delegate, RETURN - ;; that result from our loop, otherwise it will - ;; error and continue on to the next delegate, via - ;; IGNORE-ERRORS. If no delegates are left, it will - ;; call the default method which signals a - ;; slot-missing error. + (handler-bind ((unbound-slot #'error) + ;; there is no specific class for + ;; slot-missing errors. the spec just + ;; says signals an error of type error. + ;; ugh. + (error + ;; can't find the slot here, so we + ;; continue to the next delegate + #'identity)) + ;; if this finds the slot, we return it (return (,operation delegate slot-name))))))) (reader-delegation slot-value) (reader-delegation slot-boundp)) @@ -217,6 +223,11 @@ (assert (eql (slot-value *3* 'x) 3)) (assert (not (slot-boundp *3.1* 'x))) (assert (not (slot-boundp *3.3.1* 'x))) +(handler-case + (progn + (slot-value *3.3.1* 'x) + (assert nil)) + (unbound-slot (error))) (defclass test () ((x :allocation :class)))