aboutsummaryrefslogtreecommitdiffstats
path: root/test
diff options
context:
space:
mode:
authorStephen Berman2017-07-07 22:03:21 +0200
committerStephen Berman2017-07-07 22:03:21 +0200
commitc24748ada08ffdb2921826f2b954a230e25d1d60 (patch)
treeb6cd6c2f16ce78e8c5e664dfe10cfc8787d2453e /test
parent264dd81d7bf14d39737677af11e1cd3d618ad887 (diff)
downloademacs-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.toda6
-rw-r--r--test/lisp/calendar/todo-mode-resources/todo-test-1.todo14
-rw-r--r--test/lisp/calendar/todo-mode-tests.el470
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." 67With 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
85intermediate buffer switch should not make the archive buffer 94intermediate buffer switch should not make the archive buffer
86current again." 95current 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
111become current." 120become 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.
124In particular, all lines of a multiline item should be highlighted." 133In 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).
248This provides a noninteractive API for todo-move-item for use in
249automatic 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.
302In 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.
327In the new category the todo item should have the provided
328priority 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.
368Both types of item should be moved en bloc to the new category,
369and the the top todo item should have the provided priority and
370the 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.
514The relocated item's header should take on the display status of
515headers in the goal file, even when the display status in the
516source 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.
534Use defaults for all other item insertion parameters. This
535provides a noninteractive API for todo-insert-item for use in
536automatic 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