[elephant-cvs] CVS elephant/tests

[ieslick]

Update of /project/elephant/cvsroot/elephant/tests
In directory common-lisp:/tmp/cvs-serv18474/tests

Modified Files:
	elephant-tests.lisp testindexing.lisp 
Log Message:

Quick fix for config.lisp not having a package designator.  Also my tweaks
to fix a BDB bug, adding transacctions to btree writes for increased safety
and various tweaks I made trying to fix the slot-boundp bug in indexing-redef-class



--- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2006/02/21 19:40:08	1.17
+++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2006/02/22 21:03:48	1.18
@@ -155,7 +155,6 @@
     (print (do-test 'indexing-reconnect-db))
     (print (do-test 'indexing-change-class))
     (print (do-test 'indexing-redef-class))
-    (print (do-test 'indexing-explicit-changes))
     (print (do-test 'indexing-timing))))
 
 (defun do-crazy-pg-tests()
--- /project/elephant/cvsroot/elephant/tests/testindexing.lisp	2006/02/22 20:18:54	1.9
+++ /project/elephant/cvsroot/elephant/tests/testindexing.lisp	2006/02/22 21:03:48	1.10
@@ -47,12 +47,11 @@
     (progn
       ;;(format t "Global vars:~%")
       ;;(format t "~%basic store: ~A  ~A~%" *store-controller* (elephant::controller-spec *store-controller*))
-      ;;(format t "auto-commit: ~A~%" *auto-commit*)
+;;      (format t "auto-commit: ~A~%" *auto-commit*)
 
-      (disable-class-indexing 'idx-one :errorp nil)
-
-;; Possibly under SBCL this really hoses things up!
-;;      (setf (find-class 'idx-one) nil)
+      (when (find-class 'idx-one nil)
+	(disable-class-indexing 'idx-one :errorp nil)
+	(setf (find-class 'idx-one nil) nil))
       
       (defclass idx-one ()
 	((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
@@ -76,7 +75,7 @@
 (deftest indexing-inherit
     (progn 
 ;;      (format t "inherit store: ~A  ~A~%" *store-controller* (controller-path *store-controller*))
-      
+
       (when (find-class 'idx-two nil)
 	(disable-class-indexing 'idx-two :sc *store-controller* :errorp nil)
 	(setf (find-class 'idx-two) nil))
@@ -123,7 +122,7 @@
       ;;      (format t "range store: ~A  ~A~%" *store-controller* (controller-path *store-controller*))
       (when (find-class 'idx-four nil)
 	(disable-class-indexing 'idx-four :errorp nil)
-	(setf (find-class 'idx-four) nil))
+	(setf (find-class 'idx-four nil) nil))
       
       (defclass idx-four ()
 	((slot1 :initarg :slot1 :initform 1 :accessor slot1 :index t))
@@ -166,8 +165,7 @@
 	 (slot3 :initarg :slot3 :initform 3 :accessor slot3 :index t))
 	(:metaclass persistent-metaclass))
 
-      (let ((*old-default* *default-indexed-class-synch-policy*)
-	    (*default-indexed-class-synch-policy* :db))
+      (let ((*default-indexed-class-synch-policy* :db))
 
       (format t "connect store: ~A  ~A~%" *store-controller* (elephant::controller-spec *store-controller*))
 	(with-transaction (:store-controller *store-controller*)
@@ -250,6 +248,8 @@
 	(disable-class-indexing 'idx-eight :errorp nil)
 	(setf (find-class 'idx-eight nil) nil))
 
+;;      (format t "sc: ~A  ct: ~A~%" *store-controller* *current-transaction*)
+
       (defclass idx-eight ()
 	((slot1 :accessor slot1 :initarg :slot1 :index t)
 	 (slot2 :accessor slot2 :initarg :slot2)
@@ -268,8 +268,8 @@
 	  ((slot1 :accessor slot1 :initarg :slot1 :initform 11)
 	   (slot2 :accessor slot2 :initarg :slot2 :initform 12 :index t)
 	   (slot3 :accessor slot3 :initarg :slot3 :initform 13)
-	   (slot6 :accessor slot6 :initarg :slot6 :initform 14 :index t)
-	   (slot7 :accessor slot7 :initarg :slot7))
+	   (slot7 :accessor slot7 :initarg :slot7)
+	   (slot6 :accessor slot6 :initarg :slot6 :index t))
 	  (:metaclass persistent-metaclass))
 
 	(values 
@@ -280,10 +280,13 @@
 	 (eq (slot3 o1) 13) ;; transient values not preserved (would be inconsistent)
 	 (and (not (slot-exists-p o1 'slot4))
 	      (not (slot-exists-p o1 'slot5))
-	      (signals-error (get-instances-by-value 'idx-eight 'slot4)))
+	      (signals-error (get-instances-by-value 'idx-eight 'slot4 4)))
 	 (and (eq (slot6 o1) 14)
 	      (eq (length (get-instances-by-value 'idx-eight 'slot6 14)) 2))
-	 (and (not (slot-boundp o1 'slot7))))))
+	 (and (slot-exists-p o1 'slot7)
+	      (not (slot-boundp o1 'slot7)))
+	 (and (slot-exists-p o2 'slot7)
+	      (not (slot-boundp o2 'slot7))))))
   t t t t t t)
 
 ;; create 500 objects, write each object's slots