[elephant-devel] SBCL64 Tests

[Henrik Hjelte]

Hm, it seems to have something to do with multiple-value-prog1.
I'm to tired to understand what, it seems to work as expected when I do
some testing from the repl. However if I slighly modify
execute-transaction I can get all ele-bdb tests to run ok.

What I've done is replace multiple-value-prog1 with multiple-value-list
and setf.

/Henrik


(defmethod execute-transaction ((sc bdb-store-controller) txn-fn
				&key 
				transaction parent environment
				(retries 100) 
				degree-2 dirty-read txn-nosync txn-nowait txn-sync)
  (let ((env (if environment environment (controller-environment sc))))
    (loop 
     for count fixnum from 1 to retries
     for success of-type boolean = nil
     do
     (let ((txn
            (if transaction transaction
                (db-transaction-begin env
                                      :parent (if parent parent
+NULL-VOID+)
                                      :degree-2 degree-2
                                      :dirty-read dirty-read
                                      :txn-nosync txn-nosync
                                      :txn-nowait txn-nowait
                                      :txn-sync txn-sync))))
       (declare (type pointer-void txn))
       (let (result)
         (let ((*current-transaction* (make-transaction-record sc txn))
               (*store-controller* sc))
           (declare (special *current-transaction* *store-controller*))
           (catch 'transaction
             (unwind-protect
                  (progn
                    (setf result (multiple-value-list (funcall txn-fn)))
                    (db-transaction-commit txn 
                                           :txn-nosync txn-nosync
                                           :txn-sync txn-sync)
                    (setq success t))
               (unless success 
                 (db-transaction-abort txn)))))
         (unless (and (eq result txn) (not success))
           (return (values-list result)))))
     finally (error "Too many retries in transaction"))))