[elephant-cvs] CVS update: elephant/tests/elephant-tests.lisp elephant/tests/mop-tests.lisp elephant/tests/testcollections.lisp elephant/tests/testserializer.lisp
Robert L. Read
rread at common-lisp.net
Tue Oct 18 20:41:35 UTC 2005
Update of /project/elephant/cvsroot/elephant/tests
In directory common-lisp.net:/tmp/cvs-serv16451/tests
Modified Files:
Tag: SQL-BACK-END
elephant-tests.lisp mop-tests.lisp testcollections.lisp
testserializer.lisp
Log Message:
Differences of existing files based on sql-back-end work
Date: Tue Oct 18 22:41:33 2005
Author: rread
Index: elephant/tests/elephant-tests.lisp
diff -u elephant/tests/elephant-tests.lisp:1.5 elephant/tests/elephant-tests.lisp:1.5.2.1
--- elephant/tests/elephant-tests.lisp:1.5 Thu Feb 24 02:07:51 2005
+++ elephant/tests/elephant-tests.lisp Tue Oct 18 22:41:32 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,35 @@
;;"/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*
+'("localhost.localdomain" "test" "postgres" ""))
+
(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 +159,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.7.2.1
--- elephant/tests/mop-tests.lisp:1.7 Thu Feb 24 02:07:51 2005
+++ elephant/tests/mop-tests.lisp Tue Oct 18 22:41:32 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.3.2.1
--- elephant/tests/testcollections.lisp:1.3 Thu Feb 24 02:06:05 2005
+++ elephant/tests/testcollections.lisp Tue Oct 18 22:41:32 2005
@@ -1,12 +1,32 @@
(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
+ (if (typep *store-controller* 'sql-store-controller)
+ *testpg-path*
+ *testdb-path*))))
+ (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 +44,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
@@ -49,7 +75,8 @@
(defvar first-key (first keys))
(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 +93,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 +109,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 +144,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 +159,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 +196,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 +210,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 +227,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 +240,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 +249,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 +258,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 +267,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 +276,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 +285,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 +294,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 +302,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 +379,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 +398,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 +413,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 +424,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 +434,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 +443,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 +452,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 +495,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 +513,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 +567,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 +585,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 +607,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.6.2.1
--- elephant/tests/testserializer.lisp:1.6 Thu Feb 24 02:06:05 2005
+++ elephant/tests/testserializer.lisp Tue Oct 18 22:41:32 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)
+
+
+
More information about the Elephant-cvs
mailing list