--- 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 <steve@stevelosh.com>"
+ :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"))))
--- 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)))))))))
--- /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
+);
--- /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
--- /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");
--- /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
--- /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
--- /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");
--- /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))
--- /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)
--- /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/"))))