elephant-cvs

elephant-cvs@common-lisp.net

858 discussions

[elephant-cvs] CVS elephant/src/elephant
by ieslick 29 Apr '07

29 Apr '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv12328/src/elephant Modified Files: classes.lisp classindex.lisp collections.lisp unicode2.lisp Log Message: Fixes for lispworks in tests & deadlock detect; fixes for openmcl in pointer manipulation --- /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/04/27 13:32:16 1.33 +++ /project/elephant/cvsroot/elephant/src/elephant/classes.lisp 2007/04/29 02:10:54 1.34 @@ -273,18 +273,21 @@ "Ensures that object can be written as a reference into store sc" (eq (dbcn-spc-pst object) (controller-spec sc))) -(define-condition cross-reference-error () +(define-condition cross-reference-error (error) ((object :accessor cross-reference-error-object :initarg :object) (home-controller :accessor cross-reference-error-home-controller :initarg :home-ctrl) (foreign-controller :accessor cross-reference-error-foreign-controller :initarg :foreign-ctrl)) (:documentation "An error condition raised when an object is being written into a data store other - than its home store")) + than its home store") + (:report (lambda (condition stream) + (format stream "Attempted to write object ~A with home store ~A into store ~A" + (cross-reference-error-object condition) + (cross-reference-error-home-controller condition) + (cross-reference-error-foreign-controller condition))))) (defun signal-cross-reference-error (object sc) (cerror "Proceed to write incorrect reference" 'cross-reference-error - :format-control "Attempted to write object ~A with home store ~A into store ~A" - :format-arguments (list object (get-con object) sc) :object object :home-ctrl (get-con object) :foreign-ctrl sc)) --- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/04/28 03:07:38 1.41 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/04/29 02:10:54 1.42 @@ -84,18 +84,17 @@ (let ((class (find-class class-name nil))) (when class (indexed class)))) -(define-condition persistent-class-not-indexed (error) - ((class-obj :initarg :class :initarg nil :reader unindexed-class-obj))) - +(define-condition persistent-class-not-indexed () + ((class-obj :initarg :class :initarg nil :reader unindexed-class-obj)) + (:report (lambda (condition stream) + (format stream "Class ~A is not enabled for indexing" + (class-name (unindexed-class-obj condition)))))) + (defun signal-class-not-indexed (class) (cerror "Ignore and continue?" 'persistent-class-not-indexed - :format-control "Class ~A is not enabled for indexing" - :format-arguments (list (class-name class)) :class class)) -;; (define-condition - (defmethod find-class-index ((class persistent-metaclass) &key (sc *store-controller*) (errorp t)) (ensure-finalized class) (if (not (indexed class)) --- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/04/28 17:18:33 1.29 +++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/04/29 02:10:54 1.30 @@ -74,13 +74,6 @@ (:documentation "Delete all key-value pairs from the btree and render it an invalid object in the data store")) -(defmethod drop-btree ((bt btree)) - (ensure-transaction (:store-controller *store-controller*) - (with-btree-cursor (cur bt) - (loop for (exists? key) = (multiple-value-list (cursor-first cur)) - then (multiple-value-list (cursor-next cur)) - while exists? - do (remove-kv key bt))))) ;; ;; Btrees that support secondary indices @@ -380,7 +373,6 @@ different key.) Returns has-tuple / secondary key / value / primary key.")) - (defmacro with-btree-cursor ((var bt) &body body) "Macro which opens a named cursor on a BTree (primary or not), evaluates the forms, then closes the cursor." @@ -389,6 +381,14 @@ (progn ,@body) (cursor-close ,var)))) +(defmethod drop-btree ((bt btree)) + (ensure-transaction (:store-controller *store-controller*) + (with-btree-cursor (cur bt) + (loop for (exists? key) = (multiple-value-list (cursor-first cur)) + then (multiple-value-list (cursor-next cur)) + while exists? + do (remove-kv key bt))))) + ;; ======================================= ;; Generic Mapping Functions ;; ======================================= --- /project/elephant/cvsroot/elephant/src/elephant/unicode2.lisp 2007/04/12 02:47:33 1.8 +++ /project/elephant/cvsroot/elephant/src/elephant/unicode2.lisp 2007/04/29 02:10:55 1.9 @@ -83,13 +83,13 @@ (let ((code (char-code (schar string i)))) (declare (type fixnum code)) (when (> code #xFF) (fail)) - (setf (uffi:deref-array buffer 'array-or-pointer-char (+ i size)) code)))) + (setf (uffi:deref-array buffer '(:array :unsigned-char) (+ i size)) code)))) (string (loop for i fixnum from 0 below characters do (let ((code (char-code (char string i)))) (declare (type fixnum code)) (when (> code #xFF) (fail)) - (setf (uffi:deref-array buffer 'array-or-pointer-char (+ i size)) code))))) + (setf (uffi:deref-array buffer '(:array :unsigned-char) (+ i size)) code))))) (setf (buffer-stream-size bstream) needed) (succeed)))))) @@ -120,20 +120,20 @@ (loop for i fixnum from 0 below characters do (let ((code (char-code (schar string i)))) (when (> code #xFFFF) (fail)) - (setf (uffi:deref-array buffer 'array-or-pointer-char (+ (* i 2) size)) + (setf (uffi:deref-array buffer '(:array :unsigned-char) (+ (* i 2) size)) ;; (coerce (ldb (byte 8 8) code) '(signed 8))) (ldb (byte 8 8) code)) - (setf (uffi:deref-array buffer 'array-or-pointer-char (+ (* i 2) size 1)) + (setf (uffi:deref-array buffer '(:array :unsigned-char) (+ (* i 2) size 1)) ;; (coerce (ldb (byte 8 0) code) '(signed 8)))))) (ldb (byte 8 0) code))))) (string (loop for i fixnum from 0 below characters do (let ((code (char-code (schar string i)))) (when (> code #xFFFF) (fail)) - (setf (uffi:deref-array buffer 'array-or-pointer-char (+ (* i 2) size)) + (setf (uffi:deref-array buffer '(:array :unsigned-char) (+ (* i 2) size)) ;; (coerce (ldb (byte 8 8) code) '(signed 8))) (ldb (byte 8 8) code)) - (setf (uffi:deref-array buffer 'array-or-pointer-char (+ (* i 2) size 1)) + (setf (uffi:deref-array buffer '(:array :unsigned-char) (+ (* i 2) size 1)) ;; (coerce (ldb (byte 8 0) code) '(signed 8))))))) (ldb (byte 8 0) code)))))) (incf size (* characters 2)) @@ -158,25 +158,25 @@ (loop for i fixnum from 0 below characters do (let ((code (char-code (schar string i)))) (when (> code #x10FFFF) (error "Invalid unicode code type")) - (setf (uffi:deref-array buffer 'array-or-pointer-char (+ (* i 4) size 0)) + (setf (uffi:deref-array buffer '(:array :unsigned-char) (+ (* i 4) size 0)) (ldb (byte 8 24) code)) - (setf (uffi:deref-array buffer 'array-or-pointer-char (+ (* i 4) size 1)) + (setf (uffi:deref-array buffer '(:array :unsigned-char) (+ (* i 4) size 1)) (ldb (byte 8 16) code)) - (setf (uffi:deref-array buffer 'array-or-pointer-char (+ (* i 4) size 2)) + (setf (uffi:deref-array buffer '(:array :unsigned-char) (+ (* i 4) size 2)) (ldb (byte 8 8) code)) - (setf (uffi:deref-array buffer 'array-or-pointer-char (+ (* i 4) size 3)) + (setf (uffi:deref-array buffer '(:array :unsigned-char) (+ (* i 4) size 3)) (ldb (byte 8 0) code))))) (string (loop for i fixnum from 0 below characters do (let ((code (char-code (schar string i)))) (when (> code #x10FFFF) (error "Invalid unicode code type")) - (setf (uffi:deref-array buffer 'array-or-pointer-char (+ (* i 4) size 0)) + (setf (uffi:deref-array buffer '(:array :unsigned-char) (+ (* i 4) size 0)) (ldb (byte 8 24) code)) - (setf (uffi:deref-array buffer 'array-or-pointer-char (+ (* i 4) size 1)) + (setf (uffi:deref-array buffer '(:array :unsigned-char) (+ (* i 4) size 1)) (ldb (byte 8 16) code)) - (setf (uffi:deref-array buffer 'array-or-pointer-char (+ (* i 4) size 2)) + (setf (uffi:deref-array buffer '(:array :unsigned-char) (+ (* i 4) size 2)) (ldb (byte 8 8) code)) - (setf (uffi:deref-array buffer 'array-or-pointer-char (+ (* i 4) size 3)) + (setf (uffi:deref-array buffer '(:array :unsigned-char) (+ (* i 4) size 3)) (ldb (byte 8 0) code)))))) (incf size (* characters 4)) t))))

1 0

[elephant-cvs] CVS elephant
by ieslick 29 Apr '07

29 Apr '07

Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv12328 Modified Files: elephant.asd Log Message: Fixes for lispworks in tests & deadlock detect; fixes for openmcl in pointer manipulation --- /project/elephant/cvsroot/elephant/elephant.asd 2007/04/21 17:22:35 1.45 +++ /project/elephant/cvsroot/elephant/elephant.asd 2007/04/29 02:10:54 1.46 @@ -305,7 +305,7 @@ (:file "serializer2") ;; 0.6.1 db's (:file "unicode2") (:file "migrate") - (:file "query") +;; (:file "query") (:file "data-store-api")) :serial t :depends-on (memutil utils)))))

1 0

[elephant-cvs] CVS elephant/tests
by ieslick 28 Apr '07

28 Apr '07

Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv32598/tests Modified Files: elephant-tests.lisp testconditions.lisp Log Message: test conditions fix, new run-regression test interface; remove doc strings to cleanup manual --- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2007/04/28 02:31:31 1.32 +++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2007/04/28 17:18:34 1.33 @@ -86,6 +86,9 @@ (defvar *testpg-spec* '(:clsql (:postgresql "localhost.localdomain" "test" "postgres" ""))) +(defvar *testpg-spec2* + '(:clsql (:postgresql "localhost.localdomain" "test2" "postgres" ""))) + (defvar *testsqlite3-spec* `(:clsql (:sqlite3 ,(namestring @@ -116,14 +119,36 @@ ;; -;; GUIDE TO TESTING +;; COMPREHENSIVE TESTING +;; + +(defun run-regression-tests (type) + (let (sc1 sc2 oid) + (case type + (:BDB + (setf sc1 *testbdb-spec* + sc2 *testbdb-spec2* + oid *testbdb-spec-oid*)) + (:SQLITE + (setf sc1 *testsqlite3-spec* + sc2 *testsqlite3-spec2*)) + (:POSTGRES + (setf sc1 *testpg-spec* + sc2 *testpg-spec*)) + (t (error "Unrecognized data store type: ~A" type))) + (let ((*test-spec-primary* sc1) + (*test-spec-secondary* sc2)) + (declare (special *test-spec-secondary* *test-spec-primary*)) + (do-backend-tests sc1)))) + +;; +;; GUIDE TO SUBTESTS ;; -;; 1) Set *default-spec* to the above spec of your choice -;; 2) Call (do-backend-tests) to test the standard API -;; 3) To test migration: (do-migration-tests *default-spec* <second-spec>) inserting a second +;; 1) Call (do-backend-tests <specname>) to test the standard API +;; 3) To test migration: (do-migration-tests <first-spec> <second-spec>) inserting a second ;; spec, typically a bdb spec or create another instance of a sql db depending on ;; your configuration -;; 4) A backend is green if it passes do-backend-tests and can succesfully be +;; 4) A data store is green if it passes do-backend-tests and can succesfully be ;; used as spec1 or spec2 argument in the migration test ;; @@ -146,8 +171,7 @@ "For easy interactive running of single tests while debugging" (when spec (with-open-store (spec) - (let ((*auto-commit* nil)) - (do-test testname))))) + (do-test testname)))) (defun do-migration-tests (spec1 spec2 &optional oid-spec) "Interface to do explicit migration tests between backends" --- /project/elephant/cvsroot/elephant/tests/testconditions.lisp 2007/04/28 03:07:39 1.4 +++ /project/elephant/cvsroot/elephant/tests/testconditions.lisp 2007/04/28 17:18:34 1.5 @@ -19,9 +19,9 @@ (progn (format t "~%Second store spec missing: ignoring") (values t t t t)) - (let (*store-controller* - (sc1 *store-controller*) - (sc2 (open-store *test-spec-secondary* :recover t :deadlock-detect nil))) + (let ((sc2 (open-store *test-spec-secondary* :recover t :deadlock-detect nil)) + (*store-controller* *store-controller*) + (sc1 *store-controller*)) (unwind-protect (let ((inst1 (make-instance 'pfoo :slot1 100 :sc sc1)) (inst2 (make-instance 'pfoo :slot1 200 :sc sc2))) @@ -36,10 +36,7 @@ t t t t) (deftest unindexed-class-condition - (let* ((sc (open-store *test-spec-primary* :recover t :deadlock-detect nil)) - (inst (make-instance 'pfoo :slot1 1 :sc sc))) - (unwind-protect - (signals-specific-condition (persistent-class-not-indexed) - (find-class-index 'pfoo :sc sc)) - (close-store sc))) + (let ((inst (make-instance 'pfoo :slot1 1))) + (signals-specific-condition (persistent-class-not-indexed) + (find-class-index 'pfoo))) t) \ No newline at end of file

1 0

[elephant-cvs] CVS elephant
by ieslick 28 Apr '07

28 Apr '07

Update of /project/elephant/cvsroot/elephant In directory clnet:/tmp/cvs-serv32598 Modified Files: ele-bdb.asd Log Message: test conditions fix, new run-regression test interface; remove doc strings to cleanup manual --- /project/elephant/cvsroot/elephant/ele-bdb.asd 2007/04/19 05:24:37 1.26 +++ /project/elephant/cvsroot/elephant/ele-bdb.asd 2007/04/28 17:18:32 1.27 @@ -18,6 +18,11 @@ (in-package :cl-user) +;; Forward def +(defpackage elephant-system + (:use :cl :asdf) + (:export :elephant-c-source :compiler-options :foreign-libraries-to-load-first :get-config-option)) + (defpackage ele-bdb-system (:use :cl :asdf :elephant-system)) @@ -40,6 +45,9 @@ (setf result (concatenate 'string "/cygdrive" result)) (substitute #\/ #\\ result))) +;; Forward def +(defclass elephant-c-source (c-source-file) ()) + (defclass bdb-c-source (elephant-c-source) ()) (defmethod compiler-options ((compiler (eql :gcc)) (c bdb-c-source) &key &allow-other-keys)

1 0

[elephant-cvs] CVS elephant/src/elephant
by ieslick 28 Apr '07

28 Apr '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv32598/src/elephant Modified Files: collections.lisp Log Message: test conditions fix, new run-regression test interface; remove doc strings to cleanup manual --- /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/04/28 02:31:15 1.28 +++ /project/elephant/cvsroot/elephant/src/elephant/collections.lisp 2007/04/28 17:18:33 1.29 @@ -340,8 +340,8 @@ "Move to the previous duplicate element (with the same key.) Returns has-pair key value.")) +;; Default implementation. Plan is to update both backends when BDB 4.6 comes out (defmethod cursor-prev-dup ((cur cursor)) - "Default implementation. Plan is to update both backends when BDB 4.6 comes out" (when (cursor-initialized-p cur) (multiple-value-bind (exists? skey-cur) (cursor-current cur) @@ -362,8 +362,8 @@ "Move to the previous duplicate element (with the same key.) Returns has-tuple / secondary key / value / primary key.")) +;; Default implementation. Plan is to update both backends when BDB 4.6 comes out (defmethod cursor-pprev-dup ((cur cursor)) - "Default implementation. Plan is to update both backends when BDB 4.6 comes out" (when (cursor-initialized-p cur) (multiple-value-bind (exists? skey-cur) (cursor-current cur)

1 0

[elephant-cvs] CVS elephant/doc
by ieslick 28 Apr '07

28 Apr '07

Update of /project/elephant/cvsroot/elephant/doc In directory clnet:/tmp/cvs-serv26611 Modified Files: Makefile data-store-reference.texinfo elephant.texinfo installation.texinfo intro.texinfo reference.texinfo user-guide.texinfo Log Message: Final doc cleanup; added contents to PDF (finally) --- /project/elephant/cvsroot/elephant/doc/Makefile 2007/04/01 14:33:24 1.6 +++ /project/elephant/cvsroot/elephant/doc/Makefile 2007/04/28 14:24:57 1.7 @@ -9,4 +9,5 @@ makeinfo -v --html --css-include=style.css --force --no-split elephant.texinfo pdf: includes-stuff - texi2dvi --pdf elephant.texinfo + texi2pdf --texinfo=@setcontentsaftertitlepage --texinfo=@setshortcontentsaftertitlepage \ + elephant.texinfo --- /project/elephant/cvsroot/elephant/doc/data-store-reference.texinfo 2007/04/28 02:31:07 1.8 +++ /project/elephant/cvsroot/elephant/doc/data-store-reference.texinfo 2007/04/28 14:24:57 1.9 @@ -28,12 +28,12 @@ * Registration: DSR Registration. Register the data store for the appropriate controller specifications. * Store Controllers: DSR Store Controllers. Subclassing the store controller. * Handling Serialization: DSR Handling Serialization. Available facilities for serializing objects. -* Memory Utilities: DSR Memory Utilities. Writing primitive C types. * Persistent Objects and Slot access: DSR Persistent Objects and Slot Access. Support for metaprotocol slot access. * Collections: DSR Collections. BTrees and indices. * Cursors: DSR Cursors. Traversing BTrees. * Transactions: DSR Transactions. Transaction implementation. * Multithreading Considerations: DSR Multithreading Considerations. Multithreading considerations. +@c * Memory Utilities: DSR Memory Utilities. Writing primitive C types. @c * Foreign Libraries: DSR Foreign Libraries. Using UFFI and ASDF to build or link foreign libraries @end menu @@ -241,7 +241,7 @@ @node DSR Handling Serialization @comment node-name, next, previous, up @section Handling Serialization -@cindex Serialization +@cindex Serializer Data stores must initialize @ref{Class elephant:store-controller} with internal serializer functions. Packages @code{elephant-serializer1} --- /project/elephant/cvsroot/elephant/doc/elephant.texinfo 2007/04/28 02:31:07 1.11 +++ /project/elephant/cvsroot/elephant/doc/elephant.texinfo 2007/04/28 14:24:57 1.12 @@ -2,9 +2,10 @@ @c %**start of header @setfilename elephant.info @settitle Elephant User Manual -@setchapternewpage odd @c %**end of header +@setchapternewpage odd + @copying @quotation Elephant System @* @@ -44,7 +45,6 @@ @top Copyright @insertcopying -@end ifnottex @ifhtml @menu @@ -74,13 +74,14 @@ * Variable Index:: * Colophon:: @end menu - @end ifhtml @node Table of Contents @unnumbered @comment node-name, next, previous, up -@contents +@contents + +@end ifnottex @include intro.texinfo @include tutorial.texinfo @@ -131,4 +132,8 @@ @uref{http://www.common-lisp.net/project/elephant/}) and submit a patch. +@iftex +@shortcontents +@contents +@end iftex @bye --- /project/elephant/cvsroot/elephant/doc/installation.texinfo 2007/04/28 02:31:07 1.12 +++ /project/elephant/cvsroot/elephant/doc/installation.texinfo 2007/04/28 14:24:57 1.13 @@ -11,7 +11,7 @@ * Loading Elephant:: Loading Elephant and the data store loading protocol. * Berkeley DB:: Installing support for the Berkeley DB data store. * Berkeley DB Example:: An example of installing and running the Berkeley DB data store. -* Upgrading Berkeley DB Database:: How to upgrade to a new version of Berkeley DB. +* Upgrading Berkeley DB Databases:: How to upgrade to a new version of Berkeley DB. * CL-SQL:: Install and connecting to the CL-SQL data store. * CL-SQL Example:: An example of using the CL-SQL data store. * Elephant on Windows:: More details about running Elephant on Windows @@ -309,8 +309,8 @@ @item Open your old database: @code{(setf sc (open-store '(:BDB "/Users/me/db/ele060/")))} @item Run upgrade: @code{(upgrade sc '(:BDB "/Users/me/db/ele061/"))} @end itemize -@item Test your new application and report any bugs that arise to elephant-devel(a)common-lisp.net -@end itemize +@item Test your new application and report any bugs that arise to @email{elephant-devel@@common-lisp.net} +@end enumerate @emph{(NOTE: close-store may fail when closing the old 0.6 database, this is OK.)} --- /project/elephant/cvsroot/elephant/doc/intro.texinfo 2007/04/02 00:51:06 1.6 +++ /project/elephant/cvsroot/elephant/doc/intro.texinfo 2007/04/28 14:24:57 1.7 @@ -3,7 +3,9 @@ @node Introduction @comment node-name, next, previous, up @chapter Introduction -@cindex Introduction +@cindex History +@cindex Goals + Elephant is a persistent object protocol and database for Common Lisp. The persistent protocol component of elephant overrides class --- /project/elephant/cvsroot/elephant/doc/reference.texinfo 2007/04/28 02:31:07 1.14 +++ /project/elephant/cvsroot/elephant/doc/reference.texinfo 2007/04/28 14:24:57 1.15 @@ -7,22 +7,22 @@ @cindex API Reference @menu -* Store Controllers:: Connecting to a data store. -* Persistent Object API:: Defining persistent classes and creating and manipulating persistent indices. -* Persistent Object Indexing API:: Convenient indexing of persistent classes. -* Persistent Set API:: Maintaining persistent collections the easy way. +* Store Controllers: Store Controller API. Connecting to a data store. +* Persistent Objects: Persistent Object API. Defining persistent classes and creating and manipulating persistent indices. +* Persistent Object Indexing: Persistent Object Indexing API. Convenient indexing of persistent classes. +* Persistent Sets: Persistent Set API. Maintaining persistent collections the easy way. @c * Query Interfaces:: Finding instances. -* BTree API:: BTrees and indices, a low level persistent data structure. -* Cursor API:: Traversing BTrees. -* Index Cursor API:: Traversing BTree Indicies. -* Transaction API:: Transaction functions. -* Migration and Upgrading API:: Migration and upgrading. -* Miscellaneous API:: Other functions and data store specific functions +* BTrees: BTree API. BTrees and indices, a low level persistent data structure. +* BTree Cursors: BTree Cursor API. Traversing BTrees. +* Index Cursors: Index Cursor API. Traversing BTree Indicies. +* Transactions: Transaction API. Transaction functions. +* Migration and Upgrading: Migration and Upgrading API. Migration and upgrading. +@c * Miscellaneous API:: Other functions and data store specific functions @end menu @node Store Controller API @comment node-name, next, previous, up -@section Store Controller API +@section Store Controllers @cindex Store Controller @cindex API @@ -49,7 +49,7 @@ @node Persistent Object API @comment node-name, next, previous, up -@section Persistent Object API +@section Persistent Objects @cindex Persistent Objects @cindex API @@ -63,7 +63,7 @@ @node Persistent Object Indexing API @comment node-name, next, previous, up -@section Persistent Object Indexing API +@section Persistent Object Indexing @cindex Persistent Object Indexing @cindex API @@ -100,8 +100,8 @@ @node Persistent Set API @comment node-name, next, previous, up -@section Persistent Set API -@cindex Persistent Set API +@section Persistent Sets +@cindex Persistent Sets Persistent sets are a simple persistent collection abstraction. They maintain an unordered collection of objects. Unlike the normal @@ -132,7 +132,7 @@ @node BTree API @comment node-name, next, previous, up -@section BTree API +@section BTrees @cindex BTree @cindex API @@ -167,9 +167,9 @@ @include includes/fun-elephant-map-index.texinfo -@node Cursor API +@node BTree Cursor API @comment node-name, next, previous, up -@section Cursor API +@section Btree Cursors @cindex Cursors @cindex API @@ -200,7 +200,7 @@ @node Index Cursor API @comment node-name, next, previous, up -@section Index Cursor API +@section Index Cursors @cindex Cursor @cindex Index @cindex Indices @@ -239,7 +239,7 @@ @node Transaction API @comment node-name, next, previous, up -@section Transaction API +@section Transactions @cindex Transaction API @cindex API @@ -256,7 +256,7 @@ @node Migration and Upgrading API @comment node-name, next, previous, up -@section Migration and Upgrading API +@section Migration and Upgrading @cindex Migration and Upgrading @cindex API --- /project/elephant/cvsroot/elephant/doc/user-guide.texinfo 2007/04/28 02:31:11 1.20 +++ /project/elephant/cvsroot/elephant/doc/user-guide.texinfo 2007/04/28 14:24:57 1.21 @@ -882,7 +882,7 @@ setting a second cursor to the same location. Cursors can be in two states: initialized and uninitialized. -@ref{Cursor API} for details. +@ref{BTree Cursor API} for details. To initialize a cursor, you have to use one of the initializing functions to select a key-value pair in the btree. @@ -1068,6 +1068,7 @@ that the cursor is now uninitialized (@code{cursor-initialized-p}) and needs to be reset by a set or set both call. +@xref{Index Cursor API} for further details. @node Multi-threaded Applications @comment node-name, next, previous, up

1 0

[elephant-cvs] CVS elephant/doc/oldfiles
by ieslick 28 Apr '07

28 Apr '07

Update of /project/elephant/cvsroot/elephant/doc/oldfiles In directory clnet:/tmp/cvs-serv26611/oldfiles Modified Files: TODO Log Message: Final doc cleanup; added contents to PDF (finally) --- /project/elephant/cvsroot/elephant/doc/oldfiles/TODO 2007/04/28 02:31:14 1.1 +++ /project/elephant/cvsroot/elephant/doc/oldfiles/TODO 2007/04/28 14:24:57 1.2 @@ -12,24 +12,9 @@ TASKS TO GET TO FINAL RELEASE: Bugs: -- Fix awkward serializer API -- Support for asdf-install? - - problem with other .asd files in root - -Lisp Support: -- Validate OpenMCL pre-1.1 on Mac OS X -- Validate OpenMCL 1.1 and/or 64-bit on Mac OS X? -- Verify db_deadlock for other lisps (launch and kill background program I/F) - -Documentation: -- Update install, build and test procedures -- Upgrade, migration and other system level issues -- Performance and design issues - - More notes about transaction performance - - Serious discussion of threading implications - - Add notes about with/ensure-transaction usage (abort & commit behavior on exit) - - Add notes about deadlock-detect - - Add notes about checkpoint (null in SQL?) +- Validate OpenMCL 1.0 on Mac OS X +- Lispworks on Linux +- Verify install, build and test documentation and procedures 0.6.1 - Features COMPLETED to date ----------------------------------

1 0

[elephant-cvs] CVS elephant/tests
by ieslick 28 Apr '07

28 Apr '07

Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv23936/tests Modified Files: testconditions.lisp Log Message: Fixed test bug; cleaned up get-instances-by-xxx fns to use new map operators --- /project/elephant/cvsroot/elephant/tests/testconditions.lisp 2007/04/28 02:31:31 1.3 +++ /project/elephant/cvsroot/elephant/tests/testconditions.lisp 2007/04/28 03:07:39 1.4 @@ -20,7 +20,7 @@ (format t "~%Second store spec missing: ignoring") (values t t t t)) (let (*store-controller* - (sc1 (open-store *test-spec-primary* :recover t :deadlock-detect nil)) + (sc1 *store-controller*) (sc2 (open-store *test-spec-secondary* :recover t :deadlock-detect nil))) (unwind-protect (let ((inst1 (make-instance 'pfoo :slot1 100 :sc sc1)) @@ -32,13 +32,14 @@ (add-to-root 'inst1 inst1 :sc sc2)) (signals-specific-condition (cross-reference-error) (add-to-root 'inst2 inst2 :sc sc1)))) - (close-store sc1) (close-store sc2)))) t t t t) (deftest unindexed-class-condition (let* ((sc (open-store *test-spec-primary* :recover t :deadlock-detect nil)) (inst (make-instance 'pfoo :slot1 1 :sc sc))) - (signals-specific-condition (persistent-class-not-indexed) - (find-class-index 'pfoo :sc sc))) + (unwind-protect + (signals-specific-condition (persistent-class-not-indexed) + (find-class-index 'pfoo :sc sc)) + (close-store sc))) t) \ No newline at end of file

1 0

[elephant-cvs] CVS elephant/src/elephant
by ieslick 28 Apr '07

28 Apr '07

Update of /project/elephant/cvsroot/elephant/src/elephant In directory clnet:/tmp/cvs-serv23936/src/elephant Modified Files: classindex.lisp controller.lisp Log Message: Fixed test bug; cleaned up get-instances-by-xxx fns to use new map operators --- /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/04/28 02:31:15 1.40 +++ /project/elephant/cvsroot/elephant/src/elephant/classindex.lisp 2007/04/28 03:07:38 1.41 @@ -389,7 +389,7 @@ ;; USER MAPPING API ;; ====================== -(defun map-class (fn class) +(defun map-class (fn class &key collect) "Perform a map operation over all instances of class. Takes a function of one argument, a class instance" (let* ((class (if (symbolp class) @@ -400,9 +400,9 @@ (declare (ignore k)) (funcall fn v))) (declare (dynamic-extent map-fn)) - (map-btree #'map-fn class-idx)))) + (map-btree #'map-fn class-idx :collect collect)))) -(defun map-inverted-index (fn class index &rest args &key start end value from-end) +(defun map-inverted-index (fn class index &rest args &key start end (value nil value-p) from-end collect) "map-inverted-index maps a function of two variables, taking key and instance, over a subset of class instances in the order defined by the index. Specify the class and index by quoted @@ -431,7 +431,10 @@ (declare (ignore pkey)) (funcall fn key value))) (declare (dynamic-extent wrapper)) - (map-index #'wrapper index :start start :end end :value value :from-end from-end)))) + (if value-p + (map-index #'wrapper index :value value :collect collect) + (map-index #'wrapper index :start start :end end :from-end from-end :collect collect))))) + ;; ================= @@ -454,30 +457,27 @@ nil to start or end indicates, respectively, the lowest or highest value in the index")) + +(defun identity2 (k v) + (declare (ignore k)) + v) + +(defun identity3 (k v pk) + (declare (ignore k pk)) + v) + (defmethod get-instances-by-class ((class symbol)) (get-instances-by-class (find-class class))) (defmethod get-instances-by-class ((class persistent-metaclass)) - (let ((instances nil)) - (flet ((accum (c) - (declare (dynamic-extent c)) - (push c instances))) - (map-class #'accum class) - (nreverse instances)))) + (map-class #'identity class :collect t)) (defmethod get-instances-by-value ((class symbol) slot-name value) (get-instances-by-value (find-class class) slot-name value)) (defmethod get-instances-by-value ((class persistent-metaclass) slot-name value) (declare (type (or string symbol) slot-name)) - (let ((instances nil)) - (declare (type list instances)) - (flet ((collector (k v pk) - (declare (ignore k pk)) - (push v instances))) - (declare (dynamic-extent collector)) - (map-index #'collector (find-inverted-index class slot-name) :value value)) - (nreverse instances))) + (map-inverted-index #'identity2 class slot-name :value value :collect t)) (defmethod get-instance-by-value ((class symbol) slot-name value) (let ((list (get-instances-by-value (find-class class) slot-name value))) @@ -495,15 +495,7 @@ (defmethod get-instances-by-range ((class persistent-metaclass) idx-name start end) (declare (type (or fixnum null) start end) (type symbol idx-name)) - (let ((instances nil)) - (declare (type list instances)) - (flet ((collector (k v pk) - (declare (ignore k pk)) - (push v instances))) - (declare (dynamic-extent collector)) - (map-index #'collector (find-inverted-index class idx-name) - :start start :end end)) - (nreverse instances))) + (map-inverted-index #'identity2 class idx-name :start start :end end :collect t)) (defun drop-instances (instances &key (sc *store-controller*)) "Removes a list of persistent objects from all class indices --- /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/04/28 02:31:15 1.51 +++ /project/elephant/cvsroot/elephant/src/elephant/controller.lisp 2007/04/28 03:07:38 1.52 @@ -220,7 +220,7 @@ "Reset the instance cache (flush object lookups). Useful for testing. Does not reclaim existing objects so there will be duplicate instances with identical functionality" - (ele-with-lock ((instance-cache-lock sc)) + (ele-with-fast-lock ((instance-cache-lock sc)) (setf (instance-cache sc) (make-cache-table :test 'eql))))

1 0

[elephant-cvs] CVS elephant/tests
by ieslick 28 Apr '07

28 Apr '07

Update of /project/elephant/cvsroot/elephant/tests In directory clnet:/tmp/cvs-serv16753/tests Modified Files: elephant-tests.lisp testconditions.lisp Log Message: Cleaning up root directory files; map-index performance enhancement, index api cleanup, ensure transaction fix, alpha quality documentation draft --- /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2007/03/30 14:34:35 1.31 +++ /project/elephant/cvsroot/elephant/tests/elephant-tests.lisp 2007/04/28 02:31:31 1.32 @@ -300,9 +300,15 @@ (defmacro signals-condition (&body body) `(handler-case - (progn ,@body) - (condition () t) - (:no-error (&rest rest) (declare (ignore rest)) nil))) + (progn ,@body) + (condition () t) + (:no-error (&rest rest) (declare (ignore rest)) nil))) + +(defmacro signals-specific-condition ((condition) &body body) + `(handler-case + (progn ,@body) + (,condition () t) + (:no-error (&rest rest) (declare (ignore rest)) nil))) (defmacro signals-error (&body body) `(handler-case --- /project/elephant/cvsroot/elephant/tests/testconditions.lisp 2007/04/22 03:02:35 1.2 +++ /project/elephant/cvsroot/elephant/tests/testconditions.lisp 2007/04/28 02:31:31 1.3 @@ -28,8 +28,17 @@ (values (is-not-null (add-to-root 'inst1 inst1 :sc sc1)) (is-not-null (add-to-root 'inst2 inst2 :sc sc2)) - (signals-condition (add-to-root 'inst1 inst1 :sc2)) - (signals-condition (add-to-root 'inst2 inst2 :sc1)))) + (signals-specific-condition (cross-reference-error) + (add-to-root 'inst1 inst1 :sc sc2)) + (signals-specific-condition (cross-reference-error) + (add-to-root 'inst2 inst2 :sc sc1)))) (close-store sc1) (close-store sc2)))) - t t t t) \ No newline at end of file + t t t t) + +(deftest unindexed-class-condition + (let* ((sc (open-store *test-spec-primary* :recover t :deadlock-detect nil)) + (inst (make-instance 'pfoo :slot1 1 :sc sc))) + (signals-specific-condition (persistent-class-not-indexed) + (find-class-index 'pfoo :sc sc))) + t) \ No newline at end of file

1 0

← Newer
1
2
3
4
5
6
7
...
86
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

elephant-cvs