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