Changeset 3690

Show
Ignore:
Timestamp:
07/30/08 11:42:58 (4 months ago)
Author:
hans
Message:

More changes relating to ALLOCATE-INSTANCE.

Files:

Legend:

Unmodified
Added
Removed
Modified
Copied
Moved

  • trunk/bknr/datastore/src/data/object.lisp

    r3689 r3690  
    455455      ;; running Lisp image and objects of this class will be ignored. 
    456456      (when class 
     457        (setf (next-object-id (store-object-subsystem)) object-id) 
    457458        (let ((object (allocate-instance class))) 
     459          (assert (= object-id (slot-value object 'id))) 
    458460          (dolist (index (class-slot-indices class 'id)) 
    459             (assert (= object-id (slot-value object 'id))) 
    460461            (index-add index object))))))) 
    461462 
    …… 
    642643(defun make-object (class-name &rest initargs) 
    643644  "Make a persistent object of class named CLASS-NAME. Calls MAKE-INSTANCE with INITARGS." 
    644   (with-store-guard () 
    645     (execute (make-instance 'transaction 
    646                             :function-symbol 'tx-make-object 
    647                             :args (append (list class-name 
    648                                                 :id (next-object-id (store-object-subsystem))) 
    649                                           initargs))))) 
     645  (if (in-anonymous-transaction-p) 
     646      (apply #'make-instance class-name initargs) 
     647      (with-store-guard () 
     648        (execute (make-instance 'transaction 
     649                                :function-symbol 'tx-make-object 
     650                                :args (append (list class-name 
     651                                                    :id (next-object-id (store-object-subsystem))) 
     652                                              initargs)))))) 
    650653 
    651654(defun tx-delete-object (id)