[elephant-cvs] CVS elephant/src

[rread]

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)