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