commit 902f0b869105c6a2ff900bc3a6f3385761cd68d0
parent 964d88c89c27e06d0d7956b84c5e1188b9da9227
Author: Decay <decay@todayiwilllaunchmyinfantsonintoorbit.com>
Date: Sun, 4 Oct 2020 16:16:17 -0700
Initial set of unit tests
Code needs some refactoring to be more easily testable so this is
a very limited set of tests to begin with.
Diffstat:
5 files changed, 282 insertions(+), 1 deletion(-)
diff --git a/miniblog.asd b/miniblog.asd
@@ -36,10 +36,22 @@ into date-structured directories as a normal HTML."
(:static-file "template.lhtml")
(:static-file "rss.lxml")))
(:static-file "COPYING")
- (:static-file "README")))
+ (:static-file "README"))
+ :in-order-to ((test-op (test-op "miniblog/tests"))))
(defsystem "miniblog/executable"
:build-operation program-op
:build-pathname "miniblog"
:entry-point "miniblog:entry-point"
:depends-on ("miniblog"))
+
+(defsystem "miniblog/tests"
+ :depends-on ("miniblog"
+ "cl-html5-parser"
+ "fiveam")
+ :components ((:module "tst"
+ :components ((:file "packages")
+ (:file "format")
+ (:file "edit")
+ (:file "db"))))
+ :perform (test-op (o c) (symbol-call :miniblog/tests :run-miniblog-tests)))
diff --git a/tst/db.lisp b/tst/db.lisp
@@ -0,0 +1,217 @@
+(in-package :miniblog/tests)
+
+(in-suite miniblog-test)
+
+(defparameter +db-settings+ '(sqlite3 :database-name ":memory:"))
+
+(test add-and-get-entry
+ "Add an entry and then fetch it back, verify all fields are correct"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((title "Test entry")
+ (content "Test content")
+ (username "test")
+ (new-entry (miniblog.db:add-entry title content :username username))
+ (now (local-time:now))
+ (new-id (getf new-entry :id))
+ (fetched-entry (miniblog.db:get-entry new-id)))
+ (is (and (string= title (getf new-entry :title))
+ (string= title (getf fetched-entry :title))))
+ (is (and (string= content (getf new-entry :content))
+ (string= content (getf fetched-entry :content))))
+ (is (and (string= username (getf new-entry :created-by))
+ (string= username (getf fetched-entry :created-by))))
+ (is (and (string= username (getf new-entry :last-updated-by))
+ (string= username (getf fetched-entry :last-updated-by))))
+ (is (and (< (timestamp-difference now (getf new-entry :created-at)) 1)
+ (>= (timestamp-difference now (getf new-entry :created-at)) 0)))
+ (is (and (timestamp= (getf new-entry :created-at)
+ (getf new-entry :last-updated-at))))
+ (is (and (timestamp= (getf new-entry :created-at)
+ (getf fetched-entry :created-at))))
+ (is (and (timestamp= (getf new-entry :last-updated-at)
+ (getf fetched-entry :last-updated-at)))))))
+
+(test modify-entry
+ "Update an entry, verify update fields"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((title "Before title")
+ (content "Before content")
+ (username "before")
+ (entry (miniblog.db:add-entry title content :username username))
+ (id (getf entry :id))
+ (new-title "After title")
+ (new-content "After content")
+ (new-username "after")
+ (updated-entry (miniblog.db:update-entry id new-title new-content :username new-username)))
+ (is (string= new-title (getf updated-entry :title)))
+ (is (string= new-content (getf updated-entry :content)))
+ (is (string= username (getf updated-entry :created-by)))
+ (is (string= new-username (getf updated-entry :last-updated-by)))
+ (is (> (timestamp-difference (getf updated-entry :last-updated-at) (getf updated-entry :created-at)) 0)))))
+
+(test delete-entry
+ "Add an entry, delete it and verify it's removed"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((entry (miniblog.db:add-entry "foo" "foo"))
+ (id (getf entry :id)))
+ (is (miniblog.db:get-entry id))
+ (miniblog.db:delete-entry id)
+ (is (not (miniblog.db:get-entry id))))))
+
+(test add-and-get-page
+ "Add a page and then fetch it back, verify all fields are correct"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((name "test")
+ (title "Test page")
+ (content "Test content")
+ (username "test")
+ (new-page (miniblog.db:add-page name title content :username username))
+ (now (local-time:now))
+ (new-id (getf new-page :id))
+ (fetched-page (miniblog.db:get-page new-id)))
+ (is (and (eql 0 (getf new-page :parent))
+ (eql 0 (getf fetched-page :parent))))
+ (is (and (string= name (getf new-page :name))
+ (string= name (getf fetched-page :name))))
+ (is (and (string= title (getf new-page :title))
+ (string= title (getf fetched-page :title))))
+ (is (and (string= content (getf new-page :content))
+ (string= content (getf fetched-page :content))))
+ (is (and (string= username (getf new-page :created-by))
+ (string= username (getf fetched-page :created-by))))
+ (is (and (string= username (getf new-page :last-updated-by))
+ (string= username (getf fetched-page :last-updated-by))))
+ (is (and (< (timestamp-difference now (getf new-page :created-at)) 1)
+ (>= (timestamp-difference now (getf new-page :created-at)) 0)))
+ (is (and (timestamp= (getf new-page :created-at)
+ (getf new-page :last-updated-at))))
+ (is (and (timestamp= (getf new-page :created-at)
+ (getf fetched-page :created-at))))
+ (is (and (timestamp= (getf new-page :last-updated-at)
+ (getf fetched-page :last-updated-at)))))))
+
+(test modify-page
+ "Update a page, verify update fields"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((name "before")
+ (title "Before title")
+ (content "Before content")
+ (username "before")
+ (page (miniblog.db:add-page name title content :username username))
+ (id (getf page :id))
+ (new-name "after")
+ (new-title "After title")
+ (new-content "After content")
+ (new-username "after")
+ (updated-page (miniblog.db:update-page id new-name new-title new-content :username new-username)))
+ (is (eql 0 (getf updated-page :parent)))
+ (is (string= new-title (getf updated-page :title)))
+ (is (string= new-content (getf updated-page :content)))
+ (is (string= username (getf updated-page :created-by)))
+ (is (string= new-username (getf updated-page :last-updated-by)))
+ (is (> (timestamp-difference (getf updated-page :last-updated-at) (getf updated-page :created-at)) 0)))))
+
+(test move-page
+ "Create several test pages, move one in the hierarchy and verify the move"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((page-1 (miniblog.db:add-page "foo" "foo" "foo"))
+ (page-1-id (getf page-1 :id))
+ (page-2 (miniblog.db:add-page "bar" "bar" "bar" :parent page-1-id))
+ (page-2-id (getf page-2 :id))
+ (page-3 (miniblog.db:add-page "baz" "baz" "baz" :parent page-2-id))
+ (page-3-id (getf page-3 :id))
+ (moved-page-2 (miniblog.db:move-page page-2-id 0))
+ (page-3-post-move (miniblog.db:get-page page-3-id)))
+ (is (eql page-1-id (getf page-2 :parent)))
+ (is (eql 0 (getf moved-page-2 :parent)))
+ (is (and (eql page-2-id (getf page-3 :parent))
+ (eql page-2-id (getf page-3-post-move :parent)))))))
+
+(test delete-page
+ "Add a page, delete it and verify it's removed"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((page (miniblog.db:add-page "foo" "foo" "foo"))
+ (id (getf page :id)))
+ (is (miniblog.db:get-page id))
+ (miniblog.db:delete-page id)
+ (is (not (miniblog.db:get-page id))))))
+
+(test delete-page-moving-subtree-to-root
+ "Add a page with a child, delete it and verify that it's removed and its child is reparented to the root"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((page-1 (miniblog.db:add-page "foo" "foo" "foo"))
+ (page-1-id (getf page-1 :id))
+ (page-2 (miniblog.db:add-page "bar" "bar" "bar" :parent (getf page-1 :id)))
+ (page-2-id (getf page-2 :id)))
+ (miniblog.db:delete-page page-1-id :children :move-to-root)
+ (is (not (miniblog.db:get-page page-1-id)))
+ (is (eql 0 (getf (miniblog.db:get-page page-2-id) :parent))))))
+
+(test delete-page-moving-subtree-to-parent
+ "Add three test pages, each the next one's parent, delete the second one and verify that it's removed and its child is reparented to first page"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((page-1 (miniblog.db:add-page "foo" "foo" "foo"))
+ (page-1-id (getf page-1 :id))
+ (page-2 (miniblog.db:add-page "bar" "bar" "bar" :parent page-1-id))
+ (page-2-id (getf page-2 :id))
+ (page-3 (miniblog.db:add-page "baz" "baz" "baz" :parent page-2-id))
+ (page-3-id (getf page-3 :id)))
+ (miniblog.db:delete-page page-2-id) ; :MOVE-TO-PARENT is default
+ (is (eql page-1-id (getf (miniblog.db:get-page page-3-id) :parent))))))
+
+(test delete-page-deleting-subtree
+ "Add six test pages with the first the second's parent and the second the top of a subtree containing the other four, delete the second one and verify that it's removed and all its children are as well"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((page-1 (miniblog.db:add-page "foo" "foo" "foo"))
+ (page-1-id (getf page-1 :id))
+ (page-2 (miniblog.db:add-page "bar" "bar" "bar" :parent page-1-id))
+ (page-2-id (getf page-2 :id))
+ (page-3 (miniblog.db:add-page "baz" "baz" "baz" :parent page-2-id))
+ (page-3-id (getf page-3 :id))
+ (page-4 (miniblog.db:add-page "quux" "quux" "quux" :parent page-3-id))
+ (page-4-id (getf page-4 :id))
+ (page-5 (miniblog.db:add-page "wibble" "wibble" "wibble" :parent page-2-id))
+ (page-5-id (getf page-5 :id))
+ (page-6 (miniblog.db:add-page "frotz" "frotz" "frotz" :parent page-5-id))
+ (page-6-id (getf page-6 :id)))
+ (miniblog.db:delete-page page-2-id :children :delete)
+ (is (and (not (miniblog.db:get-page page-3-id)))
+ (not (miniblog.db:get-page page-4-id))
+ (not (miniblog.db:get-page page-5-id))
+ (not (miniblog.db:get-page page-6-id))))))
+
+(test get-pages
+ "Add a tree of pages and verify that get-pages returns the tree as constructed"
+ (let ((mito:*connection* (apply #'dbi:connect +db-settings+)))
+ (miniblog.db:init-tables)
+ (let* ((page-1 (miniblog.db:add-page "foo" "foo" "foo"))
+ (page-1-id (getf page-1 :id))
+ (page-2 (miniblog.db:add-page "bar" "bar" "bar" :parent page-1-id))
+ (page-2-id (getf page-2 :id))
+ (page-3 (miniblog.db:add-page "baz" "baz" "baz" :parent page-2-id))
+ (page-3-id (getf page-3 :id))
+ (page-4 (miniblog.db:add-page "quux" "quux" "quux" :parent page-3-id))
+ (page-4-id (getf page-4 :id))
+ (page-5 (miniblog.db:add-page "wibble" "wibble" "wibble" :parent page-2-id))
+ (page-5-id (getf page-5 :id))
+ (pages (miniblog.db:get-pages))
+ (maybe-page-1 (car (getf pages :children)))
+ (maybe-page-2 (car (getf maybe-page-1 :children)))
+ (maybe-page-3 (cadr (getf maybe-page-2 :children)))
+ (maybe-page-4 (car (getf maybe-page-3 :children)))
+ (maybe-page-5 (car (getf maybe-page-2 :children))))
+ (is (eql page-1-id (getf maybe-page-1 :id)))
+ (is (eql page-2-id (getf maybe-page-2 :id)))
+ (is (eql page-3-id (getf maybe-page-3 :id)))
+ (is (eql page-4-id (getf maybe-page-4 :id)))
+ (is (eql page-5-id (getf maybe-page-5 :id))))))
diff --git a/tst/edit.lisp b/tst/edit.lisp
@@ -0,0 +1,13 @@
+(in-package :miniblog/tests)
+
+(in-suite miniblog-test)
+
+(test get-title-and-content
+ "Verify GET-TITLE-AND-CONTENT extracts the title and body as expected"
+ (let* ((title "Test title")
+ (body (format nil "Line 1~%Line 2~%Line 3"))
+ (content (format nil "~a~%~%~a~%" title body))
+ (output (miniblog.edit:get-title-and-content content)))
+ (format t "\"~a\"~%\"~a\"~%" (car output) (str:trim (cadr output)))
+ (is (and (string= title (car output))
+ (string= body (cadr output))))))
diff --git a/tst/format.lisp b/tst/format.lisp
@@ -0,0 +1,23 @@
+(in-package :miniblog/tests)
+
+(in-suite miniblog-test)
+
+(test test-date-formatters
+ "Validate that date formatters return expected results"
+ (let ((ts (encode-timestamp 0 0 0 12 20 4 2020 :timezone +utc-zone+))
+ (rfc-822 (miniblog.format:make-rfc-822-date-formatter +utc-zone+))
+ (short-date (miniblog.format:make-short-date-formatter +utc-zone+))
+ (long-date (miniblog.format:make-long-date-formatter +utc-zone+)))
+ (is (string= "Mon, 20 Apr 2020 12:00:00 +0000" (funcall rfc-822 ts)))
+ (is (string= "2020-04-20" (funcall short-date ts)))
+ (is (string= "Monday, April 20th 2020 at 12:00 pm UTC" (funcall long-date ts)))))
+
+(test test-markdown-formatter
+ "Simple validation that the Markdown formatter works"
+ (let* ((formatter (miniblog.format:make-content-formatter))
+ (html (funcall formatter "# foo"))
+ (html-frag (parse-html5-fragment html))
+ (maybe-h1 (node-first-child html-frag))
+ (maybe-text (node-first-child maybe-h1)))
+ (is (string= "h1" (node-name maybe-h1)))
+ (is (string= "foo" (node-value maybe-text)))))
diff --git a/tst/packages.lisp b/tst/packages.lisp
@@ -0,0 +1,16 @@
+(in-package :cl-user)
+
+(defpackage :miniblog/tests
+ (:use :cl :fiveam)
+ (:import-from :local-time :encode-timestamp :timestamp= :timestamp-difference
+ :+utc-zone+)
+ (:import-from :html5-parser :parse-html5-fragment :node-first-child :node-name
+ :node-value)
+ (:export #:run-miniblog-tests))
+
+(in-package :miniblog/tests)
+
+(def-suite miniblog-test)
+
+(defun run-miniblog-tests ()
+ (debug! 'miniblog-test))
