[elephant-cvs] CVS elephant/src

[ieslick]

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 , at 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)