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) + + +