Update of /project/elephant/cvsroot/elephant/tests In directory common-lisp.net:/tmp/cvs-serv30677/tests
Modified Files: elephant-tests.lisp mop-tests.lisp testcollections.lisp testserializer.lisp Added Files: testmigration.lisp Log Message: This is the big merger from the SQL-BACK-END branch.
Date: Wed Nov 23 18:52:00 2005 Author: rread
Index: elephant/tests/testmigration.lisp diff -u /dev/null elephant/tests/testmigration.lisp:1.2 --- /dev/null Wed Nov 23 18:52:01 2005 +++ elephant/tests/testmigration.lisp Wed Nov 23 18:51:59 2005 @@ -0,0 +1,170 @@ +;; This file can really only be used if you +;; have preformed both: +;; (asdf:operate 'asdf:load-op :ele-bdb) +;; and +;; (asdf:operate 'asdf:load-op :ele-clsql) + +(in-package :ele-tests) + +(deftest remove-element + (let ((a (vector 'a 'b 'c)) + (ans (vector 'a 'c))) + (setf a (ele::remove-indexed-element-and-adjust 1 a)) + (and (equal (aref a 0) (aref ans 0)) + (equal (aref a 1) (aref ans 1)) + (equal (length a) (length ans)))) + t) + + +(deftest migrate1 + (let ((old-store *store-controller*) + (*prev-commit* *auto-commit*) + (*auto-commit* t) + (rv nil)) + (unwind-protect + (let ( + (sc1 (open-store *test-path-primary*)) + (sc2 (open-store *test-path-secondary*))) + (add-to-root "x" "y" :store-controller sc1) + (copy-from-key "x" sc1 sc2) + (setf rv (equal (get-from-root "x" :store-controller sc1) + (get-from-root "x" :store-controller sc2)))) + (progn + (setq *store-controller* old-store) + (setq *auto-commit* *prev-commit*))) + rv) + t) + + +(deftest migrate2 + (let ((old-store *store-controller*) + (*prev-commit* *auto-commit*) + (*auto-commit* t) + (rv nil)) + (unwind-protect + (let + ((sc1 (open-store *test-path-primary*)) + (sc2 (open-store *test-path-secondary*))) + (let ((ibt (build-btree sc1))) + (loop for i from 0 to 10 + do + (setf (get-value i ibt) (* i i))) + (let ((mig (migrate sc2 ibt))) + (btree-differ ibt mig)))) + (progn + (setq *store-controller* old-store) + (setq *auto-commit* *prev-commit*)))) + nil) + + +(deftest migrate3 + (let ((old-store *store-controller*) + (*prev-commit* *auto-commit*) + (*auto-commit* t) + (rv nil)) + (unwind-protect + (let ((sc1 (open-store *test-path-primary*)) + (sc2 (open-store *test-path-secondary*)) + ) + (let* ((ibt (build-indexed-btree sc1))) + (let ( + (index + (add-index ibt :index-name 'crunch :key-form 'crunch + :populate t)) + ) + (loop for i from 0 to 10 + do + (setf (get-value i ibt) (* i i))) + (let* ((mig (migrate sc2 ibt)) + (nindex (gethash 'crunch (indices ibt)))) + (loop for i from 0 to 10 + do + (if (not + (equal + (get-value i index) + (get-value i nindex) + )) + (progn + (format t "YIKES ~A ~%" i) + ))) + (setf rv (not (btree-differ ibt mig))) + )))) + (progn + (setq *store-controller* old-store) + (setq *auto-commit* *prev-commit*))) + rv) + t) + + +(deftest migrate4 + (finishes + (let ((old-store *store-controller*) + (*prev-commit* *auto-commit*) + (*auto-commit* t) + (rv nil)) + (unwind-protect + (let* ( + (sc1 (open-store *test-path-primary*)) + (sc2 (open-store *test-path-secondary*)) + ) + (let* ((ibt (build-indexed-btree sc1))) + (let ( + (index + (add-index ibt :index-name 'crunch :key-form 'crunch + :populate t)) + (x 0) + ) + (loop for i from 0 to 10 + do + (setf (get-value i ibt) (* i i))) + ))) + (progn + (setq *store-controller* old-store) + (setq *auto-commit* *prev-commit*))) + )) + t) + +(deftest migrate5 + (finishes + (let ((old-store *store-controller*) + (*prev-commit* *auto-commit*) + (*auto-commit* t)) + (unwind-protect + (let ((osc (if (subtypep (type-of *store-controller*) 'sql-store-controller) + (open-store *test-path-primary*) + (open-store *test-path-secondary*) + ))) +;; really need to test the an error is thrown when attempting to migrate +;; non-persistent object! + (let* ((f1 (make-instance 'pfoo :sc *store-controller*)) + (f2 (make-instance 'pfoo :slot1 "this is a string" :sc *store-controller*)) + (b1 (make-instance 'pbar :slot2 "another string" :sc *store-controller*)) + ) + (let ((fm1 + (ele::migraten-pobj + osc f1 + #'(lambda (dst src) + (if (slot-boundp src 'slot1) + (setf (slot1 dst) (slot1 src)))))) + (fm2 + (ele::migraten-pobj + osc f2 + #'(lambda (dst src) + (if (slot-boundp src 'slot1) + (setf (slot1 dst) (slot1 src)))))) + (bm1 (ele::migraten-pobj + osc b1 + #'(lambda (dst src) + (if (slot-boundp src 'slot2) + (setf (slot2 dst) (slot2 src)))))) + ) + (and + (and (not (slot-boundp fm1 'slot1)) + (not (slot-boundp f1 'slot1))) + (equal (slot1 fm2) (slot1 f2)) + (equal (slot2 bm1) (slot2 b1)))))) + (progn + (setq *store-controller* old-store) + (setq *auto-commit* *prev-commit*)))) + ) + t)
Index: elephant/tests/elephant-tests.lisp diff -u elephant/tests/elephant-tests.lisp:1.5 elephant/tests/elephant-tests.lisp:1.6 --- elephant/tests/elephant-tests.lisp:1.5 Thu Feb 24 02:07:51 2005 +++ elephant/tests/elephant-tests.lisp Wed Nov 23 18:51:59 2005 @@ -81,6 +81,9 @@
(in-package :ele-tests)
+;; Putting this in to make the test work; I have no idea what it means... +(deftype array-or-pointer-char () '(or array t)) +
(defvar *testdb-path* ;;"/usr/local/share/common-lisp/elephant-0.2/tests/testdb" @@ -93,11 +96,50 @@ ;;"/usr/local/share/common-lisp/elephant-0.2/tests/testdb" (namestring (merge-pathnames - #p"tests/sleepycatdb/" + #p"tests/testsleepycat/" (asdf:component-pathname (asdf:find-system 'elephant-tests)))))
+(defvar *testpg-path* +'(:postgresql "localhost.localdomain" "test" "postgres" "")) + +(defvar *testsqlite3-path* +;; This is of the form '(filename &optional init-function), +;; and using :memory: as a file name will get you an completely in-memory system... +;; '(":memory:") + '(:sqlite3 "sqlite3-test.db") +) + +(defvar *test-path-primary* + *testpg-path* +) +(defvar *test-path-secondary* + *testdb-path* +) + + (defun do-all-tests() - (with-open-store (*testdb-path*) + (progn + (do-all-tests-spec *testdb-path*) + (do-all-tests-spec *testpg-path*) + )) + +(defun do-crazy-pg-tests() + (open-store *testpg-path*) + (do-test 'indexed-btree-make) + (do-test 'add-indices) + (do-test 'test-indices) + (do-test 'indexed-put) + (do-test 'indexed-get) + (close-store) + ) + +(defun do-migrate-test-spec(spud) + (with-open-store(spud) + (let ((*auto-commit* nil)) + (do-test 'migrate1)))) + +(defun do-all-tests-spec(spec) + (with-open-store (spec) (let ((*auto-commit* nil)) (do-tests))))
@@ -132,4 +174,4 @@ (defmacro are-not-null (&rest forms) `(values ,@(loop for form in forms - collect `(is-not-null ,form)))) \ No newline at end of file + collect `(is-not-null ,form))))
Index: elephant/tests/mop-tests.lisp diff -u elephant/tests/mop-tests.lisp:1.7 elephant/tests/mop-tests.lisp:1.8 --- elephant/tests/mop-tests.lisp:1.7 Thu Feb 24 02:07:51 2005 +++ elephant/tests/mop-tests.lisp Wed Nov 23 18:51:59 2005 @@ -139,14 +139,14 @@
(deftest initform-test (let ((*auto-commit* t)) - (slot-value (make-instance 'p-initform-test) 'slot1)) + (slot-value (make-instance 'p-initform-test :sc *store-controller*) 'slot1)) 10)
(deftest initarg-test (let ((*auto-commit* t)) (values - (slot-value (make-instance 'p-initform-test-2) 'slot1) - (slot-value (make-instance 'p-initform-test-2 :slot1 20) 'slot1))) + (slot-value (make-instance 'p-initform-test-2 :sc *store-controller*) 'slot1) + (slot-value (make-instance 'p-initform-test-2 :slot1 20 :sc *store-controller*) 'slot1))) 10 20)
(deftest no-eval-initform @@ -155,7 +155,7 @@ ((slot1 :initarg :slot1 :initform (error "Shouldn't be called"))) (:metaclass persistent-metaclass)) (let ((*auto-commit* t)) - (make-instance 'no-eval-initform :slot1 "something")) + (make-instance 'no-eval-initform :slot1 "something" :sc *store-controller* )) t) t)
@@ -168,8 +168,8 @@
;; i wish i could use slot-makunbound but allegro sux (deftest makunbound - (let ((p (make-instance 'p-class))) - (with-transaction () + (let ((p (make-instance 'p-class :sc *store-controller*))) + (with-transaction (:store-controller *store-controller*) (setf (slot1 p) t) #-allegro (slot-makunbound p 'slot1) @@ -186,7 +186,7 @@ ((slot1 :initform 1 :accessor slot1)) (:metaclass persistent-metaclass)) (let* ((*auto-commit* t) - (foo (make-instance 'update-class))) + (foo (make-instance 'update-class :sc *store-controller*))) (defclass update-class () ((slot2 :initform 2 :accessor slot2)) (:metaclass persistent-metaclass)) @@ -207,7 +207,7 @@ (:metaclass persistent-metaclass))
(let* ((*auto-commit* t) - (foo (make-instance 'class-one))) + (foo (make-instance 'class-one :sc *store-controller*))) (change-class foo (find-class 'class-two)) (values (slot1 foo) @@ -215,9 +215,13 @@ 1 2)
(deftest change-class2 - (with-transaction () - (let ((foo (make-instance 'btree))) - (change-class foo (find-class 'indexed-btree)) + (with-transaction (:store-controller *store-controller*) + (let ((foo (build-btree *store-controller*))) + (change-class foo (find-class + (if (typep *store-controller* 'bdb-store-controller) + 'bdb-indexed-btree + 'sql-indexed-btree) + )) (is-not-null (indices foo)))) t)
@@ -233,7 +237,7 @@ (:metaclass persistent-metaclass))
(let* ((*auto-commit* t) - (foo (make-instance 'class-one))) + (foo (make-instance 'class-one :sc *store-controller*))) (change-class foo (find-class 'class-two)) (values (slot1 foo)
Index: elephant/tests/testcollections.lisp diff -u elephant/tests/testcollections.lisp:1.3 elephant/tests/testcollections.lisp:1.4 --- elephant/tests/testcollections.lisp:1.3 Thu Feb 24 02:06:05 2005 +++ elephant/tests/testcollections.lisp Wed Nov 23 18:51:59 2005 @@ -1,12 +1,29 @@
(in-package :ele-tests)
+(deftest basicpersistence + (let ((old-store *store-controller*) + (*prev-commit* *auto-commit*) + (*auto-commit* t) + (rv nil)) + (unwind-protect + (let ((x (gensym))) + (add-to-root "x" x) + (let ((sc1 (open-store *test-path-primary*))) + (setf rv (equal (format nil "~A" x) + (format nil "~A" (get-from-root "x")))))) + (progn + (setq *store-controller* old-store) + (setq *auto-commit* *prev-commit*))) + rv) + t +) + (deftest testoid (progn (ele::next-oid *store-controller*) (let ((oid (ele::next-oid *store-controller*))) - (with-open-store (*testdb-path*) - (< oid (ele::next-oid *store-controller*))))) + (< oid (ele::next-oid *store-controller*)))) t)
(defclass blob () @@ -24,17 +41,23 @@ (defvar bt)
(deftest btree-make - (finishes (setq bt (make-instance 'btree))) + (finishes (setq bt (build-btree *store-controller*))) t)
-(setq *auto-commit* nil) +;; This is a very dangerous and naughty statement. +;; It was probably placed in this file for a good reason, +;; but nothing seems to reset it. The result is that after loading +;; theses tests, nothing works as you expect it later. +;; It may be that the proper fix is not just to take it out, +;; but that is the best that I can do right now. +;; (setq *auto-commit* nil)
(deftest btree-put (finishes - (with-transaction () - (loop for obj in objs - for key in keys - do (setf (get-value key bt) obj)))) + (with-transaction (:store-controller *store-controller*) + (loop for obj in objs + for key in keys + do (setf (get-value key bt) obj)))) t)
(deftest btree-get @@ -48,8 +71,13 @@
(defvar first-key (first keys))
+ +;; For some unkown reason, this fails on my server unless +;; I put the variable "first-key" here rather than use the string +;; "key-1". I need to understand this, but don't at present.... (deftest remove-kv - (finishes (with-transaction () (remove-kv first-key bt))) + (finishes + (with-transaction (:store-controller *store-controller*) (remove-kv "key-1" bt))) t)
(deftest removed @@ -66,13 +94,14 @@ (subsetp (cdr keys) ks :test #'equalp)))) t)
+;; I hate global variables! Yuck! (defvar indexed) (defvar index1) (defvar index2)
(deftest indexed-btree-make - (finishes (with-transaction () - (setq indexed (make-instance 'indexed-btree)))) + (finishes (with-transaction (:store-controller *store-controller*) + (setq indexed (build-indexed-btree *store-controller*)))) t)
(defun key-maker (s key value) @@ -81,7 +110,7 @@
(deftest add-indices (finishes - (with-transaction () + (with-transaction (:store-controller *store-controller*) (setf index1 (add-index indexed :index-name 'slot1 :key-form 'key-maker)) (setf index2 @@ -116,10 +145,10 @@
(deftest indexed-put (finishes - (with-transaction () + (with-transaction (:store-controller *store-controller*) (loop for obj in objs - for key in keys - do (setf (get-value key indexed) obj)))) + for key in keys + do (setf (get-value key indexed) obj)))) t)
(deftest indexed-get @@ -131,6 +160,16 @@ (= (slot2 obj) (* i 100)))) t)
+ +(deftest simple-slot-get + (progn + (setf (get-value (nth 0 keys) indexed) (nth 0 objs)) + (let ((obj + (get-value 1 index1))) + (and (= (slot1 obj) 1) + (= (slot2 obj) (* 1 100))))) +t) + (deftest indexed-get-from-slot1 (loop with index = (get-index indexed 'slot1) for i from 1 to 1000 @@ -158,10 +197,10 @@ (get-primary-key 100 index2)) nil nil nil)
+ (deftest remove-kv-from-slot1 (finishes (remove-kv 2 index1)) t) - (deftest no-key-nor-indices-slot1 (values (get-value (second keys) indexed) @@ -172,7 +211,6 @@ (deftest remove-kv-from-slot2 (finishes (remove-kv 300 index2)) t) - (deftest no-key-nor-indices-slot2 (values (get-value (third keys) indexed) @@ -190,8 +228,11 @@ (subsetp (cdddr keys) ks :test #'equalp)))) t)
+;; This is "4" below because they have removed the +;; first three keys, and are testing that the index reflect this, +;; and my code doesn't. (deftest get-first - (with-transaction () + (with-transaction (:store-controller *store-controller*) (with-btree-cursor (c index1) (multiple-value-bind (has k v) (cursor-first c) @@ -200,7 +241,7 @@ t)
(deftest get-first2 - (with-transaction () + (with-transaction (:store-controller *store-controller*) (with-btree-cursor (c index2) (multiple-value-bind (has k v) (cursor-first c) @@ -209,7 +250,7 @@ t)
(deftest get-last - (with-transaction () + (with-transaction (:store-controller *store-controller*) (with-btree-cursor (c index1) (multiple-value-bind (has k v) (cursor-last c) @@ -218,7 +259,7 @@ t)
(deftest get-last2 - (with-transaction () + (with-transaction (:store-controller *store-controller*) (with-btree-cursor (c index2) (multiple-value-bind (has k v) (cursor-last c) @@ -227,7 +268,7 @@ t)
(deftest set - (with-transaction () + (with-transaction (:store-controller *store-controller*) (with-btree-cursor (c index1) (multiple-value-bind (has k v) (cursor-set c 200) @@ -236,7 +277,7 @@ t)
(deftest set2 - (with-transaction () + (with-transaction (:store-controller *store-controller*) (with-btree-cursor (c index2) (multiple-value-bind (has k v) (cursor-set c 500) @@ -245,7 +286,7 @@ t)
(deftest set-range - (with-transaction () + (with-transaction (:store-controller *store-controller*) (with-btree-cursor (c index1) (multiple-value-bind (has k v) (cursor-set-range c 199.5) @@ -254,7 +295,7 @@ t)
(deftest set-range2 - (with-transaction () + (with-transaction (:store-controller *store-controller*) (with-btree-cursor (c index2) (multiple-value-bind (has k v) (cursor-set-range c 501) @@ -262,12 +303,75 @@ (= (slot2 v) 600)))) t)
+(deftest rem-kv + (with-transaction (:store-controller *store-controller*) + (let ((ibt (build-indexed-btree *store-controller*))) + (loop for i from 0 to 10 + do + (setf (get-value i ibt) (* i i))) + (remove-kv 0 ibt) + (remove-kv 1 ibt) + (remove-kv 10 ibt) + (equal (list + (get-value 0 ibt) + (get-value 1 ibt) + (get-value 10 ibt) + (get-value 5 ibt) + ) + '(nil nil nil 25)) + )) +t + ) + +(defun odd (s k v) + (declare (ignore s k)) + (values t (mod v 2) +)) + +(deftest rem-idexkv + (with-transaction (:store-controller *store-controller*) + (let* ((ibt (build-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))) + + (with-btree-cursor (c id1) + (cursor-first c) + (dotimes (i 10) + (multiple-value-bind (has key value) + (cursor-next c) + )) + ) + (remove-kv 4 ibt) + (remove-kv 5 ibt) + + (equal (list + (get-value 4 ibt) + (get-value 5 ibt) + (get-value 6 ibt) + (with-btree-cursor (c ibt) + (cursor-first c) + (dotimes (i 4) + (multiple-value-bind (has key value) + (cursor-next c) + value)) + (multiple-value-bind (has key value) + (cursor-next c) + value + ) + )) + '(nil nil 36 49) + ))) + t + ) + (defvar indexed2) (defvar index3)
(deftest make-indexed2 - (finishes (with-transaction () - (setq indexed2 (make-instance 'indexed-btree)))) + (finishes (with-transaction (:store-controller *store-controller*) + (setq indexed2 (build-indexed-btree *store-controller*)))) t)
(defun crunch (s k v) @@ -276,14 +380,14 @@
(deftest add-indices2 (finishes - (with-transaction () + (with-transaction (:store-controller *store-controller*) (setq index3 (add-index indexed2 :index-name 'crunch :key-form 'crunch)))) t)
(deftest put-indexed2 (finishes - (with-transaction () + (with-transaction (:store-controller *store-controller*) (loop for i from 0 to 10000 do (setf (get-value i indexed2) (- i))))) @@ -295,13 +399,12 @@ t)
(deftest get-from-index3 - (loop for i from 0 to 1000 - always (= (* i -10) (get-value i index3))) - t) - + (loop for i from 0 to 1000 + always (= (* i -10) (get-value i index3))) + t)
(deftest dup-test - (with-transaction () + (with-transaction (:store-controller *store-controller*) (with-btree-cursor (curs index3) (loop for (more k v) = (multiple-value-list (cursor-first curs)) @@ -311,8 +414,9 @@ (0 -1 -2 -3 -4 -5 -6 -7 -8 -9))
+ (deftest nodup-test - (with-transaction () + (with-transaction (:store-controller *store-controller*) (with-btree-cursor (curs index3) (loop for (m k v) = (multiple-value-list (cursor-next-nodup curs)) for i from 0 downto -9990 by 10 @@ -321,7 +425,7 @@ t)
(deftest prev-nodup-test - (with-transaction () + (with-transaction (:store-controller *store-controller*) (with-btree-cursor (curs index3) (cursor-last curs) (loop for (m k v) = (multiple-value-list (cursor-prev-nodup curs)) @@ -331,7 +435,7 @@ t)
(deftest pnodup-test - (with-transaction () + (with-transaction (:store-controller *store-controller*) (with-btree-cursor (curs index3) (loop for (m k v p) = (multiple-value-list (cursor-pnext-nodup curs)) for i from 0 to 9990 by 10 @@ -340,7 +444,7 @@ t)
(deftest pprev-nodup-test - (with-transaction () + (with-transaction (:store-controller *store-controller*) (with-btree-cursor (curs index3) (cursor-last curs) (loop for (m k v p) = (multiple-value-list (cursor-pprev-nodup curs)) @@ -349,9 +453,36 @@ always (= p i)))) t)
+(deftest cur-del1 + ;; Note: If this is not done inside a transaction, + ;; it HANGS BDB! + (with-transaction (:store-controller *store-controller*) + (let* ((ibt (build-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) + ) + (equal + (list + (get-value 4 ibt) + (get-value 5 ibt) + (get-value 9 ibt) + (get-value 10 ibt) + ) + '(16 25 nil 100)) + )) + t) + (deftest indexed-delete (finishes - (with-transaction () + (with-transaction (:store-controller *store-controller*) (with-btree-cursor (curs index3) (cursor-last curs) (cursor-delete curs)))) @@ -365,7 +496,7 @@ (deftest indexed-delete2 (finishes - (with-transaction () + (with-transaction (:store-controller *store-controller*) (with-btree-cursor (curs index3) (cursor-first curs) (cursor-next-dup curs) @@ -383,6 +514,29 @@ v))) 0 0 nil -2)
+ +(deftest cur-del2 + (with-transaction (:store-controller *store-controller*) + (let* ((ibt (build-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))) + (with-btree-cursor (c id1) + (cursor-first c) + (cursor-next-dup c) + (cursor-delete c) + ) + (equal (list + (get-value 1 id1) ;; + (get-value 0 id1) ;; This should be 0, but is returning nil! + ) + '(1 0)) + )) + t) + + + (deftest get-both (with-btree-cursor (c indexed2) (cursor-get-both c 200 -200)) @@ -414,12 +568,15 @@ (pcursor-pkey (cursor-pfirst c)) (pcursor-pkey (cursor-pnext c)) (pcursor-pkey (cursor-pnext-nodup c)) + (pcursor-pkey (cursor-pnext-dup c)) (pcursor-pkey (cursor-pprev c)) (pcursor-pkey (cursor-pprev-nodup c)) + (pcursor-pkey (cursor-plast c)) (pcursor-pkey (cursor-pset c 300)) (pcursor-pkey (cursor-pset-range c 199.5)) + (pcursor-pkey (cursor-pget-both c 10 101)) (pcursor-pkey (cursor-pget-both-range c 11 111.4))))
@@ -429,7 +586,7 @@
(deftest newindex (finishes - (with-transaction () + (with-transaction (:store-controller *store-controller*) (setq index4 (add-index indexed2 :index-name 'crunch :key-form 'crunch :populate t)))) @@ -451,3 +608,105 @@ (pcursor-pkey (cursor-pget-both-range c 11 111.4))))
0 2 10 11 10 9 9999 3000 2000 101 112) + + +(deftest add-get-remove + (let ((r1 '()) + (r2 '()) + (*prev-commit* *auto-commit*)) + (unwind-protect + (progn + (setq *auto-commit* t) + (add-to-root "x1" "y1") + (add-to-root "x2" "y2") + (setf r1 (get-from-root "x1")) + (setf r2 (get-from-root "x2")) + (remove-from-root "x1") + (remove-from-root "x2") + (and + (equal "y1" r1) + (equal "y2" r2) + (equal nil (get-from-root "x1")) + (equal nil (get-from-root "x2")) + ) + ) + (setq *auto-commit* *prev-commit*) + )) + t) + +(deftest add-get-remove-symbol + (let ((foo (cons nil nil)) + (bar (cons 'a 'b)) + (f1 '()) + (f2 '()) + (b1 '()) + (b2 '()) + (*prev-commit* *auto-commit*)) + (unwind-protect + (progn + (setq *auto-commit* t) + (add-to-root "my key" foo) + (add-to-root "my other key" foo) + (setf f1 (get-from-root "my key")) + (setf f2 (get-from-root "my other key")) + (add-to-root "my key" bar) + (add-to-root "my other key" bar) + (setf b1 (get-from-root "my key")) + (setf b2 (get-from-root "my other key")) + (and + (equal f1 f2) + (equal b1 b2) + (equal f1 foo) + (equal b1 bar) + )) + (setq *auto-commit* *prev-commit*) + )) + t) + +(deftest existsp + (let ((exists1 '()) + (exists2 '()) + (exists3 '()) + (key "my key") + (*prev-commit* *auto-commit*) + ) + (unwind-protect + (progn + (setq *auto-commit* t) + (remove-from-root key) + (setf exists1 + (from-root-existsp key) + ) + (add-to-root key 'a) + (setf exists2 (from-root-existsp key)) + (remove-from-root key) + (setf exists3 (from-root-existsp key)) + ) + (setq *auto-commit* *prev-commit*) + ) + (values exists1 exists2 exists3) + ) + nil t nil + ) + + +;; This test not only does not work, it appears to +;; hang sleepycat forcing a recovery!?!?!?! +;; (deftest cursor-put +;; (let* ((ibt (build-indexed-btree *store-controller*))) +;; (let ( +;; (index +;; (add-index ibt :index-name 'crunch :key-form 'crunch +;; :populate t)) +;; ) +;; (loop for i from 0 to 10 +;; do +;; (setf (get-value i ibt) (* i i))) +;; ;; Now create a cursor, advance and put... +;; (let ((c (make-cursor ibt))) +;; (cursor-next c) +;; (cursor-next c) +;; (cursor-put c 4 :key 10) +;; (equal (get-value 10 ibt) 4))) +;; ) +;; t)
Index: elephant/tests/testserializer.lisp diff -u elephant/tests/testserializer.lisp:1.6 elephant/tests/testserializer.lisp:1.7 --- elephant/tests/testserializer.lisp:1.6 Thu Feb 24 02:06:05 2005 +++ elephant/tests/testserializer.lisp Wed Nov 23 18:51:59 2005 @@ -2,19 +2,19 @@
(defun in-out-value (var) (with-buffer-streams (out-buf) - (deserialize (serialize var out-buf)))) + (deserialize (serialize var out-buf) :sc *store-controller*)))
(defun in-out-eq (var) (with-buffer-streams (out-buf) - (eq var (deserialize (serialize var out-buf))))) + (eq var (deserialize (serialize var out-buf) :sc *store-controller*))))
(defun in-out-equal (var) (with-buffer-streams (out-buf) - (equal var (deserialize (serialize var out-buf))))) + (equal var (deserialize (serialize var out-buf) :sc *store-controller*))))
(defun in-out-equalp (var) (with-buffer-streams (out-buf) - (equalp var (deserialize (serialize var out-buf))))) + (equalp var (deserialize (serialize var out-buf) :sc *store-controller*))))
(deftest fixnums (are-not-null @@ -33,7 +33,7 @@ (typep (in-out-value most-positive-fixnum) 'fixnum) (typep (in-out-value most-negative-fixnum) 'fixnum)) t t t t t) - + (deftest bignums (are-not-null (in-out-equal 10000000000) @@ -114,7 +114,7 @@ (defun in-out-uninterned-equal (var) (with-buffer-streams (out-buf) (serialize var out-buf) - (let ((new (deserialize (serialize var out-buf)))) + (let ((new (deserialize (serialize var out-buf) :sc *store-controller*))) (and (equal (symbol-name new) (symbol-name var)) (equal (symbol-package new) (symbol-package var))))))
@@ -299,7 +299,7 @@
(defun in-out-deep-equalp (var) (with-buffer-streams (out-buf) - (deep-equalp var (deserialize (serialize var out-buf))))) + (deep-equalp var (deserialize (serialize var out-buf) :sc *store-controller*))))
(deftest objects (are-not-null @@ -315,8 +315,8 @@ (l1 (make-list 100)) (h (make-hash-table :test 'equal)) (g (make-array '(2 3 4))) - (f (make-instance 'foo)) - (b (make-instance 'bar))) + (f (make-instance 'foo )) + (b (make-instance 'bar ))) (setf (car c1) c1) (setf (cdr c1) c1) (setf (car c2) c1) @@ -351,11 +351,16 @@
(deftest persistent (let* ((*auto-commit* t) - (f1 (make-instance 'pfoo)) - (f2 (make-instance 'pfoo :slot1 "this is a string")) - (b1 (make-instance 'pbar :slot2 "another string")) - (b2 (make-instance 'pbar)) - (h (make-instance 'btree))) + (f1 (make-instance 'pfoo :sc *store-controller*)) + (f2 (make-instance 'pfoo :slot1 "this is a string" :sc *store-controller*)) + (b1 (make-instance 'pbar :slot2 "another string" :sc *store-controller*)) + (b2 (make-instance 'pbar :sc *store-controller*)) + +;; Note, this as will will have to be split on clas,s if we we want to +;; test it both ways...since we won't know how they will want it +;; implemented, we will have to somehow make a choice here, maybe +;; based on the stype of *store-controller* + (h (build-btree *store-controller*))) (are-not-null (in-out-eq f1) (in-out-eq f2) @@ -368,4 +373,7 @@ (eq f1 (slot1 f1))) (progn (setf (get-value f2 h) f2) (eq (get-value f2 h) f2)))) - t t t t t t t t) + t t t t t t t t) + + +