[bknr-cvs] r2266 - branches/trunk-reorg/bknr/datastore/src/data
bknr at bknr.net
bknr at bknr.net
Sun Nov 11 21:35:53 UTC 2007
Author: hhubner
Date: 2007-11-11 16:35:49 -0500 (Sun, 11 Nov 2007)
New Revision: 2266
Added:
branches/trunk-reorg/bknr/datastore/src/data/anon-circular-test.lisp
Modified:
branches/trunk-reorg/bknr/datastore/src/data/TODO
branches/trunk-reorg/bknr/datastore/src/data/object.lisp
branches/trunk-reorg/bknr/datastore/src/data/package.lisp
branches/trunk-reorg/bknr/datastore/src/data/random-mixin.lisp
branches/trunk-reorg/bknr/datastore/src/data/txn.lisp
Log:
Rename random-mixin to random-store-mixin, fix a bug.
Document another severe bug, including test case.
Clean up some of the messages, in particular do not use WARN to report restore
messages.
Modified: branches/trunk-reorg/bknr/datastore/src/data/TODO
===================================================================
--- branches/trunk-reorg/bknr/datastore/src/data/TODO 2007-11-11 13:16:06 UTC (rev 2265)
+++ branches/trunk-reorg/bknr/datastore/src/data/TODO 2007-11-11 21:35:49 UTC (rev 2266)
@@ -7,10 +7,15 @@
- import-image anschauen, nicht mehr failsafe
- Revise and document make-object und initargs behaviour. Upon
-restore, initargs for transient slots are ignored now, but this is not
-completely thought out. It would better not to log initargs for
-transient slots in the first place.
+ restore, initargs for transient slots are ignored now, but this is
+ not completely thought out. It would better not to log initargs for
+ transient slots in the first place.
- tx-persistent-change-class does not maintain indices
- XXXX broken initialize-persistent-instance (?)
+
+- Within anonymous transactions, circular dependencies are not
+ correctly serialized. Thus, an object that is created in the
+ anonymous transactions links itself to another object, it may fail
+ to restore correctly. See anon-circular-test.lisp for an example.
Added: branches/trunk-reorg/bknr/datastore/src/data/anon-circular-test.lisp
===================================================================
--- branches/trunk-reorg/bknr/datastore/src/data/anon-circular-test.lisp 2007-11-11 13:16:06 UTC (rev 2265)
+++ branches/trunk-reorg/bknr/datastore/src/data/anon-circular-test.lisp 2007-11-11 21:35:49 UTC (rev 2266)
@@ -0,0 +1,15 @@
+(in-package :bknr.datastore)
+
+(define-persistent-class parent ()
+ ((children :update :initform nil)))
+
+(define-persistent-class child ()
+ ())
+
+(defun test-circular (parent)
+ (with-transaction (:circular)
+ (push (make-object 'child) (parent-children parent))))
+
+(defvar *p* (make-object 'parent))
+
+(test-circular *p*)
\ No newline at end of file
Modified: branches/trunk-reorg/bknr/datastore/src/data/object.lisp
===================================================================
--- branches/trunk-reorg/bknr/datastore/src/data/object.lisp 2007-11-11 13:16:06 UTC (rev 2265)
+++ branches/trunk-reorg/bknr/datastore/src/data/object.lisp 2007-11-11 21:35:49 UTC (rev 2266)
@@ -446,7 +446,6 @@
(error "Encoding reference to destroyed object with ID ~A from slot ~A of object ~A with ID ~A."
id slot (type-of container) (store-object-id container))))
-
;;; Go ahead and serialize the object reference
(progn (%write-char #\o stream)
(%encode-integer (store-object-id object) stream))))
@@ -513,7 +512,7 @@
(clear-class-indices (find-class class-name)))
(setf (id-counter subsystem) 0)
(when (probe-file snapshot)
- (warn "loading snapshot file ~A" snapshot)
+ (format *trace-output* "loading snapshot file ~A~%" snapshot)
(with-open-file (s snapshot
:element-type '(unsigned-byte 8)
:direction :input)
@@ -526,12 +525,14 @@
(with-simple-restart
(finalize-object-subsystem "Finalize the object subsystem.")
(loop
- (when (= (mod created-objects 10000) 1)
+ (when (and (plusp created-objects)
+ (zerop (mod created-objects 10000)))
#+nil(format t "Snapshot position ~A~%" (file-position s))
(format t "~A objects created.~%" created-objects)
(force-output))
- (when (= (mod read-slots 10000) 1)
- (format t "~A slots set (of ~A).~%" read-slots created-objects)
+ (when (and (plusp read-slots)
+ (zerop (mod read-slots 10000)))
+ (format t "~A of ~A slots set.~%" read-slots created-objects)
(force-output))
(let ((char (%read-char s nil nil)))
(unless (member char '(#\O #\L #\S nil))
Modified: branches/trunk-reorg/bknr/datastore/src/data/package.lisp
===================================================================
--- branches/trunk-reorg/bknr/datastore/src/data/package.lisp 2007-11-11 13:16:06 UTC (rev 2265)
+++ branches/trunk-reorg/bknr/datastore/src/data/package.lisp 2007-11-11 21:35:49 UTC (rev 2266)
@@ -15,7 +15,7 @@
;; store
#:store
#:mp-store
- #:random-mixin
+ #:random-store-mixin
#:store-guard
#:store-state
#:open-store
Modified: branches/trunk-reorg/bknr/datastore/src/data/random-mixin.lisp
===================================================================
--- branches/trunk-reorg/bknr/datastore/src/data/random-mixin.lisp 2007-11-11 13:16:06 UTC (rev 2265)
+++ branches/trunk-reorg/bknr/datastore/src/data/random-mixin.lisp 2007-11-11 21:35:49 UTC (rev 2266)
@@ -5,31 +5,37 @@
;; (in-package :bknr.user)
-;; (defclass mystore (mp-store random-mixin)
+;; (defclass mystore (mp-store random-store-mixin)
;; ())
;; (open-store "/tmp/db_123/" :class-name 'mystore
;; :subsystems (list (make-instance 'store-object-subsystem)
;; (make-instance 'random-mixin-subsystem)))
-(defclass random-mixin ()
+(defclass random-store-mixin ()
((random-state :accessor random-state-of :initform (make-random-state t))))
-(defmethod initialize-instance :after ((store random-mixin) &rest initargs)
+(defun random-subsystem-pathname (store)
+ (make-pathname :name "random-state" :defaults (ensure-store-current-directory store)))
+
+(defmethod initialize-instance :after ((store random-store-mixin) &rest initargs)
(declare (ignore initargs))
(let ((random-mixin-subsystem (find 'random-mixin-subsystem
(store-subsystems store)
:key #'type-of)))
- (assert random-mixin-subsystem nil "Store ~s needs to have a random-mixin-subsystem."
+ (assert random-mixin-subsystem nil "Store ~S needs to have a random-mixin-subsystem."
store)
- (snapshot-subsystem store random-mixin-subsystem)))
+ (unless (probe-file (random-subsystem-pathname store))
+ (snapshot-subsystem store random-mixin-subsystem))))
-(defmethod restore-store :after ((store random-mixin) &key until)
+(defmethod restore-store :after ((store random-store-mixin) &key until)
(declare (ignore until))
- ;; see FIXME of (setf *random-state* (random-state-of store))
+ ;; During restore, we use the random state of the store (see
+ ;; restore-subsystem below). Once finished with the restore, we
+ ;; save the current random state to be the store's random state:
(setf (random-state-of store) *random-state*))
-(defmethod execute-transaction :around ((executor random-mixin) transaction)
+(defmethod execute-transaction :around ((executor random-store-mixin) transaction)
(declare (ignore transaction))
(let ((*random-state* (random-state-of executor)))
(call-next-method)))
@@ -37,31 +43,28 @@
(defclass random-mixin-subsystem ()
())
-(defmethod snapshot-subsystem ((store random-mixin)
+(defmethod snapshot-subsystem ((store random-store-mixin)
(subsystem random-mixin-subsystem))
- (let* ((store-dir (ensure-store-current-directory store))
- (random-state-pathname
- (make-pathname :name "random-state" :defaults store-dir)))
- (with-open-file (s random-state-pathname
- :direction :output
- :if-exists :supersede)
- (with-standard-io-syntax
- (prin1 (random-state-of store) s)))))
+ (with-open-file (s (random-subsystem-pathname store)
+ :direction :output
+ :if-exists :supersede)
+ (with-standard-io-syntax
+ (prin1 (random-state-of store) s))))
-(defmethod restore-subsystem ((store random-mixin)
+(defmethod restore-subsystem ((store random-store-mixin)
(subsystem random-mixin-subsystem) &key
until)
(declare (ignore until))
- (let* ((store-dir (ensure-store-current-directory store))
- (random-state-pathname
- (make-pathname :name "random-state" :defaults store-dir)))
+ (let* ((random-state-pathname (random-subsystem-pathname store)))
(prog1
(if (probe-file random-state-pathname)
(with-open-file (s random-state-pathname :direction :input)
(let ((random-state (read s)))
(setf (random-state-of store) random-state)))
(progn
- (warn "Could not find store random-state value, setting to (make-random-state t).")
+ (format *trace-output* "Initializing random state of store.~%")
(setf (random-state-of store) (make-random-state t))))
- ;; FIXME
+ ;; Set global random state to the state of the store, so that
+ ;; the transactions that are restored afterwards are in the
+ ;; correct random context.
(setf *random-state* (random-state-of store)))))
Modified: branches/trunk-reorg/bknr/datastore/src/data/txn.lisp
===================================================================
--- branches/trunk-reorg/bknr/datastore/src/data/txn.lisp 2007-11-11 13:16:06 UTC (rev 2265)
+++ branches/trunk-reorg/bknr/datastore/src/data/txn.lisp 2007-11-11 21:35:49 UTC (rev 2266)
@@ -79,7 +79,7 @@
(ensure-store-current-directory store)
(dolist (subsystem (store-subsystems store))
(when *store-debug*
- (warn "Initializing subsystem ~A of ~A..." subsystem store))
+ (format *trace-output* "Initializing subsystem ~A of ~A~%" subsystem store))
(initialize-subsystem subsystem store store-existed-p))
(restore-store store))
(setf (store-state store) :opened))
@@ -450,12 +450,10 @@
(with-store-state (:snapshot)
(dolist (subsystem (store-subsystems store))
(when *store-debug*
- (warn "Snapshotting subsystem ~A of ~A..."
- subsystem store))
+ (format *trace-output* "Snapshotting subsystem ~A of ~A~%" subsystem store))
(snapshot-subsystem store subsystem)
(when *store-debug*
- (warn "Successfully snapshotted ~A of ~A."
- subsystem store)))
+ (format *trace-output* "Successfully snapshotted ~A of ~A~%" subsystem store)))
(setf (store-transaction-run-time store) 0)
(setf error nil))
(when error
@@ -512,7 +510,7 @@
(restore-store *store* :until until))
(defmethod restore-store ((store store) &key until)
- (warn "restoring ~A" store)
+ (format *trace-output* "restoring ~A~%" store)
(let ((*store* store))
(setf (store-state store) :opened)
(with-store-state (:restore)
@@ -530,18 +528,17 @@
(dolist (subsystem (store-subsystems store))
;;; check that UNTIL > snapshot date
(when *store-debug*
- (warn "Restoring the subsystem ~A of ~A..."
- subsystem store))
+ (format *trace-output* "Restoring the subsystem ~A of ~A~%" subsystem store))
(restore-subsystem store subsystem :until until))
(when (probe-file transaction-log)
- (warn "loading transaction log ~A" transaction-log)
+ (format *trace-output* "loading transaction log ~A~%" transaction-log)
(setf (store-transaction-run-time store) 0)
(load-transaction-log transaction-log :until until))
(setf error nil))
(when error
(dolist (subsystem (store-subsystems store))
(when *store-debug*
- (warn "Closing the subsystem ~A of ~A..."
+ (format *trace-output* "Closing the subsystem ~A of ~A~%"
subsystem store))
(close-subsystem store subsystem)
(setf (store-state store) :closed))))))))))
More information about the Bknr-cvs
mailing list