[bknr-cvs] hans changed trunk/bknr/datastore/src/data/object.lisp
BKNR Commits
bknr at bknr.net
Wed Jul 30 09:42:58 UTC 2008
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)))
More information about the Bknr-cvs
mailing list