[elephant-cvs] CVS update: elephant/tests/testsleepycat.lisp elephant/tests/testserializer.lisp elephant/tests/testcollections.lisp
blee at common-lisp.net
blee at common-lisp.net
Thu Feb 24 01:06:10 UTC 2005
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)
More information about the Elephant-cvs
mailing list