db.lisp (11287B)
1 (in-package :miniblog/tests) 2 3 (in-suite miniblog-test) 4 5 (defparameter +db-settings+ '(sqlite3 :database-name ":memory:")) 6 7 (test add-and-get-entry 8 "Add an entry and then fetch it back, verify all fields are correct" 9 (let ((mito:*connection* (apply #'dbi:connect +db-settings+))) 10 (miniblog.db:init-tables) 11 (let* ((title "Test entry") 12 (content "Test content") 13 (username "test") 14 (new-entry (miniblog.db:add-entry title content :username username)) 15 (now (local-time:now)) 16 (new-id (getf new-entry :id)) 17 (fetched-entry (miniblog.db:get-entry new-id))) 18 (is (and (string= title (getf new-entry :title)) 19 (string= title (getf fetched-entry :title)))) 20 (is (and (string= content (getf new-entry :content)) 21 (string= content (getf fetched-entry :content)))) 22 (is (and (string= username (getf new-entry :created-by)) 23 (string= username (getf fetched-entry :created-by)))) 24 (is (and (string= username (getf new-entry :last-updated-by)) 25 (string= username (getf fetched-entry :last-updated-by)))) 26 (is (and (< (timestamp-difference now (getf new-entry :created-at)) 1) 27 (>= (timestamp-difference now (getf new-entry :created-at)) 0))) 28 (is (and (timestamp= (getf new-entry :created-at) 29 (getf new-entry :last-updated-at)))) 30 (is (and (timestamp= (getf new-entry :created-at) 31 (getf fetched-entry :created-at)))) 32 (is (and (timestamp= (getf new-entry :last-updated-at) 33 (getf fetched-entry :last-updated-at))))))) 34 35 (test modify-entry 36 "Update an entry, verify update fields" 37 (let ((mito:*connection* (apply #'dbi:connect +db-settings+))) 38 (miniblog.db:init-tables) 39 (let* ((title "Before title") 40 (content "Before content") 41 (username "before") 42 (entry (miniblog.db:add-entry title content :username username)) 43 (id (getf entry :id)) 44 (new-title "After title") 45 (new-content "After content") 46 (new-username "after") 47 (updated-entry (miniblog.db:update-entry id new-title new-content :username new-username))) 48 (is (string= new-title (getf updated-entry :title))) 49 (is (string= new-content (getf updated-entry :content))) 50 (is (string= username (getf updated-entry :created-by))) 51 (is (string= new-username (getf updated-entry :last-updated-by))) 52 (is (> (timestamp-difference (getf updated-entry :last-updated-at) (getf updated-entry :created-at)) 0))))) 53 54 (test delete-entry 55 "Add an entry, delete it and verify it's removed" 56 (let ((mito:*connection* (apply #'dbi:connect +db-settings+))) 57 (miniblog.db:init-tables) 58 (let* ((entry (miniblog.db:add-entry "foo" "foo")) 59 (id (getf entry :id))) 60 (is (miniblog.db:get-entry id)) 61 (miniblog.db:delete-entry id) 62 (is (not (miniblog.db:get-entry id)))))) 63 64 (test add-and-get-page 65 "Add a page and then fetch it back, verify all fields are correct" 66 (let ((mito:*connection* (apply #'dbi:connect +db-settings+))) 67 (miniblog.db:init-tables) 68 (let* ((name "test") 69 (title "Test page") 70 (content "Test content") 71 (username "test") 72 (new-page (miniblog.db:add-page name title content :username username)) 73 (now (local-time:now)) 74 (new-id (getf new-page :id)) 75 (fetched-page (miniblog.db:get-page new-id))) 76 (is (and (eql 0 (getf new-page :parent)) 77 (eql 0 (getf fetched-page :parent)))) 78 (is (and (string= name (getf new-page :name)) 79 (string= name (getf fetched-page :name)))) 80 (is (and (string= title (getf new-page :title)) 81 (string= title (getf fetched-page :title)))) 82 (is (and (string= content (getf new-page :content)) 83 (string= content (getf fetched-page :content)))) 84 (is (and (string= username (getf new-page :created-by)) 85 (string= username (getf fetched-page :created-by)))) 86 (is (and (string= username (getf new-page :last-updated-by)) 87 (string= username (getf fetched-page :last-updated-by)))) 88 (is (and (< (timestamp-difference now (getf new-page :created-at)) 1) 89 (>= (timestamp-difference now (getf new-page :created-at)) 0))) 90 (is (and (timestamp= (getf new-page :created-at) 91 (getf new-page :last-updated-at)))) 92 (is (and (timestamp= (getf new-page :created-at) 93 (getf fetched-page :created-at)))) 94 (is (and (timestamp= (getf new-page :last-updated-at) 95 (getf fetched-page :last-updated-at))))))) 96 97 (test modify-page 98 "Update a page, verify update fields" 99 (let ((mito:*connection* (apply #'dbi:connect +db-settings+))) 100 (miniblog.db:init-tables) 101 (let* ((name "before") 102 (title "Before title") 103 (content "Before content") 104 (username "before") 105 (page (miniblog.db:add-page name title content :username username)) 106 (id (getf page :id)) 107 (new-name "after") 108 (new-title "After title") 109 (new-content "After content") 110 (new-username "after") 111 (updated-page (miniblog.db:update-page id new-name new-title new-content :username new-username))) 112 (is (eql 0 (getf updated-page :parent))) 113 (is (string= new-title (getf updated-page :title))) 114 (is (string= new-content (getf updated-page :content))) 115 (is (string= username (getf updated-page :created-by))) 116 (is (string= new-username (getf updated-page :last-updated-by))) 117 (is (> (timestamp-difference (getf updated-page :last-updated-at) (getf updated-page :created-at)) 0))))) 118 119 (test move-page 120 "Create several test pages, move one in the hierarchy and verify the move" 121 (let ((mito:*connection* (apply #'dbi:connect +db-settings+))) 122 (miniblog.db:init-tables) 123 (let* ((page-1 (miniblog.db:add-page "foo" "foo" "foo")) 124 (page-1-id (getf page-1 :id)) 125 (page-2 (miniblog.db:add-page "bar" "bar" "bar" :parent page-1-id)) 126 (page-2-id (getf page-2 :id)) 127 (page-3 (miniblog.db:add-page "baz" "baz" "baz" :parent page-2-id)) 128 (page-3-id (getf page-3 :id)) 129 (moved-page-2 (miniblog.db:move-page page-2-id 0)) 130 (page-3-post-move (miniblog.db:get-page page-3-id))) 131 (is (eql page-1-id (getf page-2 :parent))) 132 (is (eql 0 (getf moved-page-2 :parent))) 133 (is (and (eql page-2-id (getf page-3 :parent)) 134 (eql page-2-id (getf page-3-post-move :parent))))))) 135 136 (test delete-page 137 "Add a page, delete it and verify it's removed" 138 (let ((mito:*connection* (apply #'dbi:connect +db-settings+))) 139 (miniblog.db:init-tables) 140 (let* ((page (miniblog.db:add-page "foo" "foo" "foo")) 141 (id (getf page :id))) 142 (is (miniblog.db:get-page id)) 143 (miniblog.db:delete-page id) 144 (is (not (miniblog.db:get-page id)))))) 145 146 (test delete-page-moving-subtree-to-root 147 "Add a page with a child, delete it and verify that it's removed and its child is reparented to the root" 148 (let ((mito:*connection* (apply #'dbi:connect +db-settings+))) 149 (miniblog.db:init-tables) 150 (let* ((page-1 (miniblog.db:add-page "foo" "foo" "foo")) 151 (page-1-id (getf page-1 :id)) 152 (page-2 (miniblog.db:add-page "bar" "bar" "bar" :parent (getf page-1 :id))) 153 (page-2-id (getf page-2 :id))) 154 (miniblog.db:delete-page page-1-id :children :move-to-root) 155 (is (not (miniblog.db:get-page page-1-id))) 156 (is (eql 0 (getf (miniblog.db:get-page page-2-id) :parent)))))) 157 158 (test delete-page-moving-subtree-to-parent 159 "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" 160 (let ((mito:*connection* (apply #'dbi:connect +db-settings+))) 161 (miniblog.db:init-tables) 162 (let* ((page-1 (miniblog.db:add-page "foo" "foo" "foo")) 163 (page-1-id (getf page-1 :id)) 164 (page-2 (miniblog.db:add-page "bar" "bar" "bar" :parent page-1-id)) 165 (page-2-id (getf page-2 :id)) 166 (page-3 (miniblog.db:add-page "baz" "baz" "baz" :parent page-2-id)) 167 (page-3-id (getf page-3 :id))) 168 (miniblog.db:delete-page page-2-id) ; :MOVE-TO-PARENT is default 169 (is (eql page-1-id (getf (miniblog.db:get-page page-3-id) :parent)))))) 170 171 (test delete-page-deleting-subtree 172 "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" 173 (let ((mito:*connection* (apply #'dbi:connect +db-settings+))) 174 (miniblog.db:init-tables) 175 (let* ((page-1 (miniblog.db:add-page "foo" "foo" "foo")) 176 (page-1-id (getf page-1 :id)) 177 (page-2 (miniblog.db:add-page "bar" "bar" "bar" :parent page-1-id)) 178 (page-2-id (getf page-2 :id)) 179 (page-3 (miniblog.db:add-page "baz" "baz" "baz" :parent page-2-id)) 180 (page-3-id (getf page-3 :id)) 181 (page-4 (miniblog.db:add-page "quux" "quux" "quux" :parent page-3-id)) 182 (page-4-id (getf page-4 :id)) 183 (page-5 (miniblog.db:add-page "wibble" "wibble" "wibble" :parent page-2-id)) 184 (page-5-id (getf page-5 :id)) 185 (page-6 (miniblog.db:add-page "frotz" "frotz" "frotz" :parent page-5-id)) 186 (page-6-id (getf page-6 :id))) 187 (miniblog.db:delete-page page-2-id :children :delete) 188 (is (and (not (miniblog.db:get-page page-3-id))) 189 (not (miniblog.db:get-page page-4-id)) 190 (not (miniblog.db:get-page page-5-id)) 191 (not (miniblog.db:get-page page-6-id)))))) 192 193 (test get-pages 194 "Add a tree of pages and verify that get-pages returns the tree as constructed" 195 (let ((mito:*connection* (apply #'dbi:connect +db-settings+))) 196 (miniblog.db:init-tables) 197 (let* ((page-1 (miniblog.db:add-page "foo" "foo" "foo")) 198 (page-1-id (getf page-1 :id)) 199 (page-2 (miniblog.db:add-page "bar" "bar" "bar" :parent page-1-id)) 200 (page-2-id (getf page-2 :id)) 201 (page-3 (miniblog.db:add-page "baz" "baz" "baz" :parent page-2-id)) 202 (page-3-id (getf page-3 :id)) 203 (page-4 (miniblog.db:add-page "quux" "quux" "quux" :parent page-3-id)) 204 (page-4-id (getf page-4 :id)) 205 (page-5 (miniblog.db:add-page "wibble" "wibble" "wibble" :parent page-2-id)) 206 (page-5-id (getf page-5 :id)) 207 (pages (miniblog.db:get-pages)) 208 (maybe-page-1 (car (getf pages :children))) 209 (maybe-page-2 (car (getf maybe-page-1 :children))) 210 (maybe-page-3 (cadr (getf maybe-page-2 :children))) 211 (maybe-page-4 (car (getf maybe-page-3 :children))) 212 (maybe-page-5 (car (getf maybe-page-2 :children)))) 213 (is (eql page-1-id (getf maybe-page-1 :id))) 214 (is (eql page-2-id (getf maybe-page-2 :id))) 215 (is (eql page-3-id (getf maybe-page-3 :id))) 216 (is (eql page-4-id (getf maybe-page-4 :id))) 217 (is (eql page-5-id (getf maybe-page-5 :id))))))