# HG changeset patch # User Steve Losh # Date 1712685717 14400 # Node ID 99142dcb072dd28dad265fb6b00a11becfe6b50e # Parent 6b27e5b734d841f97cb26f96926aa62dc63f21b9 Add simple test suite diff -r 6b27e5b734d8 -r 99142dcb072d dbvolve.asd --- a/dbvolve.asd Fri Apr 05 10:02:45 2024 -0400 +++ b/dbvolve.asd Tue Apr 09 14:01:57 2024 -0400 @@ -8,6 +8,8 @@ :depends-on (:uiop) + :in-order-to ((asdf:test-op (asdf:test-op :dbvolve/test))) + :serial t :components ((:module "src" :serial t :components ((:file "package") @@ -42,3 +44,21 @@ :serial t :components ((:module "src" :serial t :components ((:file "cli"))))) + + +(asdf:defsystem :dbvolve/test + :description "Test suite for DBvolve." + + :author "Steve Losh " + :license "MIT" + + :depends-on (:dbvolve/sqlite :1am) + + :serial t + :components ((:module "test" + :serial t + :components ((:file "package") + (:file "tests")))) + + :perform (asdf:test-op (op system) + (funcall (read-from-string "dbvolve/test:run-tests")))) diff -r 6b27e5b734d8 -r 99142dcb072d src/main.lisp --- a/src/main.lisp Fri Apr 05 10:02:45 2024 -0400 +++ b/src/main.lisp Tue Apr 09 14:01:57 2024 -0400 @@ -123,9 +123,6 @@ (defun evolve (database evolutions-path) (let* ((path (uiop:parse-native-namestring evolutions-path :ensure-directory t)) (evolutions (find-evolutions path))) - (when (zerop (length evolutions)) - (logging "No evolutions found in ~S, doing nothing." evolutions-path) - (return-from evolve)) (let ((n (length evolutions))) (call-with-new-transaction database @@ -134,17 +131,19 @@ (create-metadata-table database) (logging "Obtaining table lock.~%") (lock-metadata-table database) - (let* ((current (or (find-current-number database) -1)) - (dbn (1+ current)) - (start (1+ current))) - (when (> dbn n) - (logging "Found ~D evolution~:P but DB has ~D, not running anything.~%" - n dbn) - (return-from evolve)) - (logging "Found ~D evolution~:P, DB has ~D, running ~D evolution~:P.~%" - n dbn (- n dbn)) - (evolve% database (subseq evolutions start)) - (logging "Finished running ~D evolution~:P successfully.~%" (- n dbn)))))))) + (if (zerop (length evolutions)) + (logging "No evolutions found in ~S, nothing to run." evolutions-path) + (let* ((current (or (find-current-number database) -1)) + (dbn (1+ current)) + (start (1+ current))) + (when (> dbn n) + (logging "Found ~D evolution~:P but DB has ~D, not running anything.~%" + n dbn) + (return-from evolve)) + (logging "Found ~D evolution~:P, DB has ~D, running ~D evolution~:P.~%" + n dbn (- n dbn)) + (evolve% database (subseq evolutions start)) + (logging "Finished running ~D evolution~:P successfully.~%" (- n dbn))))))))) diff -r 6b27e5b734d8 -r 99142dcb072d test/bad-name-1/foo.sql diff -r 6b27e5b734d8 -r 99142dcb072d test/bad-name-2/0001.sql diff -r 6b27e5b734d8 -r 99142dcb072d test/bad-name-3/1.meow.sql diff -r 6b27e5b734d8 -r 99142dcb072d test/broken-1/000-table.sql --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/broken-1/000-table.sql Tue Apr 09 14:01:57 2024 -0400 @@ -0,0 +1,4 @@ +CREATE TABLE foo ( + id INTEGER PRIMARY KEY, + foo TEXT NOT NULL +); diff -r 6b27e5b734d8 -r 99142dcb072d test/broken-2/000-table.sql --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/broken-2/000-table.sql Tue Apr 09 14:01:57 2024 -0400 @@ -0,0 +1,1 @@ +../broken-1/000-table.sql \ No newline at end of file diff -r 6b27e5b734d8 -r 99142dcb072d test/broken-2/001-broken.sql --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/broken-2/001-broken.sql Tue Apr 09 14:01:57 2024 -0400 @@ -0,0 +1,4 @@ +INSERT INTO foo (id, foo) VALUES (1, "x"); +INSERT INTO foo (id, foo) VALUES (2, "y"); +INSERT INTO foo (id, foo) VALUES (2, "dupe"); +INSERT INTO foo (id, foo) VALUES (4, "z"); diff -r 6b27e5b734d8 -r 99142dcb072d test/broken-3/000-table.sql --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/broken-3/000-table.sql Tue Apr 09 14:01:57 2024 -0400 @@ -0,0 +1,1 @@ +../broken-1/000-table.sql \ No newline at end of file diff -r 6b27e5b734d8 -r 99142dcb072d test/broken-3/001-broken.sql --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/broken-3/001-broken.sql Tue Apr 09 14:01:57 2024 -0400 @@ -0,0 +1,1 @@ +../broken-2/001-broken.sql \ No newline at end of file diff -r 6b27e5b734d8 -r 99142dcb072d test/broken-3/002-more.sql --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/broken-3/002-more.sql Tue Apr 09 14:01:57 2024 -0400 @@ -0,0 +1,1 @@ +INSERT INTO foo (id, foo) VALUES (5, "q"); diff -r 6b27e5b734d8 -r 99142dcb072d test/package.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/package.lisp Tue Apr 09 14:01:57 2024 -0400 @@ -0,0 +1,3 @@ +(defpackage :dbvolve/test + (:use :cl :1am) + (:export :run-tests)) diff -r 6b27e5b734d8 -r 99142dcb072d test/run.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/run.lisp Tue Apr 09 14:01:57 2024 -0400 @@ -0,0 +1,5 @@ +#+ecl (setf compiler:*user-cc-flags* "-Wno-shift-negative-value") + +(ql:quickload :dbvolve :silent t) +(asdf:test-system :dbvolve) +(quit) diff -r 6b27e5b734d8 -r 99142dcb072d test/tests.lisp --- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/test/tests.lisp Tue Apr 09 14:01:57 2024 -0400 @@ -0,0 +1,78 @@ +(in-package :dbvolve/test) + + +;;;; Utils -------------------------------------------------------------------- +(defmacro define-test (name &body body) + `(test ,(intern (concatenate 'string (symbol-name 'test/) (symbol-name name))) + (let ((*package* ,*package*)) + ,@body))) + +(defmacro with-db (db-symbol &body body) + `(sqlite:with-open-database (,db-symbol ":memory:") + (let ((dbvolve::*log-stream* (make-broadcast-stream))) + ,@body))) + +(defun run-tests () + (1am:run)) + +(defmacro check-migrations (db &rest expected) + `(is (equal '(,@expected) + (sqlite:execute-to-list ,db "select id, name from dbvolve order by id;")))) + +;;;; Tests -------------------------------------------------------------------- +(define-test no-migrations + (with-db db + ;; Should not signal an error. + (dbvolve:evolve db "test/example-0/") + (check-migrations db))) + +(define-test single-migration + (with-db db + (dbvolve:evolve db "test/example-1/") + (check-migrations db (0 "users-table")) + (is (equal '((0 "sjl")) + (sqlite:execute-to-list db "select * from users;"))))) + +(define-test one-at-a-time + (with-db db + (dbvolve:evolve db "test/example-1/") + (check-migrations db (0 "users-table")) + (is (equal '((0 "sjl")) + (sqlite:execute-to-list db "select * from users;"))) + (dbvolve:evolve db "test/example-2/") + (check-migrations db (0 "users-table") (1 "add-email")) + (is (equal '((0 "sjl" "steve@stevelosh.com")) + (sqlite:execute-to-list db "select * from users;"))))) + +(define-test multiple-migrations + (with-db db + (dbvolve:evolve db "test/example-3/") + (is (equal '((0 0 "Write DBvolve skeleton." 1) + (1 0 "Write DBvolve test suite." 0)) + (sqlite:execute-to-list db "select id, user_id, content, done from todos;"))) + (check-migrations db (0 "users-table") (1 "add-email") (2 "add-todos")))) + +(define-test broken-migrations + (with-db db + ;; start with an empty set + (dbvolve:evolve db "test/example-0/") + (check-migrations db) + (dbvolve:evolve db "test/broken-1/") + (check-migrations db (0 "table")) + (signals error (dbvolve:evolve db "test/broken-2/")) + (check-migrations db (0 "table")) ; should not have applied bad migration + (signals error (dbvolve:evolve db "test/broken-3/")) ; broken migrations stops all further ones + (check-migrations db (0 "table"))) + (with-db db + ;; start with an empty set + (dbvolve:evolve db "test/example-0/") + (check-migrations db) + ;; should be all-or-nothing + (signals error (dbvolve:evolve db "test/broken-3/")) + (check-migrations db))) + +(define-test bad-name + (with-db db + (signals error (dbvolve:evolve db "test/bad-name-1/")) + (signals error (dbvolve:evolve db "test/bad-name-2/")) + (signals error (dbvolve:evolve db "test/bad-name-3/"))))