- elephant-cvs@lists.common-lisp.net - mailman3.common-lisp.net

[elephant-cvs] CVS update: elephant/tests/testsleepycat.lisp elephant/tests/testserializer.lisp elephant/tests/testcollections.lisp
by blee＠common-lisp.net 24 Feb '05

24 Feb '05

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)

1 0

[elephant-cvs] CVS update: elephant/src/libsleepycat.c
by blee＠common-lisp.net 24 Feb '05

24 Feb '05

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv4315/src Modified Files: libsleepycat.c Log Message: updates for wide char strings, etc Date: Thu Feb 24 02:04:14 2005 Author: blee Index: elephant/src/libsleepycat.c diff -u elephant/src/libsleepycat.c:1.10 elephant/src/libsleepycat.c:1.11 --- elephant/src/libsleepycat.c:1.10 Fri Oct 8 02:53:04 2004 +++ elephant/src/libsleepycat.c Thu Feb 24 02:04:13 2005 @@ -56,6 +56,7 @@ */ #include <string.h> +#include <wchar.h> /* Pointer arithmetic utility functions */ /* should these be in network-byte order? probably not..... */ @@ -227,9 +228,9 @@ double read_num(char *buf); int case_cmp(const char *a, int32_t length1, const char *b, int32_t length2); +int lex_cmp(const char *a, int32_t length1, const char *b, int32_t length2); int utf16_cmp(const char *s1, int32_t length1, const char *s2, int32_t length2); -int lex_cmp(const char *a, int32_t length1, const char *b, int32_t length2); /* Inspired by the Sleepycat docs. We have to memcpy to insure memory alignment. */ @@ -279,6 +280,10 @@ case 13: /* 16-bit string */ case 14: /* 16-bit pathname */ return utf16_cmp(ad+9, read_int(ad, 5), bd+9, read_int(bd, 5)); + case 20: + case 21: + case 22: + return wcs_cmp(ad+9, read_int(ad, 5), bd+9, read_int(bd, 5)); default: return lex_cmp(ad+5, (a->size)-5, bd+5, (b->size)-5); } @@ -387,6 +392,16 @@ return diff; } +int wcs_cmp(const wchar_t *a, int32_t length1, + const wchar_t *b, int32_t length2) { + int min, sizediff, diff; + sizediff = length1 - length2; + min = sizediff > 0 ? length2 : length1; + diff = wcsncmp(a, b, min /4); + if (diff == 0) return sizediff; + return diff; +} + int lex_cmp(const char *a, int32_t length1, const char *b, int32_t length2) { int min, sizediff, diff; sizediff = length1 - length2; @@ -724,6 +739,99 @@ int db_txnp_begin(DB_ENV *env, DB_TXN *parent, DB_TXN **txnp, u_int32_t flags) { return env->txn_begin(env, parent, txnp, flags); +} + +/* Sequences */ + +DB_SEQUENCE * db_sequence_create2(DB *db, u_int32_t flags, int *errno) { + DB_SEQUENCE * seq; + *errno = db_sequence_create(&seq, db, flags); + return seq; +} + +int db_sequence_open(DB_SEQUENCE *seq, DB_TXN *txnid, + char *key, u_int32_t key_size, u_int32_t flags) { + DBT DBTKey; + memset(&DBTKey, 0, sizeof(DBT)); + DBTKey.data = key; + DBTKey.size = key_size; + + return seq->open(seq, txnid, &DBTKey, flags); +} + +int db_sequence_close(DB_SEQUENCE *seq, u_int32_t flags) { + return seq->close(seq, flags); +} + +/* db_seq_t = int64_t */ +const unsigned int bitmask_32bits = 0xFFFFFFFF; +#define lower_u32bits(int64) ((unsigned int) int64 & bitmask_32bits) +#define upper_u32bits(int64) ((unsigned int) (int64 >> 32)) +#define UUto64(low, high) ((((u_int64_t)high) << 32) | (u_int64_t)low) +#define lower_32bits(int64) ((int) int64 & bitmask_32bits) +#define upper_32bits(int64) ((int) (int64 >> 32)) +#define USto64(low, high) ((((int64_t)high) << 32) | (u_int64_t)low) + +int db_sequence_get(DB_SEQUENCE *seq, DB_TXN *txnid, int32_t delta, + u_int32_t *lowp, int32_t *highp, u_int32_t flags) { + db_seq_t next; + int ret; + + ret = seq->get(seq, txnid, delta, &next, flags); + *lowp = lower_u32bits(next); + *highp = upper_32bits(next); + return ret; +} + +int db_sequence_get_lower(DB_SEQUENCE *seq, DB_TXN *txnid, int32_t delta, + int32_t *lowp, u_int32_t flags) { + db_seq_t next; + int ret; + + ret = seq->get(seq, txnid, delta, &next, flags); + *lowp = (int)lower_32bits(next); + return ret; +} + +/* Typo in the sleepycat docs! */ +int db_sequence_initial_value(DB_SEQUENCE *seq, u_int32_t low, + int32_t high) { + return seq->initial_value(seq, USto64(low, high)); +} + +int db_sequence_remove(DB_SEQUENCE *seq, DB_TXN *txnid, u_int32_t flags) { + return seq->remove(seq, txnid, flags); +} + +int db_sequence_set_cachesize(DB_SEQUENCE *seq, int32_t size) { + return seq->set_cachesize(seq, size); +} + +int db_sequence_get_cachesize(DB_SEQUENCE *seq, int32_t *sizep) { + return seq->get_cachesize(seq, sizep); +} + +int db_sequence_set_flags(DB_SEQUENCE *seq, u_int32_t flags) { + return seq->set_flags(seq, flags); +} + +int db_sequence_set_range(DB_SEQUENCE *seq, u_int32_t minlow, + int32_t minhigh, u_int32_t maxlow, + int32_t maxhigh) { + return seq->set_range(seq, USto64(minlow, minhigh), USto64(maxlow, maxhigh)); +} + +int db_sequence_get_range(DB_SEQUENCE *seq, u_int32_t *minlowp, + int32_t *minhighp, u_int32_t *maxlowp, + int32_t *maxhighp) { + int64_t min, max; + int errno; + errno = seq->get_range(seq, &min, &max); + *minlowp = lower_u32bits(min); + *minhighp = upper_32bits(min); + *maxlowp = lower_u32bits(max); + *maxhighp = upper_32bits(max); + return errno; } /* Locks and timeouts */

1 0

[elephant-cvs] CVS update: elephant/INSTALL
by blee＠common-lisp.net 08 Oct '04

08 Oct '04

Update of /project/elephant/cvsroot/elephant In directory common-lisp.net:/tmp/cvs-serv13197 Modified Files: INSTALL Log Message: update-class test fails -- warn the user Date: Fri Oct 8 04:32:36 2004 Author: blee Index: elephant/INSTALL diff -u elephant/INSTALL:1.10 elephant/INSTALL:1.11 --- elephant/INSTALL:1.10 Fri Oct 8 02:53:04 2004 +++ elephant/INSTALL Fri Oct 8 04:32:36 2004 @@ -203,6 +203,7 @@ (do-all-tests) this should take about 5 minutes on decent hardware. Note -that the "no-eval-initform" test fails, this is a known bug -which will get fixed in a future release. +that the "no-eval-initform" and "update-class" tests fail, +these are known bugs which will get fixed in a future +release.

1 0

[elephant-cvs] CVS update: elephant/ChangeLog
by blee＠common-lisp.net 08 Oct '04

08 Oct '04

Update of /project/elephant/cvsroot/elephant In directory common-lisp.net:/tmp/cvs-serv7335 Modified Files: ChangeLog Log Message: Update Date: Fri Oct 8 03:01:46 2004 Author: blee Index: elephant/ChangeLog diff -u elephant/ChangeLog:1.3 elephant/ChangeLog:1.4 --- elephant/ChangeLog:1.3 Sun Sep 19 20:04:09 2004 +++ elephant/ChangeLog Fri Oct 8 03:01:45 2004 @@ -1,3 +1,56 @@ +2004-10-07 19:57 blee + + * src/libsleepycat.def: win32 fixes (thanks to Bill Clementson) + +2004-10-07 19:53 blee + + * CREDITS, INSTALL, NEWS, src/libsleepycat.c: win32 fixes (thanks + to Bill Clementson) + +2004-09-25 13:57 blee + + * src/collections.lisp: because of allocation type weirdness, + should always init indices-cache + +2004-09-21 14:36 blee + + * tests/mop-tests.lisp: new tests for change class, update class + +2004-09-21 14:36 blee + + * src/collections.lisp: make shared-init on indexed-btree play nice + +2004-09-21 14:35 blee + + * src/classes.lisp: added preliminary support for change-class + (though redef class is broken.) + +2004-09-21 14:34 blee + + * TODO: update + +2004-09-20 20:38 blee + + * Makefile: no install anymore, should be local to asdf + +2004-09-20 20:37 blee + + * src/sleepycat.lisp, tests/elephant-tests.lisp: use asdf packaging + info + +2004-09-20 20:35 blee + + * src/elephant.lisp: typo: forgot remove-from-root + +2004-09-20 20:34 blee + + * src/collections.lisp: typo: forgot populate keyword on generic + add-index + +2004-09-19 13:04 blee + + * ChangeLog: automagic! + 2004-09-19 12:52 blee * tests/testcollections.lisp: tests for :populate

1 0

[elephant-cvs] CVS update: elephant/src/libsleepycat.def
by blee＠common-lisp.net 08 Oct '04

08 Oct '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv6524/src Added Files: libsleepycat.def Log Message: win32 fixes (thanks to Bill Clementson) Date: Fri Oct 8 02:57:12 2004 Author: blee

1 0

[elephant-cvs] CVS update: elephant/NEWS elephant/INSTALL elephant/CREDITS
by blee＠common-lisp.net 08 Oct '04

08 Oct '04

Update of /project/elephant/cvsroot/elephant In directory common-lisp.net:/tmp/cvs-serv6453 Modified Files: NEWS INSTALL CREDITS Log Message: win32 fixes (thanks to Bill Clementson) Date: Fri Oct 8 02:53:04 2004 Author: blee Index: elephant/NEWS diff -u elephant/NEWS:1.5 elephant/NEWS:1.6 --- elephant/NEWS:1.5 Sun Sep 19 19:38:25 2004 +++ elephant/NEWS Fri Oct 8 02:53:04 2004 @@ -1,3 +1,8 @@ +October 7, 2004 - + +Elephant 0.2.1 released. Thanks to Bill Clementson, +Elephant should compile on Win32 now. Also, a few minor +fixups. September 19, 2004 - Index: elephant/INSTALL diff -u elephant/INSTALL:1.9 elephant/INSTALL:1.10 --- elephant/INSTALL:1.9 Sun Sep 19 19:37:03 2004 +++ elephant/INSTALL Fri Oct 8 02:53:04 2004 @@ -4,25 +4,29 @@ ------------ CMUCL 19a, SBCL 0.8.14, OpemMCL 0.14.2, or Allegro CL 6.2. -I've tested under x86 FreeBSD, Linux and PPC Darwin. A -Lispworks version will come if requested. +I've tested under x86 FreeBSD, Linux and PPC Darwin. I +can't personally test Win32 but I've compiled under Visual +Studio .NET and a user has gotten it to work with Visual +Studio 6. A Lispworks version will come if requested. ASDF - http://www.cliki.net/asdf -UFFI 1.4.24/5 - http://uffi.b9.com +UFFI 1.4.24+ - http://uffi.b9.com I've patched src/functions.lisp to support some kinds of :out arguments. it is backwards-compatible so shouldn't interfere with your existing work. It is included in -1.4.25, but just in case you have 1.4.24 I have included it. +1.4.25+, but just in case you have 1.4.24 I have included +it. Sleepycat Berkeley DB 4.2 - http://www.sleepycat.com The version number is important -- the headers have changed -siginificantly. +siginificantly. When 4.3 comes out, I'll have to reroll my +constants..... -A C compiler. Presumably you have this if you installed -Sleepycat. +A C compiler, probably gcc or Visual Studio. Presumably you +have this if you installed Sleepycat. ------------ Instructions @@ -34,22 +38,27 @@ /usr/local/share/common-lisp/elephant-0.1/ -1) Install UFFI 1.4.24. Replace +1) Install UFFI. If you're using 1.4.24 replace path-to-uffi/src/functions.lisp with the provided file. -2) Install Berkeley DB 4.2. You may actually already have -this installed. FreeBSD has a port for this, as I'm sure -do other BSDs (including Darwin/Fink.) Take note of where -libdb.so and db.h are installed (usually +2) Install Berkeley DB 4.2. Under Un*x, you may actually +already have this installed, though it may be compiled with +funny options, so if things don't work you may want to try +to start from scratch. FreeBSD has a port for this, as I'm +sure do other BSDs (including Darwin/Fink.) Take note of +where libdb.so and db.h are installed (usually /usr/local/BerekleyDB.4.2/lib/libdb.so and /usr/local/BerekleyDB.4.2/include/db.h, or /usr/local/lib/db42/libdb.so and /usr/local/include/db42/db.h.) -3) Edit Makefile and run (using GNU make, gmake on BSD) +3) Compile and install the libsleepycat shared library. + +Under Un*x, edit Makefile and run (using GNU make, gmake on +BSD) make install @@ -60,10 +69,28 @@ or where you specified. On Darwin / OS X you need to have the developer tools installed. +For Win32 (directions courtesy of Bill Clementson): + +Create an MSVC dll project and add src/libsleepycat.c, +src/libsleepycat.def and the Berkeley DB libdb42.lib files +to the project (should be in the build_win32/release folder) + +Add the Berkeley DB dbinc include files directory and the +build_win32/release directory (where the Berkeley DB install +instructions builds the Berkeley DB objects by default) to +the build directories for the project + +Build the Elephant DLL file + +Since you've statically included libdb42.lib inside +libsleepycat.c, it may or may not be necessary to load +libdb42.dll into Lisp (see below.) + 4) Compile and load Elephant: First, edit src/sleepycat.lisp so that it points to the -correct libraries. +correct libraries. If you're using Un*x and ASDF, this is +probably automagic. Symlink elephant.asd to your asdf systems directory (mine is /usr/local/share/common-lisp/systems). Fire up lisp and Index: elephant/CREDITS diff -u elephant/CREDITS:1.3 elephant/CREDITS:1.4 --- elephant/CREDITS:1.3 Sun Sep 19 19:36:22 2004 +++ elephant/CREDITS Fri Oct 8 02:53:04 2004 @@ -18,6 +18,8 @@ Rafal Strzalinski for the Makefile and package patch +Bill Clementson for Win32 help and publicity + The common-lisp.net people for hosting The CMUCL and SBCL people for great compilers

1 0

[elephant-cvs] CVS update: elephant/src/libsleepycat.c
by blee＠common-lisp.net 08 Oct '04

08 Oct '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv6453/src Modified Files: libsleepycat.c Log Message: win32 fixes (thanks to Bill Clementson) Date: Fri Oct 8 02:53:04 2004 Author: blee Index: elephant/src/libsleepycat.c diff -u elephant/src/libsleepycat.c:1.9 elephant/src/libsleepycat.c:1.10 --- elephant/src/libsleepycat.c:1.9 Sun Sep 19 19:50:22 2004 +++ elephant/src/libsleepycat.c Fri Oct 8 02:53:04 2004 @@ -55,6 +55,8 @@ ;;; */ +#include <string.h> + /* Pointer arithmetic utility functions */ /* should these be in network-byte order? probably not..... */ int read_int(char *buf, int offset) { @@ -101,8 +103,6 @@ return p + offset; } -#include <string.h> - void copy_buf(char *dest, int dest_offset, char *src, int src_offset, int length) { memcpy(dest + dest_offset, src + src_offset, length); @@ -226,6 +226,10 @@ #include <math.h> double read_num(char *buf); +int case_cmp(const char *a, int32_t length1, const char *b, int32_t length2); +int utf16_cmp(const char *s1, int32_t length1, + const char *s2, int32_t length2); +int lex_cmp(const char *a, int32_t length1, const char *b, int32_t length2); /* Inspired by the Sleepycat docs. We have to memcpy to insure memory alignment. */ @@ -320,6 +324,7 @@ } return result; case 7: + default: switch ((++buf)[0]) { case 1: result = (double)read_int(++buf, 0); @@ -334,6 +339,7 @@ } break; case 6: + default: result = 0; buf += 5; limit = buf + read_uint(buf, -4); @@ -355,6 +361,7 @@ } return result / denom; case 6: + default: denom = 0; buf += 5; limit = buf + read_uint(buf, -4); @@ -365,6 +372,11 @@ } } } + +#ifdef WIN32 +#define strncasecmp _strnicmp +typedef unsigned short uint16_t; +#endif int case_cmp(const char *a, int32_t length1, const char *b, int32_t length2) { int min, sizediff, diff;

1 0

[elephant-cvs] CVS update: elephant/src/collections.lisp
by blee＠common-lisp.net 25 Sep '04

25 Sep '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv19911/src Modified Files: collections.lisp Log Message: because of allocation type weirdness, should always init indices-cache Date: Sat Sep 25 20:57:37 2004 Author: blee Index: elephant/src/collections.lisp diff -u elephant/src/collections.lisp:1.10 elephant/src/collections.lisp:1.11 --- elephant/src/collections.lisp:1.10 Tue Sep 21 21:36:03 2004 +++ elephant/src/collections.lisp Sat Sep 25 20:57:37 2004 @@ -103,9 +103,8 @@ (defmethod shared-initialize :after ((instance indexed-btree) slot-names &rest rest) - (declare (ignore rest)) - (if (member 'indices slot-names :test #'eq) - (setf (indices-cache instance) (indices instance)))) + (declare (ignore slot-names rest)) + (setf (indices-cache instance) (indices instance))) (defgeneric add-index (bt &key index-name key-form populate) (:documentation

1 0

[elephant-cvs] CVS update: elephant/tests/mop-tests.lisp
by blee＠common-lisp.net 21 Sep '04

21 Sep '04

Update of /project/elephant/cvsroot/elephant/tests In directory common-lisp.net:/tmp/cvs-serv4131/tests Modified Files: mop-tests.lisp Log Message: new tests for change class, update class Date: Tue Sep 21 21:36:35 2004 Author: blee Index: elephant/tests/mop-tests.lisp diff -u elephant/tests/mop-tests.lisp:1.5 elephant/tests/mop-tests.lisp:1.6 --- elephant/tests/mop-tests.lisp:1.5 Thu Sep 16 06:26:08 2004 +++ elephant/tests/mop-tests.lisp Tue Sep 21 21:36:34 2004 @@ -177,4 +177,45 @@ (find-slot-def 'p-class 'slot1)) ) (signals-condition (slot1 p))) + t) + +(deftest update-class + (progn + (defclass update-class () + ((slot1 :initform 1 :accessor slot1)) + (:metaclass persistent-metaclass)) + (let* ((*auto-commit* t) + (foo (make-instance 'update-class))) + (defclass update-class () + ((slot2 :initform 2 :accessor slot2)) + (:metaclass persistent-metaclass)) + (values + (slot2 foo) + (signals-condition (slot1 foo))))) + 2 t) + +(deftest change-class + (progn + (defclass class-one () + ((slot1 :initform 1 :accessor slot1)) + (:metaclass persistent-metaclass)) + + (defclass class-two () + ((slot1 :initform 0 :accessor slot1) + (slot2 :initform 2 :accessor slot2)) + (:metaclass persistent-metaclass)) + + (let* ((*auto-commit* t) + (foo (make-instance 'class-one))) + (change-class foo (find-class 'class-two)) + (values + (slot1 foo) + (slot2 foo)))) + 1 2) + +(deftest change-class2 + (with-transaction () + (let ((foo (make-instance 'btree))) + (change-class foo (find-class 'indexed-btree)) + (is-not-null (indices foo)))) t)

1 0

[elephant-cvs] CVS update: elephant/src/collections.lisp
by blee＠common-lisp.net 21 Sep '04

21 Sep '04

Update of /project/elephant/cvsroot/elephant/src In directory common-lisp.net:/tmp/cvs-serv2520/src Modified Files: collections.lisp Log Message: make shared-init on indexed-btree play nice Date: Tue Sep 21 21:36:04 2004 Author: blee Index: elephant/src/collections.lisp diff -u elephant/src/collections.lisp:1.9 elephant/src/collections.lisp:1.10 --- elephant/src/collections.lisp:1.9 Tue Sep 21 03:34:31 2004 +++ elephant/src/collections.lisp Tue Sep 21 21:36:03 2004 @@ -103,8 +103,9 @@ (defmethod shared-initialize :after ((instance indexed-btree) slot-names &rest rest) - (declare (ignore slot-names rest)) - (setf (indices-cache instance) (indices instance))) + (declare (ignore rest)) + (if (member 'indices slot-names :test #'eq) + (setf (indices-cache instance) (indices instance)))) (defgeneric add-index (bt &key index-name key-form populate) (:documentation

1 0