[elephant-cvs] CVS elephant/tests
ieslick
ieslick at common-lisp.net
Sun Feb 4 10:08:28 UTC 2007
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)
More information about the Elephant-cvs
mailing list