Update of /project/elephant/cvsroot/elephant/src In directory common-lisp:/tmp/cvs-serv9274

Modified Files: RUNTEST.lisp classes.lisp collections.lisp controller.lisp elephant.lisp metaclasses.lisp sql-controller.lisp Log Message: Changes from Andrew Blumberg discovered while debugging on openMCL.

--- /project/elephant/cvsroot/elephant/src/RUNTEST.lisp 2005/11/23 17:51:37 1.2 +++ /project/elephant/cvsroot/elephant/src/RUNTEST.lisp 2006/01/24 15:42:30 1.3 @@ -19,6 +19,10 @@ (setq *test-path-primary* *testpg-path*) (setq *test-path-primary* *testsqlite3-path*) (setq *test-path-secondary* *testdb-path*) + +(setq *test-path-primary* *testdb-path*) +(setq *test-path-secondary* nil) + (do-all-tests-spec *test-path-primary*)

--- /project/elephant/cvsroot/elephant/src/classes.lisp 2005/11/23 17:51:37 1.14 +++ /project/elephant/cvsroot/elephant/src/classes.lisp 2006/01/24 15:42:30 1.15 @@ -187,6 +187,9 @@ (setf (slot-value-using-class class instance slot-def) (funcall initfun)))) ) +;; (format t "transient-slot-inits ~A~%" transient-slot-inits) +;; (format t "indices boundp ~A~%" (slot-boundp instance 'indices)) +;; (format t "indices-caches boundp ~A~%" (slot-boundp instance 'indices-cache)) ;; let the implementation initialize the transient slots (apply #'call-next-method instance transient-slot-inits initargs))))))

@@ -194,11 +197,16 @@ ;; 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 "slot-boundp ~A~%" (slot-boundp instance '%persistent-slots)) (let* ((class (class-of instance)) (new-persistent-slots (set-difference (persistent-slots class) (old-persistent-slots class)))) - (apply #'shared-initialize instance new-persistent-slots initargs)))) + (apply #'shared-initialize instance new-persistent-slots initargs)) +;; (format t "slot-boundp ~A~%" (slot-boundp instance '%persistent-slots)) + ) + )

(defun find-slot-def-by-name (class slot-name) (loop for slot-def in (class-slots class) --- /project/elephant/cvsroot/elephant/src/collections.lisp 2005/11/23 17:51:37 1.12 +++ /project/elephant/cvsroot/elephant/src/collections.lisp 2006/01/24 15:42:30 1.13 @@ -377,7 +377,8 @@ (defmethod (setf get-value) (value key (bt btree-index)) "Puts are not allowed on secondary indices. Try adding to the primary." - (declare (ignore value key bt)) + (declare (ignore value key) + (ignorable bt)) (error "Puts are forbidden on secondary indices. Try adding to the primary."))

(defgeneric get-primary-key (key bt) @@ -1008,20 +1009,23 @@ (defmethod cursor-get-both ((cursor bdb-secondary-cursor) key value) "cursor-get-both not implemented for secondary indices. Use cursor-pget-both." - (declare (ignore cursor key value)) + (declare (ignore key value) + (ignorable cursor)) (error "cursor-get-both not implemented on secondary indices. Use cursor-pget-both."))

(defmethod cursor-get-both-range ((cursor bdb-secondary-cursor) key value) "cursor-get-both-range not implemented for secondary indices. Use cursor-pget-both-range." - (declare (ignore cursor key value)) + (declare (ignore key value) + (ignorable cursor)) (error "cursor-get-both-range not implemented on secondary indices. Use cursor-pget-both-range."))

(defmethod cursor-put ((cursor bdb-secondary-cursor) value &rest rest) "Puts are forbidden on secondary indices. Try adding to the primary." - (declare (ignore rest value cursor)) + (declare (ignore rest value) + (ignorable cursor)) (error "Puts are forbidden on secondary indices. Try adding to the primary."))

(defmethod cursor-next-dup ((cursor bdb-secondary-cursor)) --- /project/elephant/cvsroot/elephant/src/controller.lisp 2005/11/23 17:51:37 1.13 +++ /project/elephant/cvsroot/elephant/src/controller.lisp 2006/01/24 15:42:30 1.14 @@ -181,7 +181,7 @@ )

(defun add-index-from-index (iname v dstibt dstsc) - (declare (type btree-index v) +#-ALLEGRO (declare (type btree-index v) (type indexed-btree dstibt)) (let ((kf (key-form v))) (format t " kf ~A ~%" kf) --- /project/elephant/cvsroot/elephant/src/elephant.lisp 2005/11/23 17:51:37 1.15 +++ /project/elephant/cvsroot/elephant/src/elephant.lisp 2006/01/24 15:42:30 1.16 @@ -216,7 +216,11 @@ slot-definition-initargs class-finalized-p finalize-inheritance - compute-slots) + compute-slots + slot-definition-readers + slot-definition-writers + class-direct-slots + ) #+allegro (:import-from :excl compute-effective-slot-definition-initargs) --- /project/elephant/cvsroot/elephant/src/metaclasses.lisp 2006/01/06 14:20:03 1.9 +++ /project/elephant/cvsroot/elephant/src/metaclasses.lisp 2006/01/24 15:42:30 1.10 @@ -94,6 +94,9 @@ default; use the :transient flag otherwise."))

(defmethod persistent-slots ((class persistent-metaclass)) + (if (slot-boundp class '%persistent-slots) + (car (%persistent-slots class)) + nil) (car (%persistent-slots class)))

(defmethod persistent-slots ((class standard-class)) --- /project/elephant/cvsroot/elephant/src/sql-controller.lisp 2005/11/23 17:51:38 1.2 +++ /project/elephant/cvsroot/elephant/src/sql-controller.lisp 2006/01/24 15:42:30 1.3 @@ -533,7 +533,7 @@ :where [and [= [clctn_id] clcn]] :database con ))) - (mapcar #'(lambda (x) (mapcar #'(lambda (q) (deserialize-from-base64-string :sc sc)) x)) + (mapcar #'(lambda (x) (mapcar #'(lambda (q) (deserialize-from-base64-string q :sc sc)) x)) tuples)))

(defmethod sql-from-root-existsp (key con)