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

Modified Files: elephant-tests.lisp testcollections.lisp testserializer.lisp Log Message: Fixed all but one outstanding bug in test suite; cur-del2 on SBCL with SQL backend fails; duplicate sorting dependencies removed from test suite

--- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2007/01/25 18:18:00 1.22 +++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2007/02/04 10:08:28 1.23 @@ -80,11 +80,19 @@ '(:clsql (:postgresql "localhost.localdomain" "test" "postgres" "")))

(defvar *testsqlite3-spec* - '(:clsql (:sqlite3 "sqlite3-test.db")) + `(:clsql (:sqlite3 + ,(namestring + (merge-pathnames + #p"tests/sqlite3-test.db" + (asdf:component-pathname (asdf:find-system 'elephant-tests)))))) "This is of the form '(filename &optional init-function),")

(defvar *testsqlite3-spec2* - '(:clsql (:sqlite3 "sqlite3-test2.db")) + `(:clsql (:sqlite3 + ,(namestring + (merge-pathnames + #p"tests/sqlite3-test2.db" + (asdf:component-pathname (asdf:find-system 'elephant-tests)))))) "This is of the form '(filename &optional init-function),")

(defvar *testsqlite3-memory-spec* --- /project/elephant/cvsroot/elephant/tests/testcollections.lisp 2007/02/04 00:07:45 1.15 +++ /project/elephant/cvsroot/elephant/tests/testcollections.lisp 2007/02/04 10:08:28 1.16 @@ -337,6 +337,14 @@ (values t (mod v 2) ))

+(defun twice (s k v) + (declare (ignore s k)) + (values t (* v 2))) + +(defun half-floor (s k v) + (declare (ignore s v)) + (values t (floor (/ k 2)))) + (deftest rem-idexkv (with-transaction (:store-controller *store-controller*) (let* ((ibt (make-indexed-btree *store-controller*)) @@ -425,21 +433,12 @@

(deftest dup-test (with-transaction (:store-controller *store-controller*) - (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) - ) - ) + (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))) (0 -1 -2 -3 -4 -5 -6 -7 -8 -9))

@@ -483,44 +482,22 @@ t)

(deftest cur-del1 - ;; 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 - do - (setf (get-value i ibt) (* i i))) -;; This appears to delete the SINGLE value pointed two by -;; the cursor at that time. (the way it is written now, the second-to-last element 9 = 81; -;; If you want to delete more, you have to iterate through the cursor, I suppose. - (with-btree-cursor (c id1) - (cursor-last c) - (cursor-delete c) - ) - (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 - ) - )) - ) - ) + (labels ((deleted (key others) + (and (null (get-value key ibt)) + (every #'(lambda (k2) + (= (get-value k2 ibt) (* k2 k2))) + others)))) + (loop for i from 0 to 5 do + (setf (get-value i ibt) (* i i))) + (with-btree-cursor (c id1) + (cursor-last c) + (cursor-delete c)) + (or (deleted 5 '(3 1)) + (deleted 3 '(5 1)) + (deleted 1 '(5 3)))))) t)

(deftest indexed-delete @@ -559,45 +536,21 @@

(deftest cur-del2 - (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)) + (with-transaction (:store-controller *store-controller*) + (let* ((ibt (make-indexed-btree *store-controller*)) + (id1 (add-index ibt :index-name 'idx1 :key-form 'half-floor))) + (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) + ) + (or (and (null (get-value 1 ibt)) + (eq (get-value 0 ibt) 0)) + (and (null (get-value 0 ibt)) + (eq (get-value 1 ibt) 1))))) t)

--- /project/elephant/cvsroot/elephant/tests/testserializer.lisp 2007/02/03 14:07:01 1.16 +++ /project/elephant/cvsroot/elephant/tests/testserializer.lisp 2007/02/04 10:08:28 1.17 @@ -255,9 +255,9 @@ (setf (gethash 'symbolsymbol ht) "three") (let ((out (in-out-value ht))) (are-not-null - (string= (gethash (cons nil nil) ht) "one") - (= (gethash 2 ht) 2.0d0) - (string= (gethash 'symbolsymbol ht) "three")))) + (string= (gethash (cons nil nil) out) "one") + (= (gethash 2 out) 2.0d0) + (string= (gethash 'symbolsymbol out) "three")))) t t t)

(defun type= (t1 t2)