[elephant-cvs] CVS elephant/tests

[rread]

Update of /project/elephant/cvsroot/elephant/tests
In directory clnet:/tmp/cvs-serv12286

Modified Files:
	testcollections.lisp 
Log Message:
Checking in a better tests, with a lot of debugging stuff included for now.


--- /project/elephant/cvsroot/elephant/tests/testcollections.lisp	2007/02/03 04:09:14	1.14
+++ /project/elephant/cvsroot/elephant/tests/testcollections.lisp	2007/02/04 00:07:45	1.15
@@ -174,7 +174,7 @@
     (let ((obj
 	   (get-value 1 index1)))
       	  (and (= (slot1 obj) 1)
-	       (= (slot2 obj) (* 1 100)))))
+ 	       (= (slot2 obj) (* 1 100)))))
 t)
 
 (deftest indexed-get-from-slot1
@@ -384,8 +384,8 @@
   t)
 
 (defun crunch (s k v)
-  (declare (ignore s v))
-  (values t (floor (/ k 10))))
+  (declare (ignore s k))
+  (values t (floor (/ (- v) 10))))
 
 (deftest add-indices2
     (finishes
@@ -408,18 +408,38 @@
   t)
 
 (deftest get-from-index3
-     (loop for i from 0 to 1000
-        always (= (* i -10) (get-value i index3)))
-   t)
+    (let ((v))
+;;    (trace get-value)
+;;    (trace crunch)
+    (unwind-protect 
+    (setf v (loop for i from 0 to 1000
+;;	  always (= (- i) (floor (/ (get-value i index3) 10)))))
+	  always 
+	  (multiple-value-bind (bool res)
+	      (crunch nil nil (get-value i index3))
+	    (= res i))))
+;;    (untrace))
+      )
+    v)
+  t)
 
 (deftest dup-test
     (with-transaction (:store-controller *store-controller*)
-      (with-btree-cursor (curs index3)
-	(loop for (more k v) = (multiple-value-list
-				(cursor-first curs))
-	      then (multiple-value-list (cursor-next-dup curs))
-	      while more
-	      collect v)))
+      (unwind-protect 
+	   (progn
+;;	     (trace cursor-first)
+;;	     (trace cursor-next-dup)
+;;	     (trace db-clsql::sql-get-from-clcn-nth)
+;;	     (trace db-clsql::has-key-value-scnd)
+	     (with-btree-cursor (curs index3)
+	       (loop for (more k v) = (multiple-value-list
+				       (cursor-first curs))
+		     then (multiple-value-list (cursor-next-dup curs))
+		     while more
+		     collect v)))
+	(untrace)
+	)
+      )
   (0 -1 -2 -3 -4 -5 -6 -7 -8 -9))
 	      
 
@@ -466,6 +486,14 @@
     ;; Note:  If this is not done inside a transaction,
     ;; it HANGS BDB!
     (with-transaction (:store-controller *store-controller*)
+      (unwind-protect 
+	   (progn
+;; 	     (trace cursor-first)
+;; 	     (trace cursor-next-dup)
+;; 	     (trace cursor-last)
+;; 	     (trace cursor-delete)
+;; 	     (trace get-value)
+;;	     (trace has-key-value)
       (let* ((ibt (make-indexed-btree *store-controller*))
 	     (id1 (add-index ibt :index-name 'idx1 :key-form 'odd)))
 	(loop for i from 0 to 10
@@ -478,15 +506,21 @@
 	  (cursor-last c)
 	  (cursor-delete c)
 	  )
-	(equal
-	(list
-	 (get-value 4 ibt)
-	 (get-value 5 ibt)
-	 (get-value 9 ibt)
-	 (get-value 10 ibt)
-	 )
-	'(16 25 nil 100))
+	(let ((res
+	       (equal
+		(list
+		 (get-value 4 ibt)
+		 (get-value 5 ibt)
+		 (get-value 9 ibt)
+		 (get-value 10 ibt)
+		 )
+		'(16 25 81 nil))))
+	  (untrace)
+	  res
+	  )
 	))
+      )
+      )
   t)
 
 (deftest indexed-delete 
@@ -525,23 +559,45 @@
 
 
 (deftest cur-del2 
-    (with-transaction (:store-controller *store-controller*)
-      (let* ((ibt (make-indexed-btree *store-controller*))
-	     (id1 (add-index ibt :index-name 'idx1 :key-form 'odd)))
-	(loop for i from 0 to 10
-	   do
-	   (setf (get-value i ibt) (* i i)))
-	(with-btree-cursor (c id1)
-	  (cursor-first c)
-	  (cursor-next-dup c)
-	  (cursor-delete c)
-	  )
-	(equal (list
-	 (get-value 1 id1) ;; 
-	 (get-value 0 id1) ;; This should be 0, but is returning nil!
-	 )
-	'(1 0))
-	))
+    (unwind-protect
+	 (with-transaction (:store-controller *store-controller*)
+	   (let* ((ibt (make-indexed-btree *store-controller*))
+		  (id1 (add-index ibt :index-name 'idx1 :key-form 'odd)))
+	     (progn
+	       (untrace)
+;; 	       (trace cursor-first)
+;; 	       (trace cursor-next-dup)
+;; 	       (trace cursor-last)
+;; 	       (trace cursor-delete)
+;; 	       (trace get-value)
+;; 	       (trace cursor-current)
+;; 	       (trace db-clsql::cursor-initialized-p)
+;; 	       (trace remove-kv)
+;; 	       (trace db-clsql::cursor-next-dup-x)
+;; 	       (trace db-clsql::has-key-value-scnd)
+;; 	       (trace db-clsql::sql-from-clcn-key-and-value-existsp)
+;; 	       (trace db-clsql::sql-add-to-clcn)
+;; 	       (trace odd)
+;; 	       (trace crunch)
+	       (loop for i from 0 to 10
+		     do
+		     (setf (get-value i ibt) (* i i)))
+	       (with-btree-cursor (c id1)
+		 (cursor-first c)
+		 (cursor-next-dup c)
+		 (cursor-delete c)
+		 )
+	       (let ((res
+		      (equal (list
+			      (get-value 1 id1)	;; 
+			      (get-value 0 id1)	;; This should be 0, but is returning nil!
+			      )
+			     '(1 0))))
+		 (untrace)
+		 res)
+	       )
+	     ))
+      (untrace))
   t)