diff options
| author | Stephen Berman | 2017-07-07 22:03:21 +0200 |
|---|---|---|
| committer | Stephen Berman | 2017-07-07 22:03:21 +0200 |
| commit | c24748ada08ffdb2921826f2b954a230e25d1d60 (patch) | |
| tree | b6cd6c2f16ce78e8c5e664dfe10cfc8787d2453e /test | |
| parent | 264dd81d7bf14d39737677af11e1cd3d618ad887 (diff) | |
| download | emacs-c24748ada08ffdb2921826f2b954a230e25d1d60.tar.gz emacs-c24748ada08ffdb2921826f2b954a230e25d1d60.zip | |
Add new todo-mode.el tests
* test/lisp/calendar/todo-mode-tests.el (with-todo-test):
Declare an Edebug spec. Restore pre-test-run state of test files.
(todo-test--show, todo-test--move-item)
(todo-test--insert-item): New functions.
(todo-test-get-archive): Remove, as subsumed by
todo-test--show. Adjust all callers.
(todo-test--is-current-buffer): Rename from
todo-test-is-current-buffer and adjust uses.
(todo-test-item-highlighting): Use todo-test--show.
(todo-test-revert-buffer01, todo-test-revert-buffer02)
(todo-test-raise-lower-priority)
(todo-test-todo-mark-unmark-category, todo-test-move-item01)
(todo-test-move-item02, todo-test-move-item03)
(todo-test-move-item04, todo-test-move-item05)
(todo-test-toggle-item-header01)
(todo-test-toggle-item-header02)
(todo-test-toggle-item-header03)
(todo-test-toggle-item-header04)
(todo-test-toggle-item-header05)
(todo-test-toggle-item-header06)
(todo-test-toggle-item-header07): New tests.
* test/lisp/calendar/todo-mode-resources/todo-test-1.toda:
* test/lisp/calendar/todo-mode-resources/todo-test-1.todo:
Modify to accommodate new tests.
Diffstat (limited to 'test')
| -rw-r--r-- | test/lisp/calendar/todo-mode-resources/todo-test-1.toda | 6 | ||||
| -rw-r--r-- | test/lisp/calendar/todo-mode-resources/todo-test-1.todo | 14 | ||||
| -rw-r--r-- | test/lisp/calendar/todo-mode-tests.el | 470 |
3 files changed, 457 insertions, 33 deletions
diff --git a/test/lisp/calendar/todo-mode-resources/todo-test-1.toda b/test/lisp/calendar/todo-mode-resources/todo-test-1.toda index 8ca4e1908da..82262bddb68 100644 --- a/test/lisp/calendar/todo-mode-resources/todo-test-1.toda +++ b/test/lisp/calendar/todo-mode-resources/todo-test-1.toda | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | (("testcat1" . [0 0 1 0]) ("testcat2" . [0 0 1 0]) ("testcat3" . [0 0 1 0])) | 1 | (("testcat1" . [0 0 1 0]) ("testcat2" . [0 0 1 0]) ("testcat33" . [0 0 1 0])) |
| 2 | --==-- testcat1 | 2 | --==-- testcat1 |
| 3 | 3 | ||
| 4 | ==--== DONE | 4 | ==--== DONE |
| @@ -7,7 +7,7 @@ | |||
| 7 | 7 | ||
| 8 | ==--== DONE | 8 | ==--== DONE |
| 9 | [DONE May 28, 2017] [May 28, 2017] testcat2 item1 | 9 | [DONE May 28, 2017] [May 28, 2017] testcat2 item1 |
| 10 | --==-- testcat3 | 10 | --==-- testcat33 |
| 11 | 11 | ||
| 12 | ==--== DONE | 12 | ==--== DONE |
| 13 | [DONE May 28, 2017] [May 28, 2017] testcat3 item1 | 13 | [DONE May 28, 2017] [May 28, 2017] testcat33 item1 |
diff --git a/test/lisp/calendar/todo-mode-resources/todo-test-1.todo b/test/lisp/calendar/todo-mode-resources/todo-test-1.todo index 8e845df6b69..598d487cad9 100644 --- a/test/lisp/calendar/todo-mode-resources/todo-test-1.todo +++ b/test/lisp/calendar/todo-mode-resources/todo-test-1.todo | |||
| @@ -1,12 +1,20 @@ | |||
| 1 | (("testcat1" . [2 0 0 1]) ("testcat2" . [1 0 0 1])) | 1 | (("testcat1" . [2 0 2 1]) ("testcat2" . [3 0 1 1]) ("testcat3" . [0 0 0 0])) |
| 2 | --==-- testcat1 | 2 | --==-- testcat1 |
| 3 | [May 29, 2017] testcat1 item3 | 3 | [May 29, 2017] testcat1 item3 |
| 4 | has more than one line | 4 | has more than one line |
| 5 | to test item highlighting | 5 | to test item highlighting |
| 6 | [May 26, 2017] testcat1 item2 | 6 | [Jul 3, 2017] testcat1 item4 |
| 7 | 7 | ||
| 8 | ==--== DONE | 8 | ==--== DONE |
| 9 | [DONE Jul 3, 2017] [Jun 30, 2017] testcat1 item5 | ||
| 10 | [DONE Jul 3, 2017] [May 30, 2017] testcat1 item2 | ||
| 9 | --==-- testcat2 | 11 | --==-- testcat2 |
| 10 | [May 28, 2017] testcat2 item2 | 12 | [Jul 3, 2017] testcat2 item3 |
| 13 | [Jul 3, 2017] testcat2 item4 | ||
| 14 | [Jul 3, 2017] testcat2 item5 | ||
| 15 | |||
| 16 | ==--== DONE | ||
| 17 | [DONE Jul 3, 2017] [May 28, 2017] testcat2 item2 | ||
| 18 | --==-- testcat3 | ||
| 11 | 19 | ||
| 12 | ==--== DONE | 20 | ==--== DONE |
diff --git a/test/lisp/calendar/todo-mode-tests.el b/test/lisp/calendar/todo-mode-tests.el index 08dfe541929..71589879205 100644 --- a/test/lisp/calendar/todo-mode-tests.el +++ b/test/lisp/calendar/todo-mode-tests.el | |||
| @@ -44,6 +44,7 @@ | |||
| 44 | 44 | ||
| 45 | (defmacro with-todo-test (&rest body) | 45 | (defmacro with-todo-test (&rest body) |
| 46 | "Set up an isolated todo-mode test environment." | 46 | "Set up an isolated todo-mode test environment." |
| 47 | (declare (debug (body))) | ||
| 47 | `(let* ((todo-test-home (make-temp-file "todo-test-home-" t)) | 48 | `(let* ((todo-test-home (make-temp-file "todo-test-home-" t)) |
| 48 | (process-environment (cons (format "HOME=%s" todo-test-home) | 49 | (process-environment (cons (format "HOME=%s" todo-test-home) |
| 49 | process-environment)) | 50 | process-environment)) |
| @@ -52,27 +53,35 @@ | |||
| 52 | (car (funcall todo-files-function))))) | 53 | (car (funcall todo-files-function))))) |
| 53 | (unwind-protect | 54 | (unwind-protect |
| 54 | (progn ,@body) | 55 | (progn ,@body) |
| 56 | ;; Restore pre-test-run state of test files. | ||
| 57 | (dolist (f (directory-files todo-directory)) | ||
| 58 | (let ((buf (get-file-buffer f))) | ||
| 59 | (when buf | ||
| 60 | (with-current-buffer buf | ||
| 61 | (restore-buffer-modified-p nil) | ||
| 62 | (kill-buffer))))) | ||
| 55 | (delete-directory todo-test-home t)))) | 63 | (delete-directory todo-test-home t)))) |
| 56 | 64 | ||
| 57 | ;; (defun todo-test-show (num &optional archive) | 65 | (defun todo-test--show (num &optional archive) |
| 58 | ;; "Display category NUM of test todo file. | 66 | "Display category NUM of test todo file. |
| 59 | ;; With non-nil ARCHIVE argument, display test archive file category." | 67 | With non-nil ARCHIVE argument, display test archive file category." |
| 60 | ;; (let* ((file (if archive todo-test-archive-1 todo-test-file-1)) | 68 | (let* ((file (if archive todo-test-archive-1 todo-test-file-1)) |
| 61 | ;; (buf (find-file-noselect file))) | 69 | (buf (find-file-noselect file))) |
| 62 | ;; (set-buffer buf) | 70 | (set-buffer buf) |
| 63 | ;; (if archive (todo-archive-mode) (todo-mode)) | 71 | (if archive (todo-archive-mode) (todo-mode)) |
| 72 | (setq todo-category-number num) | ||
| 73 | (todo-category-select) | ||
| 74 | (goto-char (point-min)))) | ||
| 75 | |||
| 76 | ;; (defun todo-test-get-archive (num) | ||
| 77 | ;; "Display category NUM of todo archive test file." | ||
| 78 | ;; (let ((archive-buf (find-file-noselect todo-test-archive-1))) | ||
| 79 | ;; (set-buffer archive-buf) | ||
| 80 | ;; (todo-archive-mode) | ||
| 64 | ;; (setq todo-category-number num) | 81 | ;; (setq todo-category-number num) |
| 65 | ;; (todo-category-select))) | 82 | ;; (todo-category-select))) |
| 66 | 83 | ||
| 67 | (defun todo-test-get-archive (num) | 84 | (defun todo-test--is-current-buffer (filename) |
| 68 | "Display category NUM of todo archive test file." | ||
| 69 | (let ((archive-buf (find-file-noselect todo-test-archive-1))) | ||
| 70 | (set-buffer archive-buf) | ||
| 71 | (todo-archive-mode) | ||
| 72 | (setq todo-category-number num) | ||
| 73 | (todo-category-select))) | ||
| 74 | |||
| 75 | (defun todo-test-is-current-buffer (filename) | ||
| 76 | "Return non-nil if FILENAME's buffer is current." | 85 | "Return non-nil if FILENAME's buffer is current." |
| 77 | (let ((bufname (buffer-file-name (current-buffer)))) | 86 | (let ((bufname (buffer-file-name (current-buffer)))) |
| 78 | (and bufname (equal (file-truename bufname) filename)))) | 87 | (and bufname (equal (file-truename bufname) filename)))) |
| @@ -85,24 +94,24 @@ the current todo-mode category. Quitting todo-mode without an | |||
| 85 | intermediate buffer switch should not make the archive buffer | 94 | intermediate buffer switch should not make the archive buffer |
| 86 | current again." | 95 | current again." |
| 87 | (with-todo-test | 96 | (with-todo-test |
| 88 | (todo-test-get-archive 2) | 97 | (todo-test--show 2 'archive) |
| 89 | (let ((cat-name (todo-current-category))) | 98 | (let ((cat-name (todo-current-category))) |
| 90 | (todo-quit) | 99 | (todo-quit) |
| 91 | (should (todo-test-is-current-buffer todo-test-file-1)) | 100 | (should (todo-test--is-current-buffer todo-test-file-1)) |
| 92 | (should (equal (todo-current-category) cat-name)) | 101 | (should (equal (todo-current-category) cat-name)) |
| 93 | (todo-test-get-archive 1) | 102 | (todo-test--show 1 'archive) |
| 94 | (setq cat-name (todo-current-category)) | 103 | (setq cat-name (todo-current-category)) |
| 95 | (todo-quit) | 104 | (todo-quit) |
| 96 | (should (todo-test-is-current-buffer todo-test-file-1)) | 105 | (should (todo-test--is-current-buffer todo-test-file-1)) |
| 97 | (should (equal todo-category-number 1)) | 106 | (should (equal todo-category-number 1)) |
| 98 | (todo-forward-category) ; Category 2 in todo file now current. | 107 | (todo-forward-category) ; Category 2 in todo file now current. |
| 99 | (todo-test-get-archive 3) ; No corresponding category in todo file. | 108 | (todo-test--show 3 'archive) ; No corresponding category in todo file. |
| 100 | (setq cat-name (todo-current-category)) | 109 | (setq cat-name (todo-current-category)) |
| 101 | (todo-quit) | 110 | (todo-quit) |
| 102 | (should (todo-test-is-current-buffer todo-test-file-1)) | 111 | (should (todo-test--is-current-buffer todo-test-file-1)) |
| 103 | (should (equal todo-category-number 2)) | 112 | (should (equal todo-category-number 2)) |
| 104 | (todo-quit) | 113 | (todo-quit) |
| 105 | (should-not (todo-test-is-current-buffer todo-test-archive-1))))) | 114 | (should-not (todo-test--is-current-buffer todo-test-archive-1))))) |
| 106 | 115 | ||
| 107 | (ert-deftest todo-test-todo-quit02 () ; bug#27121 | 116 | (ert-deftest todo-test-todo-quit02 () ; bug#27121 |
| 108 | "Test the behavior of todo-quit with todo and non-todo buffers. | 117 | "Test the behavior of todo-quit with todo and non-todo buffers. |
| @@ -111,20 +120,19 @@ buffer is buried by quit-window, the todo-mode buffer should not | |||
| 111 | become current." | 120 | become current." |
| 112 | (with-todo-test | 121 | (with-todo-test |
| 113 | (todo-show) | 122 | (todo-show) |
| 114 | (should (todo-test-is-current-buffer todo-test-file-1)) | 123 | (should (todo-test--is-current-buffer todo-test-file-1)) |
| 115 | (let ((dir (dired default-directory))) | 124 | (let ((dir (dired default-directory))) |
| 116 | (todo-show) | 125 | (todo-show) |
| 117 | (todo-quit) | 126 | (todo-quit) |
| 118 | (should (equal (current-buffer) dir)) | 127 | (should (equal (current-buffer) dir)) |
| 119 | (quit-window) | 128 | (quit-window) |
| 120 | (should-not (todo-test-is-current-buffer todo-test-file-1))))) | 129 | (should-not (todo-test--is-current-buffer todo-test-file-1))))) |
| 121 | 130 | ||
| 122 | (ert-deftest todo-test-item-highlighting () ; bug#27133 | 131 | (ert-deftest todo-test-item-highlighting () ; bug#27133 |
| 123 | "Test whether `todo-toggle-item-highlighting' highlights whole item. | 132 | "Test whether `todo-toggle-item-highlighting' highlights whole item. |
| 124 | In particular, all lines of a multiline item should be highlighted." | 133 | In particular, all lines of a multiline item should be highlighted." |
| 125 | (with-todo-test | 134 | (with-todo-test |
| 126 | (todo-show) | 135 | (todo-test--show 1) |
| 127 | (todo-jump-to-category nil "testcat1") ; For test rerun. | ||
| 128 | (todo-toggle-item-highlighting) | 136 | (todo-toggle-item-highlighting) |
| 129 | (let ((end (1- (todo-item-end))) | 137 | (let ((end (1- (todo-item-end))) |
| 130 | (beg (todo-item-start))) | 138 | (beg (todo-item-start))) |
| @@ -134,5 +142,413 @@ In particular, all lines of a multiline item should be highlighted." | |||
| 134 | (should (eq (next-single-char-property-change beg 'face) (1+ end)))) | 142 | (should (eq (next-single-char-property-change beg 'face) (1+ end)))) |
| 135 | (todo-toggle-item-highlighting))) ; Turn off highlighting (for test rerun). | 143 | (todo-toggle-item-highlighting))) ; Turn off highlighting (for test rerun). |
| 136 | 144 | ||
| 145 | (ert-deftest todo-test-revert-buffer01 () ; bug#27609 | ||
| 146 | "Test whether todo-mode buffer remains read-only after reverting." | ||
| 147 | (with-todo-test | ||
| 148 | (todo-show) | ||
| 149 | (let ((opoint (point))) | ||
| 150 | (should (equal buffer-read-only t)) | ||
| 151 | (todo-revert-buffer nil t) | ||
| 152 | (should (equal buffer-read-only t)) | ||
| 153 | (should (eq (point) opoint))))) | ||
| 154 | |||
| 155 | (ert-deftest todo-test-revert-buffer02 () ; bug#27609 | ||
| 156 | "Test whether todo-archive-mode buffer remains read-only after reverting." | ||
| 157 | (with-todo-test | ||
| 158 | (todo-test--show 1 'archive) | ||
| 159 | (let ((opoint (point))) | ||
| 160 | (should (equal buffer-read-only t)) | ||
| 161 | (todo-revert-buffer nil t) | ||
| 162 | (should (equal buffer-read-only t)) | ||
| 163 | (should (eq (point) opoint))))) | ||
| 164 | |||
| 165 | (ert-deftest todo-test-raise-lower-priority () | ||
| 166 | "Test the behavior of todo-{raise,lower}-item-priority." | ||
| 167 | (with-todo-test | ||
| 168 | ;; (todo-show) | ||
| 169 | (todo-test--show 1) | ||
| 170 | (goto-char (point-min)) | ||
| 171 | (let ((p1 (point)) | ||
| 172 | (s1 (todo-item-string)) | ||
| 173 | p2 s2 p3) | ||
| 174 | ;; First item in category. | ||
| 175 | (should (equal p1 (todo-item-start))) | ||
| 176 | (todo-next-item) | ||
| 177 | (setq p2 (point)) | ||
| 178 | ;; Second item in category. | ||
| 179 | (setq s2 (todo-item-string)) | ||
| 180 | ;; Second item is lower. | ||
| 181 | (should (> p2 p1)) | ||
| 182 | ;; Case 1: lowering priority. | ||
| 183 | (todo-previous-item) | ||
| 184 | (todo-lower-item-priority) | ||
| 185 | ;; Now what was the first item is the second and vice versa. | ||
| 186 | (setq p1 (point)) | ||
| 187 | (should (equal s1 (todo-item-string))) | ||
| 188 | (todo-previous-item) | ||
| 189 | (setq p2 (point)) | ||
| 190 | (should (equal s2 (todo-item-string))) | ||
| 191 | (should (> p1 p2)) | ||
| 192 | ;; Case 2: raising priority. | ||
| 193 | (todo-next-item) | ||
| 194 | (todo-raise-item-priority) | ||
| 195 | ;; Now what had become the second item is again the first and | ||
| 196 | ;; vice versa. | ||
| 197 | (setq p1 (point)) | ||
| 198 | (should (equal s1 (todo-item-string))) | ||
| 199 | (todo-next-item) | ||
| 200 | (setq p2 (point)) | ||
| 201 | (should (equal s2 (todo-item-string))) | ||
| 202 | (should (> p2 p1)) | ||
| 203 | ;; Case 3: empty line (bug#27609). | ||
| 204 | (goto-char (point-max)) | ||
| 205 | ;; The last line in the category is always empty. | ||
| 206 | (should-not (todo-item-string)) | ||
| 207 | (todo-raise-item-priority) | ||
| 208 | ;; Raising item priority on the empty string is a noop. | ||
| 209 | (should (equal (point) (point-max))) | ||
| 210 | (todo-lower-item-priority) | ||
| 211 | ;; Lowering item priority on the empty string is a noop. | ||
| 212 | (should (equal (point) (point-max))) | ||
| 213 | ;; Case 4: done item (bug#27609). | ||
| 214 | ;; todo-toggle-view-done-items recenters the window if point is | ||
| 215 | ;; not visible, so we have to make sure the todo-mode buffer is | ||
| 216 | ;; in a live window in the test run to avoid failing with (error | ||
| 217 | ;; "`recenter'ing a window that does not display ;; current-buffer."). | ||
| 218 | ;; (But this is not necessary in todo-test-toggle-item-header01 | ||
| 219 | ;; below -- why not, or why is it here? Note that without | ||
| 220 | ;; setting window buffer, the test only fails on the first run -- | ||
| 221 | ;; on rerunning it passes.) | ||
| 222 | (set-window-buffer nil (current-buffer)) | ||
| 223 | (todo-toggle-view-done-items) | ||
| 224 | (todo-next-item) | ||
| 225 | ;; Now the current item is the first done item. | ||
| 226 | (should (todo-done-item-p)) | ||
| 227 | (setq p3 (point)) | ||
| 228 | (todo-raise-item-priority) | ||
| 229 | ;; Raising item priority on a done item is a noop. | ||
| 230 | (should (eq (point) p3)) | ||
| 231 | (todo-lower-item-priority) | ||
| 232 | ;; Lowering item priority on a done item is a noop. | ||
| 233 | (should (eq (point) p3))))) | ||
| 234 | |||
| 235 | (ert-deftest todo-test-todo-mark-unmark-category () ; bug#27609 | ||
| 236 | "Test behavior of todo-mark-category and todo-unmark-category." | ||
| 237 | (with-todo-test | ||
| 238 | (todo-show) | ||
| 239 | (let ((cat (todo-current-category))) | ||
| 240 | (todo-mark-category) | ||
| 241 | (should (equal (todo-get-count 'todo cat) | ||
| 242 | (cdr (assoc cat todo-categories-with-marks)))) | ||
| 243 | (todo-unmark-category) | ||
| 244 | (should-not (assoc cat todo-categories-with-marks))))) | ||
| 245 | |||
| 246 | (defun todo-test--move-item (cat &optional priority file) | ||
| 247 | "Move item(s) to category CAT with priority PRIORITY (for todo item). | ||
| 248 | This provides a noninteractive API for todo-move-item for use in | ||
| 249 | automatic testing." | ||
| 250 | (let ((cat0 (car (nth (1- cat) todo-categories))) | ||
| 251 | (file0 (or file todo-current-todo-file))) | ||
| 252 | (cl-letf (((symbol-function 'todo-read-category) | ||
| 253 | (lambda (_prompt &optional _match-type _file) (cons cat0 file0))) | ||
| 254 | ((symbol-function 'read-number) ; For todo-set-item-priority | ||
| 255 | (lambda (_prompt &optional _default) (or priority 1)))) | ||
| 256 | (todo-move-item)))) | ||
| 257 | |||
| 258 | (ert-deftest todo-test-move-item01 () | ||
| 259 | "Test moving a todo item to another category with a given priority." | ||
| 260 | (with-todo-test | ||
| 261 | (todo-test--show 1) | ||
| 262 | (let* ((cat1 (todo-current-category)) | ||
| 263 | (cat2 (car (nth 1 todo-categories))) | ||
| 264 | (cat1-todo (todo-get-count 'todo cat1)) | ||
| 265 | (cat2-todo (todo-get-count 'todo cat2)) | ||
| 266 | (item (todo-item-string))) | ||
| 267 | (todo-test--move-item 2 3) | ||
| 268 | (should (equal (todo-current-category) cat2)) | ||
| 269 | (should (equal (todo-item-string) item)) | ||
| 270 | (should (equal (overlay-get (todo-get-overlay 'prefix) 'before-string) | ||
| 271 | "3 ")) | ||
| 272 | (todo-backward-category) ; Go to first category again. | ||
| 273 | (should-error (search-forward item)) | ||
| 274 | (should (= (todo-get-count 'todo cat1) (1- cat1-todo))) | ||
| 275 | (should (= (todo-get-count 'todo cat2) (1+ cat2-todo)))))) | ||
| 276 | |||
| 277 | (ert-deftest todo-test-move-item02 () ; bug#27609 | ||
| 278 | "Test moving a marked todo item to previous category." | ||
| 279 | (with-todo-test | ||
| 280 | (todo-test--show 2) | ||
| 281 | (let* ((cat2 (todo-current-category)) | ||
| 282 | (cat1 (car (nth 0 todo-categories))) | ||
| 283 | (cat2-todo (todo-get-count 'todo cat2)) | ||
| 284 | (cat1-todo (todo-get-count 'todo cat1)) | ||
| 285 | (item (todo-item-string))) | ||
| 286 | ;; If todo-toggle-mark-item is not called interactively, its | ||
| 287 | ;; optional prefix argument evaluates to nil and this raises a | ||
| 288 | ;; wrong-type-argument error. | ||
| 289 | (call-interactively 'todo-toggle-mark-item) | ||
| 290 | (todo-test--move-item 1) | ||
| 291 | (should (equal (todo-current-category) cat1)) | ||
| 292 | (should (equal (todo-item-string) item)) | ||
| 293 | (should (equal (overlay-get (todo-get-overlay 'prefix) 'before-string) | ||
| 294 | "1 ")) | ||
| 295 | (todo-forward-category) ; Go to second category again. | ||
| 296 | (should-error (search-forward item)) | ||
| 297 | (should (= (todo-get-count 'todo cat1) (1+ cat1-todo))) | ||
| 298 | (should (= (todo-get-count 'todo cat2) (1- cat2-todo)))))) | ||
| 299 | |||
| 300 | (ert-deftest todo-test-move-item03 () ; bug#27609 | ||
| 301 | "Test moving a done item to another category. | ||
| 302 | In the new category it should be the first done item." | ||
| 303 | (with-todo-test | ||
| 304 | (todo-test--show 1) | ||
| 305 | (let* ((cat1 (todo-current-category)) | ||
| 306 | (cat2 (car (nth 1 todo-categories))) | ||
| 307 | (cat1-done (todo-get-count 'done cat1)) | ||
| 308 | (cat2-done (todo-get-count 'done cat2))) | ||
| 309 | (goto-char (point-max)) | ||
| 310 | (set-window-buffer nil (current-buffer)) ; Why is this necessary? | ||
| 311 | (todo-toggle-view-done-items) | ||
| 312 | (todo-next-item) | ||
| 313 | (let ((item (todo-item-string))) | ||
| 314 | (todo-test--move-item 2) | ||
| 315 | (should (equal (todo-current-category) cat2)) | ||
| 316 | (should (equal (todo-item-string) item)) | ||
| 317 | (should (todo-done-item-p)) | ||
| 318 | (forward-line -1) | ||
| 319 | (should (looking-at todo-category-done)) | ||
| 320 | (todo-backward-category) | ||
| 321 | (should-error (search-forward item)) | ||
| 322 | (should (= (todo-get-count 'done cat1) (1- cat1-done))) | ||
| 323 | (should (= (todo-get-count 'done cat2) (1+ cat2-done))))))) | ||
| 324 | |||
| 325 | (ert-deftest todo-test-move-item04 () ; bug#27609 | ||
| 326 | "Test moving both a todo and a done item to another category. | ||
| 327 | In the new category the todo item should have the provided | ||
| 328 | priority and the done item should be the first done item." | ||
| 329 | (with-todo-test | ||
| 330 | (todo-test--show 1) | ||
| 331 | (let* ((cat1 (todo-current-category)) | ||
| 332 | (cat2 (car (nth 1 todo-categories))) | ||
| 333 | (cat1-todo (todo-get-count 'todo cat1)) | ||
| 334 | (cat2-todo (todo-get-count 'todo cat2)) | ||
| 335 | (cat1-done (todo-get-count 'done cat1)) | ||
| 336 | (cat2-done (todo-get-count 'done cat2)) | ||
| 337 | (todo-item (todo-item-string))) | ||
| 338 | (call-interactively 'todo-toggle-mark-item) | ||
| 339 | (goto-char (point-max)) | ||
| 340 | ;; Why is this necessary here but not below? | ||
| 341 | (set-window-buffer nil (current-buffer)) | ||
| 342 | (todo-toggle-view-done-items) | ||
| 343 | (todo-next-item) | ||
| 344 | (let ((done-item (todo-item-string))) | ||
| 345 | (call-interactively 'todo-toggle-mark-item) | ||
| 346 | (todo-test--move-item 2 3) | ||
| 347 | (should (equal (todo-current-category) cat2)) | ||
| 348 | ;; Point should be on the moved todo item. | ||
| 349 | (should (equal (todo-item-string) todo-item)) | ||
| 350 | ;; Done items section should be visible and the move done item | ||
| 351 | ;; should be at the top of it. | ||
| 352 | (should (search-forward done-item)) | ||
| 353 | (should (todo-done-item-p)) | ||
| 354 | (forward-line -1) | ||
| 355 | (should (looking-at todo-category-done)) | ||
| 356 | ;; Make sure marked items are no longer in first category. | ||
| 357 | (todo-backward-category) | ||
| 358 | (should-error (search-forward todo-item)) | ||
| 359 | (todo-toggle-view-done-items) | ||
| 360 | (should-error (search-forward done-item)) | ||
| 361 | (should (= (todo-get-count 'todo cat1) (1- cat1-todo))) | ||
| 362 | (should (= (todo-get-count 'todo cat2) (1+ cat2-todo))) | ||
| 363 | (should (= (todo-get-count 'done cat1) (1- cat1-done))) | ||
| 364 | (should (= (todo-get-count 'done cat2) (1+ cat2-done))))))) | ||
| 365 | |||
| 366 | (ert-deftest todo-test-move-item05 () ; bug#27609 | ||
| 367 | "Test moving multiple todo and done items to another category. | ||
| 368 | Both types of item should be moved en bloc to the new category, | ||
| 369 | and the the top todo item should have the provided priority and | ||
| 370 | the top done item should be the first done item." | ||
| 371 | (with-todo-test | ||
| 372 | (todo-test--show 1) | ||
| 373 | (let* ((cat1 (todo-current-category)) | ||
| 374 | (cat2 (car (nth 1 todo-categories))) | ||
| 375 | (cat1-todo (todo-get-count 'todo cat1)) | ||
| 376 | (cat2-todo (todo-get-count 'todo cat2)) | ||
| 377 | (cat1-done (todo-get-count 'done cat1)) | ||
| 378 | (cat2-done (todo-get-count 'done cat2)) | ||
| 379 | (todo-items (buffer-string)) | ||
| 380 | (done-items (prog2 (todo-toggle-view-done-only) | ||
| 381 | (buffer-string) | ||
| 382 | (todo-toggle-view-done-only)))) | ||
| 383 | ;; Why is this necessary here but not below? | ||
| 384 | (set-window-buffer nil (current-buffer)) | ||
| 385 | (todo-toggle-view-done-items) | ||
| 386 | (todo-mark-category) | ||
| 387 | (todo-test--move-item 2 3) | ||
| 388 | (should (equal (todo-current-category) cat2)) | ||
| 389 | ;; Point should be at the start of the first moved todo item. | ||
| 390 | (should (looking-at (regexp-quote todo-items))) | ||
| 391 | ;; Done items section should be visible and the move done item | ||
| 392 | ;; should be at the top of it. | ||
| 393 | (should (search-forward done-items)) | ||
| 394 | (goto-char (match-beginning 0)) | ||
| 395 | (should (todo-done-item-p)) | ||
| 396 | (forward-line -1) | ||
| 397 | (should (looking-at todo-category-done)) | ||
| 398 | ;; Make sure marked items are no longer in first category. | ||
| 399 | (todo-backward-category) | ||
| 400 | (should (eq (point-min) (point-max))) ; All todo items were moved. | ||
| 401 | ;; This passes when run interactively but fails in a batch run: | ||
| 402 | ;; the message is displayed but (current-message) evaluates to | ||
| 403 | ;; nil. | ||
| 404 | ;; (todo-toggle-view-done-items) ; All done items were moved. | ||
| 405 | ;; (let ((msg (current-message))) | ||
| 406 | ;; (should (equal msg "There are no done items in this category."))) | ||
| 407 | (todo-toggle-view-done-only) | ||
| 408 | (should (eq (point-min) (point-max))) ; All done items were moved. | ||
| 409 | (should (= (todo-get-count 'todo cat1) 0)) | ||
| 410 | (should (= (todo-get-count 'todo cat2) (+ cat1-todo cat2-todo))) | ||
| 411 | (should (= (todo-get-count 'done cat1) 0)) | ||
| 412 | (should (= (todo-get-count 'done cat2) (+ cat1-done cat2-done)))))) | ||
| 413 | |||
| 414 | (ert-deftest todo-test-toggle-item-header01 () ; bug#27609 | ||
| 415 | "Test toggling item header from an empty category." | ||
| 416 | (with-todo-test | ||
| 417 | (todo-test--show 3) | ||
| 418 | (should (eq (point-min) (point-max))) ; Category is empty. | ||
| 419 | (todo-toggle-item-header) | ||
| 420 | (todo-backward-category) | ||
| 421 | ;; Header is hidden. | ||
| 422 | (should (equal (overlay-get (todo-get-overlay 'header) 'display) "")) | ||
| 423 | (todo-forward-category) | ||
| 424 | (todo-toggle-item-header) | ||
| 425 | (todo-backward-category) | ||
| 426 | ;; Header is shown. | ||
| 427 | (should-not (todo-get-overlay 'header)))) | ||
| 428 | |||
| 429 | (ert-deftest todo-test-toggle-item-header02 () ; bug#27609 | ||
| 430 | "Test navigating between items with hidden header." | ||
| 431 | :expected-result :failed ; FIXME | ||
| 432 | (with-todo-test | ||
| 433 | (todo-test--show 2) | ||
| 434 | (let* ((start0 (point)) | ||
| 435 | (find-start (lambda () | ||
| 436 | (re-search-forward | ||
| 437 | (concat todo-date-string-start | ||
| 438 | todo-date-pattern | ||
| 439 | "\\( " diary-time-regexp "\\)?" | ||
| 440 | (regexp-quote todo-nondiary-end) "?") | ||
| 441 | (line-end-position) t) | ||
| 442 | (forward-char) | ||
| 443 | (point))) | ||
| 444 | (start1 (save-excursion (funcall find-start))) | ||
| 445 | (start2 (save-excursion (todo-next-item) (funcall find-start)))) | ||
| 446 | (should (looking-at todo-item-start)) | ||
| 447 | (todo-toggle-item-header) | ||
| 448 | ;; Point hasn't changed... | ||
| 449 | (should (eq (point) start0)) | ||
| 450 | (should (looking-at todo-item-start)) | ||
| 451 | ;; FIXME: In the test run this puts point at todo-item-start, | ||
| 452 | ;; i.e. the display overlay doesn't affect this movement, unlike | ||
| 453 | ;; with the command in todo-mode (and using call-interactively | ||
| 454 | ;; here doesn't change this). | ||
| 455 | (todo-next-item) | ||
| 456 | (should (eq (point) start2)) | ||
| 457 | (should-not (looking-at todo-item-start)) | ||
| 458 | (todo-previous-item) | ||
| 459 | ;; ...but now it has. | ||
| 460 | (should (eq (point) start1)) | ||
| 461 | (should-not (looking-at todo-item-start)) | ||
| 462 | ;; This is the status quo but is it desirable? | ||
| 463 | (todo-toggle-item-header) | ||
| 464 | (should (eq (point) start1)) | ||
| 465 | (should-not (looking-at todo-item-start))))) | ||
| 466 | |||
| 467 | (ert-deftest todo-test-toggle-item-header03 () ; bug#27609 | ||
| 468 | "Test display of hidden item header when changing item's priority." | ||
| 469 | (with-todo-test | ||
| 470 | (todo-test--show 2) | ||
| 471 | (todo-toggle-item-header) | ||
| 472 | (should (equal (overlay-get (todo-get-overlay 'header) 'display) "")) | ||
| 473 | (todo-lower-item-priority) | ||
| 474 | (should (equal (overlay-get (todo-get-overlay 'header) 'display) "")) | ||
| 475 | (todo-raise-item-priority) | ||
| 476 | (should (equal (overlay-get (todo-get-overlay 'header) 'display) "")) | ||
| 477 | ;; Set priority noninteractively. | ||
| 478 | (cl-letf (((symbol-function 'read-number) | ||
| 479 | (lambda (_prompt &optional _default) 3))) | ||
| 480 | (todo-item-undone)) | ||
| 481 | (should (equal (overlay-get (todo-get-overlay 'header) 'display) "")))) | ||
| 482 | |||
| 483 | (ert-deftest todo-test-toggle-item-header04 () ; bug#27609 | ||
| 484 | "Test display of hidden item header under todo-item-(un)done." | ||
| 485 | (with-todo-test | ||
| 486 | (todo-test--show 1) | ||
| 487 | (let ((item (todo-item-string))) | ||
| 488 | (todo-toggle-item-header) | ||
| 489 | (should (equal (overlay-get (todo-get-overlay 'header) 'display) "")) | ||
| 490 | (todo-item-done) | ||
| 491 | ;; Without set-window-buffer here this test passes when run | ||
| 492 | ;; interactively but fails in a batch run. | ||
| 493 | (set-window-buffer nil (current-buffer)) | ||
| 494 | (todo-toggle-view-done-items) | ||
| 495 | (should (search-forward item)) | ||
| 496 | (todo-item-start) | ||
| 497 | (should (equal (overlay-get (todo-get-overlay 'header) 'display) "")) | ||
| 498 | ;; Set priority for todo-item-undone noninteractively. | ||
| 499 | (cl-letf (((symbol-function 'read-number) | ||
| 500 | (lambda (_prompt &optional _default) 1))) | ||
| 501 | (todo-item-undone)) | ||
| 502 | (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))))) | ||
| 503 | |||
| 504 | (ert-deftest todo-test-toggle-item-header05 () ; bug#27609 | ||
| 505 | "Test display of hidden item header under todo-move-item." | ||
| 506 | (with-todo-test | ||
| 507 | (todo-test--show 1) | ||
| 508 | (todo-toggle-item-header) | ||
| 509 | (todo-test--move-item 2 3) | ||
| 510 | (should (equal (overlay-get (todo-get-overlay 'header) 'display) "")))) | ||
| 511 | |||
| 512 | (ert-deftest todo-test-toggle-item-header06 () ; bug#27609 | ||
| 513 | "Test display of hidden item header under (un)archiving. | ||
| 514 | The relocated item's header should take on the display status of | ||
| 515 | headers in the goal file, even when the display status in the | ||
| 516 | source file is different." | ||
| 517 | (with-todo-test | ||
| 518 | (todo-test--show 1) | ||
| 519 | (todo-toggle-item-header) | ||
| 520 | (todo-toggle-view-done-only) ; Go to first (i.e. top) done item. | ||
| 521 | (let ((item (todo-item-string))) | ||
| 522 | (todo-archive-done-item) | ||
| 523 | (todo-toggle-view-done-only) ; To display all items on unarchiving. | ||
| 524 | (todo-find-archive) | ||
| 525 | (should (equal (todo-item-string) item)) ; The just archived item. | ||
| 526 | ;; The archive file headers are displayed by default. | ||
| 527 | (should-not (todo-get-overlay 'header)) | ||
| 528 | (todo-unarchive-items) | ||
| 529 | ;; Headers in the todo file are still hidden. | ||
| 530 | (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))))) | ||
| 531 | |||
| 532 | (defun todo-test--insert-item (item &optional priority) | ||
| 533 | "Insert string ITEM into current category with priority PRIORITY. | ||
| 534 | Use defaults for all other item insertion parameters. This | ||
| 535 | provides a noninteractive API for todo-insert-item for use in | ||
| 536 | automatic testing." | ||
| 537 | (cl-letf (((symbol-function 'read-from-minibuffer) | ||
| 538 | (lambda (_prompt) item)) | ||
| 539 | ((symbol-function 'read-number) ; For todo-set-item-priority | ||
| 540 | (lambda (_prompt &optional _default) (or priority 1)))) | ||
| 541 | (todo-insert-item--basic))) | ||
| 542 | |||
| 543 | (ert-deftest todo-test-toggle-item-header07 () ; bug#27609 | ||
| 544 | "Test display of hidden item header under todo-insert-item." | ||
| 545 | (with-todo-test | ||
| 546 | (todo-test--show 1) | ||
| 547 | (todo-toggle-item-header) | ||
| 548 | (let ((item "Test display of hidden item header under todo-insert-item.")) | ||
| 549 | (todo-test--insert-item item 1) | ||
| 550 | (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))))) | ||
| 551 | |||
| 552 | |||
| 137 | (provide 'todo-mode-tests) | 553 | (provide 'todo-mode-tests) |
| 138 | ;;; todo-mode-tests.el ends here | 554 | ;;; todo-mode-tests.el ends here |