[elephant-cvs] CVS elephant/tests

ieslick ieslick at common-lisp.net
Sat Nov 11 18:41:11 UTC 2006


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

Modified Files:
	delscript.sh elephant-tests.lisp testcollections.lisp 
	testsorter.lisp 
Added Files:
	testbdb.lisp 
Removed Files:
	testsleepycat.lisp 
Log Message:

Remove all references to sleepycat; change to bdb db-bdb or 
berkeley-db; passes all test for BDB and SQLite on Allegro/Mac OS/32-bit



--- /project/elephant/cvsroot/elephant/tests/delscript.sh	2006/09/04 05:01:07	1.1
+++ /project/elephant/cvsroot/elephant/tests/delscript.sh	2006/11/11 18:41:11	1.2
@@ -4,6 +4,6 @@
 rm testdb2/__*
 rm testdb2/%*
 rm testdb2/log*
-rm testsleepycat/testsleepycat
-rm testsleepycat/__*
-rm testsleepycat/log*
\ No newline at end of file
+rm testbdb/testsbdb
+rm testbdb/__*
+rm testbdb/log*
\ No newline at end of file
--- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2006/03/07 14:12:22	1.20
+++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp	2006/11/11 18:41:11	1.21
@@ -66,7 +66,7 @@
       (merge-pathnames 
        #p"tests/testdb/" 
        (asdf:component-pathname (asdf:find-system 'elephant-tests)))))
-  "The primary test spec for testing sleepycat")
+  "The primary test spec for testing berkeley db backends")
 
 (defvar *testbdb-spec2* 
   `(:bdb
@@ -110,7 +110,7 @@
 
 (defun do-backend-tests (&optional (spec *default-spec*))
   "Will test a specific backend based on the spec.  Note, 
-   if you run a :bdb backend test it will load sleepycat 
+   if you run a :bdb backend test it will load berkeley db
    specific tests which should silently succeed if you
    test another backend"
   (when (and (consp spec) (symbolp (car spec)))
@@ -178,10 +178,10 @@
 	   (class-slots (find-class class-name))))
 
 
-(defvar *sleepycatdb-spec* 
+(defvar *bdb-spec* 
   `(:bdb . ,(namestring
 	     (merge-pathnames 
-	      #p"tests/testsleepycat/" 
+	      #p"tests/testbdb/" 
 	      (asdf:component-pathname (asdf:find-system 'elephant-tests))))))
 
 
--- /project/elephant/cvsroot/elephant/tests/testcollections.lisp	2006/02/19 04:53:02	1.12
+++ /project/elephant/cvsroot/elephant/tests/testcollections.lisp	2006/11/11 18:41:11	1.13
@@ -705,7 +705,7 @@
 
 
 ;; This test not only does not work, it appears to 
-;; hang sleepycat forcing a recovery!?!?!?!
+;; hang BDB forcing a recovery!?!?!?!
 ;; (deftest cursor-put
 ;;     (let* ((ibt (make-indexed-btree *store-controller*)))
 ;;       (let (
--- /project/elephant/cvsroot/elephant/tests/testsorter.lisp	2006/02/04 22:25:10	1.2
+++ /project/elephant/cvsroot/elephant/tests/testsorter.lisp	2006/11/11 18:41:11	1.3
@@ -27,9 +27,9 @@
     (serialize a as)
     (serialize b bs)
     (< (lisp-compare (buffer-stream-buffer as) 
-		     (sleepycat::buffer-stream-size as)
+		     (db-bdb::buffer-stream-size as)
 		     (buffer-stream-buffer bs) 
-		     (sleepycat::buffer-stream-size bs)) 0)))
+		     (db-bdb::buffer-stream-size bs)) 0)))
 
 (defun lisp-cmp1 (a b)
   (with-buffer-streams (as bs)
@@ -38,9 +38,9 @@
     (serialize a as)
     (serialize b bs)
     (lisp-compare (buffer-stream-buffer as) 
-		  (sleepycat::buffer-stream-size as)
+		  (db-bdb::buffer-stream-size as)
 		  (buffer-stream-buffer bs) 
-		  (sleepycat::buffer-stream-size bs))))
+		  (db-bdb::buffer-stream-size bs))))
 
 (defvar myvec)
 (setq myvec (list 1 1/2 (- (expt 10 29)) (expt 10 29) most-positive-fixnum 

--- /project/elephant/cvsroot/elephant/tests/testbdb.lisp	2006/11/11 18:41:11	NONE
+++ /project/elephant/cvsroot/elephant/tests/testbdb.lisp	2006/11/11 18:41:11	1.1
;;; testbdb.lisp
;;;
;;; part of
;;;
;;; Elephant: an object-oriented database for Common Lisp
;;;
;;; Copyright (c) 2004 by Andrew Blumberg and Ben Lee
;;; <ablumberg at common-lisp.net> <blee at common-lisp.net>
;;;
;;; Elephant users are granted the rights to distribute and use this software
;;; as governed by the terms of the Lisp Lesser GNU Public License
;;; (http://opensource.franz.com/preamble.html), also known as the LLGPL.

(in-package "ELE-TESTS")


(defvar env)
(defvar db)

(defun prepare-bdb ()
  (setq env (db-bdb::db-env-create))
  (db-bdb::db-env-open env (cdr *bdb-spec*) :create t :init-txn t :init-lock t 
	       :init-mpool t :init-log t :thread t
	       :recover-fatal t)
  
  (setq db (db-bdb::db-create env))
  (db-bdb::db-open db :file "testsbdb" :database "bar" :type DB-BDB::DB-BTREE
		      :auto-commit t :create t :thread t))

(deftest prepares-bdb
    (progn
      (if (find-package :db-bdb)
	  (finishes (prepare-bdb))
	  (progn 
	    (format t "Berkeley DB not loaded, so not runnning test prepares-bdb~%")
	    t)))
  t)

#|
(deftest put-alot
    (finishes
     (loop for key in keys
	   do
	   (db-bdb::db-put db key key :auto-commit t)))
  t)
  
(defun get-alot ()
  (loop for key in keys
	always (string= key (db-bdb::db-get db key))))

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

(deftest put-alot-b 
    (finishes
     (with-transaction (:environment env)
       (loop for key in keys
	     do
	     (db-bdb::db-put db key key))))
  t)

(deftest put-right-b (get-alot) t)
|#

(defun test-sequence1 ()
  (let ((seq (db-bdb::db-sequence-create db)))
    (db-bdb::db-sequence-set-cachesize seq 1000)
    (db-bdb::db-sequence-set-flags seq :seq-inc t :seq-wrap t)
    (db-bdb::db-sequence-set-range seq 0 most-positive-fixnum)
    (db-bdb::db-sequence-initial-value seq (- most-positive-fixnum 99))
    (db-bdb::db-sequence-open seq "testseq1"
		      :auto-commit t :create t :thread t)
    (loop for i = (db-bdb::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 (db-bdb::db-sequence-remove seq :auto-commit t))))

(deftest test-seq1
    (if (not (find-package :db-bdb))
	(progn 
	  (format t "Berkeley db not loaded, so not runnning test test-seq1~%")
	     t)
    (finishes (test-sequence1)))
  t)

(defun test-sequence2 ()
  (let ((seq (db-bdb::db-sequence-create db)))
    (db-bdb::db-sequence-set-cachesize seq 1000)
    (db-bdb::db-sequence-set-flags seq :seq-dec t :seq-wrap t)
    (db-bdb::db-sequence-set-range seq most-negative-fixnum 0)
    (db-bdb::db-sequence-initial-value seq (+ most-negative-fixnum 99))
    (db-bdb::db-sequence-open seq "testseq2"
		      :auto-commit t :create t :thread t)
    (loop for i = (db-bdb::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 (db-bdb::db-sequence-remove seq :auto-commit t))))

(deftest test-seq2
    (if (not db)
	(progn 
	  (format t "BDB db not valid, so not runnning test test-seq2~%")
	  t)
	(finishes (test-sequence2)))
  t)

(defun cleanup-bdb ()
  (db-bdb::db-close db)
  (db-bdb::db-env-dbremove env "testsbdb" :database "bar")
  (db-bdb::db-env-close env)
  (setq env (db-bdb::db-env-create))
  (db-bdb::db-env-remove env "test"))

(deftest cleansup-bdb
    (if (not db)
	(progn 
	  (format t "Berkeley DB not open, so not runnning test cleanup-bdb~%")
	     t)
    (finishes (cleanup-bdb)))
  t)

;;(unuse-package "DB-BDB")
;;(use-package "ELE")

#|
(defun txn-alot (iters)
  (loop for i from 1 to iters
	do
	(with-transaction (:environment env)
	  (db-put db "mykey" "mydatum"))))	     

(defun get-alot-b (keys)
  (loop for key in keys
	do
	(db-get-buffered db key)))

(defun foreign-test (ln iters)
  (with-transaction (:environment env)
    (loop for i fixnum from 1 to iters
	  with write-buf of-type array-or-pointer-char = (uffi:allocate-foreign-object :char ln)
	  with str string = (make-string ln :initial-element #\c)
	  with key-buf of-type array-or-pointer-char = (uffi:allocate-foreign-object :char 2)
	  do
	  (copy-str-to-buf "fs" key-buf)
	  (copy-str-to-buf str write-buf)
	  (db-put-buffered db key-buf 2 write-buf ln)
	  finally 
	  (progn 
	    (uffi:free-foreign-object write-buf)
	    (uffi:free-foreign-object key-buf)))))

(defun cstring-test (ln iters)
  (with-transaction (:environment env)
    (loop for i fixnum from 1 to iters
	  with str string = (make-string ln :initial-element #\c)
	  do
	  (db-put db "fs" str))))
|#




More information about the Elephant-cvs mailing list