Update of /project/elephant/cvsroot/elephant/src In directory common-lisp:/tmp/cvs-serv29751/src
Modified Files: classes.lisp controller.lisp metaclasses.lisp Log Message:
Minor modifications including a cleanup of the basicpersistence test and fixing two bugs in allegro support for slot-unboundp and makunbound. I also removed a workaround of these bugs in the mop-tests.lisp test suite. This checkin confirms that release candidate 0-5-0-rc1 passes all tests under Allegro 7.0 using the BDB 4.3 and SQLite3 backends.
--- /project/elephant/cvsroot/elephant/src/classes.lisp 2006/02/04 22:25:09 1.17 +++ /project/elephant/cvsroot/elephant/src/classes.lisp 2006/02/05 23:13:07 1.18 @@ -172,7 +172,7 @@ ;; probably should delete discarded slots, but we'll worry about that later (prog1 (call-next-method) - (format t "persisent-slots ~A~%" (persistent-slots (class-of instance))) +;; (format t "persistent-slots ~A~%" (persistent-slots (class-of instance))) ;; (format t "slot-boundp ~A~%" (slot-boundp instance '%persistent-slots)) (let* ((class (class-of instance)) (new-persistent-slots (set-difference (persistent-slots class) @@ -235,10 +235,10 @@ (loop for slot in (class-slots class) for matches-p = (eq (slot-definition-name slot) slot-name) until matches-p - finally (if (and matches-p - (typep slot 'persistent-slot-definition)) - (persistent-slot-boundp instance slot-name) - (call-next-method)))) + finally (return (if (and matches-p + (subtypep (type-of slot) 'persistent-slot-definition)) + (persistent-slot-boundp instance slot-name) + (call-next-method)))))
(defmethod slot-makunbound-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-def persistent-slot-definition)) "Deletes the slot from the database." @@ -268,6 +268,6 @@ (defmethod slot-makunbound-using-class :around ((class persistent-metaclass) (instance persistent-object) (slot-name symbol)) (loop for slot in (class-slots class) until (eq (slot-definition-name slot) slot-name) - finally (if (typep slot 'persistent-slot-definition) - (slot-makunbound-using-class class instance slot) - (call-next-method)))) + finally (return (if (typep slot 'persistent-slot-definition) + (slot-makunbound-using-class class instance slot) + (call-next-method))))) --- /project/elephant/cvsroot/elephant/src/controller.lisp 2006/02/04 22:25:09 1.15 +++ /project/elephant/cvsroot/elephant/src/controller.lisp 2006/02/05 23:13:07 1.16 @@ -400,10 +400,9 @@ (defmacro with-open-store ((spec) &body body) "Executes the body with an open controller, unconditionally closing the controller on exit." - `(let ((*store-controller* - (get-controller ,spec))) + `(let ((*store-controller* (get-controller ,spec))) (declare (special *store-controller*)) -;; (open-controller *store-controller*) + (open-controller *store-controller*) (unwind-protect (progn ,@body) (close-controller *store-controller*)))) --- /project/elephant/cvsroot/elephant/src/metaclasses.lisp 2006/02/04 22:25:09 1.11 +++ /project/elephant/cvsroot/elephant/src/metaclasses.lisp 2006/02/05 23:13:07 1.12 @@ -278,7 +278,7 @@ (let ((buf (db-get-key-buffered (controller-db (check-con (:dbcn-spc-pst ,instance))) key-buf value-buf))) - (if buf T nil)))))) + (if buf t nil))))))
#+(or cmu sbcl) (defun make-persistent-slot-boundp (name)