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)