tests.lisp
80 lines
| 3.1 KiB
| text/x-common-lisp
|
CommonLispLexer
/ t / tests.lisp
r0 | ||||
(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"))) | ||||