Update of /project/elephant/cvsroot/elephant/tests In directory common-lisp.net:/tmp/cvs-serv4345/tests

Modified Files: testsleepycat.lisp testserializer.lisp testcollections.lisp Log Message: updates for sbcl unicode, sleepycat 4.3, new sequences and degree-2

Date: Thu Feb 24 02:06:06 2005 Author: blee

Index: elephant/tests/testsleepycat.lisp diff -u elephant/tests/testsleepycat.lisp:1.2 elephant/tests/testsleepycat.lisp:1.3 --- elephant/tests/testsleepycat.lisp:1.2 Thu Sep 16 06:28:05 2004 +++ elephant/tests/testsleepycat.lisp Thu Feb 24 02:06:05 2005 @@ -1,40 +1,35 @@

(in-package "ELE-TESTS") -(use-package "SLEEPYCAT") +;;(unuse-package "ELE") +;;(use-package "SLEEPYCAT")

(defvar env) (defvar db) -(defvar keys)

-(defun make-keys (iters) - (loop for i from 1 to iters - collect (concatenate 'string "key-" (prin1-to-string i)))) - -(setq keys (make-keys 1000)) - -(defun prepare() - (setq env (db-env-create)) - (db-env-open env "test" :create t :init-txn t :init-lock t +(defun prepare-sleepycat() + (setq env (sleepycat::db-env-create)) + (sleepycat::db-env-open env *sleepycatdb-path* :create t :init-txn t :init-lock t :init-mpool t :init-log t :thread t :recover-fatal t)

- (setq db (db-create env)) - (db-open db :file "foo" :database "bar" :type DB-BTREE + (setq db (sleepycat::db-create env)) + (sleepycat::db-open db :file "testsleepycat" :database "bar" :type SLEEPYCAT::DB-BTREE :auto-commit t :create t :thread t))

-(deftest prepares - (finishes (prepare)) t) +(deftest prepares-sleepycat + (finishes (prepare-sleepycat)) t)

+#| (deftest put-alot (finishes (loop for key in keys do - (db-put db key key :auto-commit t))) + (sleepycat::db-put db key key :auto-commit t))) t)

(defun get-alot () (loop for key in keys - always (string= key (db-get db key)))) + always (string= key (sleepycat::db-get db key))))

(deftest put-right (get-alot) t)

@@ -43,11 +38,65 @@ (with-transaction (:environment env) (loop for key in keys do - (db-put db key key)))) + (sleepycat::db-put db key key)))) t)

(deftest put-right-b (get-alot) t) +|# + +(defun test-sequence1 () + (let ((seq (sleepycat::db-sequence-create db))) + (sleepycat::db-sequence-set-cachesize seq 1000) + (sleepycat::db-sequence-set-flags seq :seq-inc t :seq-wrap t) + (sleepycat::db-sequence-set-range seq 0 most-positive-fixnum) + (sleepycat::db-sequence-initial-value seq (- most-positive-fixnum 99)) + (sleepycat::db-sequence-open seq "testseq1" + :auto-commit t :create t :thread t) + (loop for i = (sleepycat::db-sequence-get-fixnum seq 1 :auto-commit t :txn-nosync t) + for j from (- most-positive-fixnum 99) to most-positive-fixnum + while (> i 0) + do + (assert (= i j)) + finally (sleepycat::db-sequence-remove seq :auto-commit t)))) + +(deftest test-seq1 + (finishes (test-sequence1)) + t) + +(defun test-sequence2 () + (let ((seq (sleepycat::db-sequence-create db))) + (sleepycat::db-sequence-set-cachesize seq 1000) + (sleepycat::db-sequence-set-flags seq :seq-dec t :seq-wrap t) + (sleepycat::db-sequence-set-range seq most-negative-fixnum 0) + (sleepycat::db-sequence-initial-value seq (+ most-negative-fixnum 99)) + (sleepycat::db-sequence-open seq "testseq2" + :auto-commit t :create t :thread t) + (loop for i = (sleepycat::db-sequence-get-fixnum seq 1 :auto-commit t :txn-nosync t) + for j from (+ most-negative-fixnum 99) downto most-negative-fixnum + while (< i 0) + do + (assert (= i j)) + finally (sleepycat::db-sequence-remove seq :auto-commit t))))

+(deftest test-seq2 + (finishes (test-sequence2)) + t) + +(defun cleanup-sleepycat () + (sleepycat::db-close db) + (sleepycat::db-env-dbremove env "testsleepycat" :database "bar") + (sleepycat::db-env-close env) + (setq env (sleepycat::db-env-create)) + (sleepycat::db-env-remove env "test")) + +(deftest cleansup-sleepycat + (finishes (cleanup-sleepycat)) + t) + +;;(unuse-package "SLEEPYCAT") +;;(use-package "ELE") + +#| (defun txn-alot (iters) (loop for i from 1 to iters do @@ -80,12 +129,5 @@ with str string = (make-string ln :initial-element #\c) do (db-put db "fs" str)))) - -(defun cleanup () - (db-close db) - - (db-env-dbremove env "foo" :database "bar") - (db-env-close env) - (setq env (db-env-create)) - (db-env-remove env "test")) +|#

Index: elephant/tests/testserializer.lisp diff -u elephant/tests/testserializer.lisp:1.5 elephant/tests/testserializer.lisp:1.6 --- elephant/tests/testserializer.lisp:1.5 Thu Sep 16 06:27:19 2004 +++ elephant/tests/testserializer.lisp Thu Feb 24 02:06:05 2005 @@ -96,6 +96,14 @@ (in-out-equal (/ (expt 2 200) (- (expt 3 300))))) t t t t t t t)

+(deftest base-strings + (are-not-null + (in-out-equal (make-string 0 :element-type 'base-char)) + (in-out-equal (coerce "this is a test" 'base-string)) + (in-out-equal (make-string 400 :initial-element (code-char 127) + :element-type 'base-char))) + t t t) + (deftest strings (are-not-null (in-out-equal "")

Index: elephant/tests/testcollections.lisp diff -u elephant/tests/testcollections.lisp:1.2 elephant/tests/testcollections.lisp:1.3 --- elephant/tests/testcollections.lisp:1.2 Sun Sep 19 19:52:51 2004 +++ elephant/tests/testcollections.lisp Thu Feb 24 02:06:05 2005 @@ -14,7 +14,7 @@ (slot2 :accessor slot2 :initarg :slot2)))

(defvar keys (loop for i from 1 to 1000 - collect (concatenate 'string "key-" (prin1-to-string i)))) + collect (concatenate 'base-string "key-" (prin1-to-string i))))

(defvar objs (loop for i from 1 to 1000 collect (make-instance 'blob @@ -46,12 +46,14 @@ (= (slot2 obj) (* i 100)))) t)

+(defvar first-key (first keys)) + (deftest remove-kv - (finishes (with-transaction () (remove-kv "key-1" bt))) + (finishes (with-transaction () (remove-kv first-key bt))) t)

(deftest removed - (not (get-value "key-1" bt)) + (not (get-value first-key bt)) t)

(deftest map-btree @@ -146,12 +148,12 @@ t) (deftest remove-kv-indexed - (finishes (remove-kv "key-1" indexed)) + (finishes (remove-kv first-key indexed)) t)

(deftest no-key-nor-indices (values - (get-value "key-1" indexed) + (get-value first-key indexed) (get-primary-key 1 index1) (get-primary-key 100 index2)) nil nil nil) @@ -162,7 +164,7 @@

(deftest no-key-nor-indices-slot1 (values - (get-value "key-2" indexed) + (get-value (second keys) indexed) (get-primary-key 2 index1) (get-primary-key 200 index2)) nil nil nil) @@ -173,7 +175,7 @@

(deftest no-key-nor-indices-slot2 (values - (get-value "key-3" indexed) + (get-value (third keys) indexed) (get-primary-key 3 index1) (get-primary-key 300 index2)) nil nil nil)