|
|
|
|
|
(in-package :cl-user)
|
|
|
(defpackage mito-transactions.tests
|
|
|
(:use :cl #:mito-transactions #:parachute))
|
|
|
|
|
|
(in-package mito-transactions.tests)
|
|
|
|
|
|
(setf mito:*auto-migration-mode* t)
|
|
|
(setf mito:*migration-keep-temp-tables* nil)
|
|
|
|
|
|
(deftable test-object ()
|
|
|
((slot :col-type (or :null :integer) :initarg :slot :initform 42)
|
|
|
(ghost-slot :ghost t))
|
|
|
(:conc-name :||))
|
|
|
|
|
|
(defmethod print-object ((o test-object) stream)
|
|
|
(print-unreadable-object (o stream :type t :identity t)
|
|
|
(format stream "~A" (mito:object-id o))))
|
|
|
|
|
|
(mito:connect-toplevel :sqlite3 :database-name (asdf:system-relative-pathname :mito-transactions "test.db"))
|
|
|
(mito:ensure-table-exists 'test-object)
|
|
|
|
|
|
(define-test suite)
|
|
|
|
|
|
(define-test setup-db
|
|
|
(delete-by-values 'test-object))
|
|
|
|
|
|
(define-test (suite cache-select)
|
|
|
:depends-on (setup-db)
|
|
|
;; Create an object
|
|
|
(let ((obj (make-instance 'test-object)))
|
|
|
;; Check that it's the same object after any select function
|
|
|
(is eq obj (get-dao 'test-object (object-id obj)))
|
|
|
(is eq obj (find-dao 'test-object 'slot 42))
|
|
|
(is eq obj (first (retrieve-dao 'test-object 'slot 42)))
|
|
|
(is eq obj (first (select-dao 'test-object (sxql:where (:= :slot 42)))))))
|
|
|
|
|
|
(define-test (suite cache-delete)
|
|
|
:depends-on (setup-db cache-select)
|
|
|
;; Delete the object and check that it's removed from the cache too
|
|
|
(let ((obj (make-instance 'test-object)))
|
|
|
(delete-dao obj)
|
|
|
(is eq nil (get-dao-from-cache-only 'test-object (object-id obj)) "DELETE-DAO didn't remove object from cache")
|
|
|
(is eq nil (get-dao 'test-object (object-id obj)) "DELETE-DAO didn't remove object from db"))
|
|
|
;; Repeat for mito:delete-by-values
|
|
|
(let ((obj (make-instance 'test-object)))
|
|
|
(delete-by-values 'test-object 'slot 42)
|
|
|
(is eq nil (get-dao-from-cache-only 'test-object (object-id obj)) "DELETE-BY-VALUES didn't remove objects from cache")
|
|
|
(is eq nil (get-dao 'test-object (object-id obj)) "DELETE-BY-VALUES didn't remove objects from db")))
|
|
|
|
|
|
(define-test (suite transactions)
|
|
|
:depends-on (setup-db cache-select)
|
|
|
(let ((obj (make-instance 'test-object :slot 1)))
|
|
|
(with-transaction ()
|
|
|
(setf (slot obj) 2)
|
|
|
(setf (slot obj) 3)
|
|
|
(commit)
|
|
|
(true nil "Transaction continued after COMMIT"))
|
|
|
(is = 3 (slot obj) "COMMIT didn't save slot value")
|
|
|
(with-transaction ()
|
|
|
(setf (slot obj) 4)
|
|
|
(setf (slot obj) 5)
|
|
|
(rollback)
|
|
|
(true nil "Transaction continued after ROLLBACK"))
|
|
|
(is = 3 (slot obj) "ROLLBACK didn't restore the initial slot value")
|
|
|
(with-transaction ()
|
|
|
(setf (slot obj) 1)
|
|
|
(with-transaction ()
|
|
|
(setf (slot obj) 2)
|
|
|
(rollback)
|
|
|
(true nil "Inner transaction continued after ROLLBACK"))
|
|
|
(true nil "Outer transaction continued after ROLLBACK"))
|
|
|
(is = 3 (slot obj) "ROLLBACK from a nested transaction didn't restore the initial slot value")
|
|
|
(with-transaction ()
|
|
|
(slot-makunbound obj 'slot))
|
|
|
(false (slot-boundp obj 'slot) "Transaction failed to unbind a slot")
|
|
|
(with-transaction ()
|
|
|
(setf (slot obj) 42)
|
|
|
(rollback))
|
|
|
(false (slot-boundp obj 'slot) "Transaction rollback failed to unbind a slot")))
|
|
|
|