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)