Revision: 3690 Author: hans URL: http://bknr.net/trac/changeset/3690
More changes relating to ALLOCATE-INSTANCE.
U trunk/bknr/datastore/src/data/object.lisp
Modified: trunk/bknr/datastore/src/data/object.lisp =================================================================== --- trunk/bknr/datastore/src/data/object.lisp 2008-07-30 09:36:20 UTC (rev 3689) +++ trunk/bknr/datastore/src/data/object.lisp 2008-07-30 09:42:58 UTC (rev 3690) @@ -454,9 +454,10 @@ ;; If the class is NIL, it was not found in the currently ;; running Lisp image and objects of this class will be ignored. (when class + (setf (next-object-id (store-object-subsystem)) object-id) (let ((object (allocate-instance class))) + (assert (= object-id (slot-value object 'id))) (dolist (index (class-slot-indices class 'id)) - (assert (= object-id (slot-value object 'id))) (index-add index object)))))))
(defun snapshot-read-slots (stream layouts) @@ -641,12 +642,14 @@
(defun make-object (class-name &rest initargs) "Make a persistent object of class named CLASS-NAME. Calls MAKE-INSTANCE with INITARGS." - (with-store-guard () - (execute (make-instance 'transaction - :function-symbol 'tx-make-object - :args (append (list class-name - :id (next-object-id (store-object-subsystem))) - initargs))))) + (if (in-anonymous-transaction-p) + (apply #'make-instance class-name initargs) + (with-store-guard () + (execute (make-instance 'transaction + :function-symbol 'tx-make-object + :args (append (list class-name + :id (next-object-id (store-object-subsystem))) + initargs))))))
(defun tx-delete-object (id) (destroy-object (store-object-with-id id)))