diff of 8fba5e3c532ca8a80341fdf5fb08beadd0be63bb
8fba5e3c532ca8a80341fdf5fb08beadd0be63bb
diff --git a/aggressive-murja.asd b/aggressive-murja.asd
index 0ab224d..e943848 100644
--- a/aggressive-murja.asd
+++ b/aggressive-murja.asd
@@ -46,7 +46,16 @@
(:file "post-routes")
(:file "media-routes")
(:file "root-routes")))
- (:file "main")))))
+ (:file "main"))))
+ :in-order-to ((test-op (test-op "pichunter/tests"))))
-
-
+(defsystem "aggressive-murja-tests"
+ :author "Ilpo Lehtinen"
+ :licence "GPLv3"
+ :depends-on ("aggressive-murja"
+ "fiveam")
+ :components ((:module "test"
+ :components
+ ((:file "tests"))))
+ :perform (test-op (op c)
+ (eval (read-from-string "(fiveam:run! 'murja.tests:main-suite)"))))
diff --git a/docker-compose.yml b/docker-compose.yml
index c63da42..8d29c60 100644
--- a/docker-compose.yml
+++ b/docker-compose.yml
@@ -1,4 +1,15 @@
services:
+ automatic-test-db:
+ image: postgres:latest
+ ports:
+ - 2345:5432
+ environment:
+ POSTGRES_USER: blogadmin
+ POSTGRES_PASSWORD: blog
+ POSTGRES_DB: blogdb
+ POSTGRES_INITDB_ARGS: '--locale en_US.UTF-8'
+ networks:
+ - murja_test_network
db:
image: postgres:latest
ports:
@@ -11,5 +22,16 @@ services:
networks:
- murja_test_network
+ murja:
+ image: ghcr.io/feuery/murja:latest
+ ports:
+ - 3010:3010
+ environment:
+ MURJA_DB_HOST: db
+ networks:
+ - murja_test_network
+ depends_on:
+ - db
+
networks:
murja_test_network:
diff --git a/run_tests.lisp b/run_tests.lisp
new file mode 100644
index 0000000..4f5aa54
--- /dev/null
+++ b/run_tests.lisp
@@ -0,0 +1,3 @@
+(ql:quickload :aggressive-murja-tests)
+(unless (fiveam:run! 'murja.tests/main:main-suite)
+ (sb-ext:exit :code 666))
diff --git a/src/local-lib/migrations.lisp b/src/local-lib/migrations.lisp
index b2b670a..4778951 100644
--- a/src/local-lib/migrations.lisp
+++ b/src/local-lib/migrations.lisp
@@ -1,7 +1,7 @@
(defpackage murja.migrations
(:use :halisql)
(:use :cl)
- (:export :deflispmigration :defmigration :migrate))
+ (:export :migration-does-exist :deflispmigration :defmigration :migrate))
(in-package :murja.migrations)
@@ -17,31 +17,6 @@
(defun migration-table-exists ()
(gethash "exists" (aref (migration-table-exists*) 0)))
-
-
-(defun defmigration (path &key initial)
- (let* ((filename (asdf:system-relative-pathname *system-name*
- (format nil "resources/sql/~a.sql" path)))
- ;; ragtime legacy, migration filenames are named .up.sql but they were saved into the public.ragtime_migrations without the .up.sql postfix
- ;; and murja.migrations/halisql system drops the .sql extension, but halisql functions don't handle the .up. string correctly
- (path (str:replace-all ".up" "" path))
- (fn (lambda ()
- (cond ((and initial (not (migration-table-exists)))
- (postmodern:execute-file filename))
-
- ((and (migration-table-exists) (not (migration-does-exist path)))
- (postmodern:execute-file filename))
-
- (t (log:info "Didn't run ~a" path)))))
- (found-migration? nil))
- (dolist (mig *migrations*)
- (when (string= (first mig) path)
- (setf (cdr mig) fn)
- (setf found-migration? t)
- (return)))
-
- (unless found-migration?
- (push (cons path fn) *migrations*))))
(defmacro deflispmigration (filename-sym path &rest body)
`(let* ((,filename-sym (asdf:system-relative-pathname *system-name*
@@ -63,13 +38,17 @@
(defun defmigration (file-path &key initial)
(deflispmigration filename file-path
+ (log:info "Migration result: ~a"
(cond ((and initial (not (migration-table-exists)))
- (postmodern:execute-file filename))
+ (postmodern:execute-file filename)
+ (mark-migration-done file-path))
((and (migration-table-exists) (not (migration-does-exist path)))
- (postmodern:execute-file filename))
+ (log:info "Really running ~a" file-path)
+ (postmodern:execute-file filename)
+ (mark-migration-done file-path))
- (t (log:info "Didn't run ~a" path)))))
+ (t (log:info "Didn't run ~a" path))))))
(defun migrate ()
(postmodern:with-transaction ()
diff --git a/src/middleware/db.lisp b/src/middleware/db.lisp
index 694a1cf..c037dac 100644
--- a/src/middleware/db.lisp
+++ b/src/middleware/db.lisp
@@ -1,9 +1,13 @@
(defpackage murja.middleware.db
(:use :cl :postmodern)
- (:export :connect-murjadb-toplevel))
+ (:export :connect-murjadb-toplevel
+ :with-db
+ :*automatic-tests-on?*))
(in-package :murja.middleware.db)
+(defvar *automatic-tests-on?* nil)
+
(defun db-config ()
(list :db (or (sb-ext:posix-getenv "MURJA_DB")
"blogdb")
@@ -13,7 +17,9 @@
"blog")
:host (or (sb-ext:posix-getenv "MURJA_DB_HOST")
"localhost")
- :port (let ((port-str (sb-ext:posix-getenv "MURJA_DB_PORT")))
+ :port (let ((port-str (if *automatic-tests-on?*
+ "2345"
+ (sb-ext:posix-getenv "MURJA_DB_PORT"))))
(if port-str
(parse-integer port-str)
5432))))
diff --git a/test/tests.lisp b/test/tests.lisp
new file mode 100644
index 0000000..2e37177
--- /dev/null
+++ b/test/tests.lisp
@@ -0,0 +1,62 @@
+(defpackage murja.tests
+ (:use :cl
+ :fiveam)
+ (:export ))
+
+(in-package :murja.tests)
+
+(def-suite main-suite)
+
+(defvar *test-server* nil)
+(defvar *test-port* 3001)
+
+(defun url ()
+ (format nil "http://localhost:~d" *test-port*))
+
+(def-fixture prepare-db-and-server ()
+ (let ((murja.middleware.db:*automatic-tests-on?* t))
+ (murja.middleware.db:with-db
+ (postmodern:execute "DROP SCHEMA IF EXISTS blog CASCADE;")
+ (postmodern:execute "DROP TABLE IF EXISTS public.ragtime_migrations")
+ (postmodern:execute "DROP TABLE IF EXISTS public.migrations_tracker")
+
+ ;; (format t "Doing migrations: ~%")
+
+ ;; (murja.migrations:migrate)
+
+ ;; (format t "Done migrations: ~%")
+
+ (unwind-protect
+ (progn
+ (setf *test-server* (murja:start-server :port *test-port*))
+ (format t "Starting the test &body~%")
+ (&body))
+
+ ;; (postmodern:execute "DROP SCHEMA IF EXISTS blog CASCADE;")
+ ;; (postmodern:execute "DROP TABLE IF EXISTS public.ragtime_migrations")
+ ;; (postmodern:execute "DROP TABLE IF EXISTS public.migrations_tracker")
+ (hunchentoot:stop *test-server*)
+ (setf *test-server* nil)))))
+
+(def-test multiple-migrations (:suite main-suite :fixture prepare-db-and-server)
+ (let ((successfully-migrated nil))
+ (unwind-protect
+ (progn
+ (log:info "Does 001-users.up exist? ~a" (murja.migrations:migration-does-exist "001-users.up"))
+ (log:info "Existing migrations: ~{~a~%~}" (coerce
+ (postmodern:query "SELECT * FROM public.migrations_tracker" :alists) 'list))
+ (log:info "Re-running migrations")
+ (handler-case
+ (murja.migrations:migrate)
+ (error (c)
+ (log:error "Migrations failed ~a" c)
+ (error 'fail)))
+ (log:info "Re-ran migrations")
+ (setf successfully-migrated t)))
+ (is (equalp successfully-migrated t))))
+
+(def-test history (:suite main-suite :fixture prepare-db-and-server)
+ ;;(is (equalp 3 55))
+ (is (equalp 1 1)))
+
+;; (run! 'main-suite)