(defmacro with-todo-test (&rest body)
"Set up an isolated todo-mode test environment."
+ (declare (debug (body)))
`(let* ((todo-test-home (make-temp-file "todo-test-home-" t))
(process-environment (cons (format "HOME=%s" todo-test-home)
process-environment))
(car (funcall todo-files-function)))))
(unwind-protect
(progn ,@body)
+ ;; Restore pre-test-run state of test files.
+ (dolist (f (directory-files todo-directory))
+ (let ((buf (get-file-buffer f)))
+ (when buf
+ (with-current-buffer buf
+ (restore-buffer-modified-p nil)
+ (kill-buffer)))))
(delete-directory todo-test-home t))))
-;; (defun todo-test-show (num &optional archive)
-;; "Display category NUM of test todo file.
-;; With non-nil ARCHIVE argument, display test archive file category."
-;; (let* ((file (if archive todo-test-archive-1 todo-test-file-1))
-;; (buf (find-file-noselect file)))
-;; (set-buffer buf)
-;; (if archive (todo-archive-mode) (todo-mode))
+(defun todo-test--show (num &optional archive)
+ "Display category NUM of test todo file.
+With non-nil ARCHIVE argument, display test archive file category."
+ (let* ((file (if archive todo-test-archive-1 todo-test-file-1))
+ (buf (find-file-noselect file)))
+ (set-buffer buf)
+ (if archive (todo-archive-mode) (todo-mode))
+ (setq todo-category-number num)
+ (todo-category-select)
+ (goto-char (point-min))))
+
+;; (defun todo-test-get-archive (num)
+;; "Display category NUM of todo archive test file."
+;; (let ((archive-buf (find-file-noselect todo-test-archive-1)))
+;; (set-buffer archive-buf)
+;; (todo-archive-mode)
;; (setq todo-category-number num)
;; (todo-category-select)))
-(defun todo-test-get-archive (num)
- "Display category NUM of todo archive test file."
- (let ((archive-buf (find-file-noselect todo-test-archive-1)))
- (set-buffer archive-buf)
- (todo-archive-mode)
- (setq todo-category-number num)
- (todo-category-select)))
-
-(defun todo-test-is-current-buffer (filename)
+(defun todo-test--is-current-buffer (filename)
"Return non-nil if FILENAME's buffer is current."
(let ((bufname (buffer-file-name (current-buffer))))
(and bufname (equal (file-truename bufname) filename))))
intermediate buffer switch should not make the archive buffer
current again."
(with-todo-test
- (todo-test-get-archive 2)
+ (todo-test--show 2 'archive)
(let ((cat-name (todo-current-category)))
(todo-quit)
- (should (todo-test-is-current-buffer todo-test-file-1))
+ (should (todo-test--is-current-buffer todo-test-file-1))
(should (equal (todo-current-category) cat-name))
- (todo-test-get-archive 1)
+ (todo-test--show 1 'archive)
(setq cat-name (todo-current-category))
(todo-quit)
- (should (todo-test-is-current-buffer todo-test-file-1))
+ (should (todo-test--is-current-buffer todo-test-file-1))
(should (equal todo-category-number 1))
(todo-forward-category) ; Category 2 in todo file now current.
- (todo-test-get-archive 3) ; No corresponding category in todo file.
+ (todo-test--show 3 'archive) ; No corresponding category in todo file.
(setq cat-name (todo-current-category))
(todo-quit)
- (should (todo-test-is-current-buffer todo-test-file-1))
+ (should (todo-test--is-current-buffer todo-test-file-1))
(should (equal todo-category-number 2))
(todo-quit)
- (should-not (todo-test-is-current-buffer todo-test-archive-1)))))
+ (should-not (todo-test--is-current-buffer todo-test-archive-1)))))
(ert-deftest todo-test-todo-quit02 () ; bug#27121
"Test the behavior of todo-quit with todo and non-todo buffers.
become current."
(with-todo-test
(todo-show)
- (should (todo-test-is-current-buffer todo-test-file-1))
+ (should (todo-test--is-current-buffer todo-test-file-1))
(let ((dir (dired default-directory)))
(todo-show)
(todo-quit)
(should (equal (current-buffer) dir))
(quit-window)
- (should-not (todo-test-is-current-buffer todo-test-file-1)))))
+ (should-not (todo-test--is-current-buffer todo-test-file-1)))))
(ert-deftest todo-test-item-highlighting () ; bug#27133
"Test whether `todo-toggle-item-highlighting' highlights whole item.
In particular, all lines of a multiline item should be highlighted."
(with-todo-test
- (todo-show)
- (todo-jump-to-category nil "testcat1") ; For test rerun.
+ (todo-test--show 1)
(todo-toggle-item-highlighting)
(let ((end (1- (todo-item-end)))
(beg (todo-item-start)))
(should (eq (next-single-char-property-change beg 'face) (1+ end))))
(todo-toggle-item-highlighting))) ; Turn off highlighting (for test rerun).
+(ert-deftest todo-test-revert-buffer01 () ; bug#27609
+ "Test whether todo-mode buffer remains read-only after reverting."
+ (with-todo-test
+ (todo-show)
+ (let ((opoint (point)))
+ (should (equal buffer-read-only t))
+ (todo-revert-buffer nil t)
+ (should (equal buffer-read-only t))
+ (should (eq (point) opoint)))))
+
+(ert-deftest todo-test-revert-buffer02 () ; bug#27609
+ "Test whether todo-archive-mode buffer remains read-only after reverting."
+ (with-todo-test
+ (todo-test--show 1 'archive)
+ (let ((opoint (point)))
+ (should (equal buffer-read-only t))
+ (todo-revert-buffer nil t)
+ (should (equal buffer-read-only t))
+ (should (eq (point) opoint)))))
+
+(ert-deftest todo-test-raise-lower-priority ()
+ "Test the behavior of todo-{raise,lower}-item-priority."
+ (with-todo-test
+ ;; (todo-show)
+ (todo-test--show 1)
+ (goto-char (point-min))
+ (let ((p1 (point))
+ (s1 (todo-item-string))
+ p2 s2 p3)
+ ;; First item in category.
+ (should (equal p1 (todo-item-start)))
+ (todo-next-item)
+ (setq p2 (point))
+ ;; Second item in category.
+ (setq s2 (todo-item-string))
+ ;; Second item is lower.
+ (should (> p2 p1))
+ ;; Case 1: lowering priority.
+ (todo-previous-item)
+ (todo-lower-item-priority)
+ ;; Now what was the first item is the second and vice versa.
+ (setq p1 (point))
+ (should (equal s1 (todo-item-string)))
+ (todo-previous-item)
+ (setq p2 (point))
+ (should (equal s2 (todo-item-string)))
+ (should (> p1 p2))
+ ;; Case 2: raising priority.
+ (todo-next-item)
+ (todo-raise-item-priority)
+ ;; Now what had become the second item is again the first and
+ ;; vice versa.
+ (setq p1 (point))
+ (should (equal s1 (todo-item-string)))
+ (todo-next-item)
+ (setq p2 (point))
+ (should (equal s2 (todo-item-string)))
+ (should (> p2 p1))
+ ;; Case 3: empty line (bug#27609).
+ (goto-char (point-max))
+ ;; The last line in the category is always empty.
+ (should-not (todo-item-string))
+ (todo-raise-item-priority)
+ ;; Raising item priority on the empty string is a noop.
+ (should (equal (point) (point-max)))
+ (todo-lower-item-priority)
+ ;; Lowering item priority on the empty string is a noop.
+ (should (equal (point) (point-max)))
+ ;; Case 4: done item (bug#27609).
+ ;; todo-toggle-view-done-items recenters the window if point is
+ ;; not visible, so we have to make sure the todo-mode buffer is
+ ;; in a live window in the test run to avoid failing with (error
+ ;; "`recenter'ing a window that does not display ;; current-buffer.").
+ ;; (But this is not necessary in todo-test-toggle-item-header01
+ ;; below -- why not, or why is it here? Note that without
+ ;; setting window buffer, the test only fails on the first run --
+ ;; on rerunning it passes.)
+ (set-window-buffer nil (current-buffer))
+ (todo-toggle-view-done-items)
+ (todo-next-item)
+ ;; Now the current item is the first done item.
+ (should (todo-done-item-p))
+ (setq p3 (point))
+ (todo-raise-item-priority)
+ ;; Raising item priority on a done item is a noop.
+ (should (eq (point) p3))
+ (todo-lower-item-priority)
+ ;; Lowering item priority on a done item is a noop.
+ (should (eq (point) p3)))))
+
+(ert-deftest todo-test-todo-mark-unmark-category () ; bug#27609
+ "Test behavior of todo-mark-category and todo-unmark-category."
+ (with-todo-test
+ (todo-show)
+ (let ((cat (todo-current-category)))
+ (todo-mark-category)
+ (should (equal (todo-get-count 'todo cat)
+ (cdr (assoc cat todo-categories-with-marks))))
+ (todo-unmark-category)
+ (should-not (assoc cat todo-categories-with-marks)))))
+
+(defun todo-test--move-item (cat &optional priority file)
+ "Move item(s) to category CAT with priority PRIORITY (for todo item).
+This provides a noninteractive API for todo-move-item for use in
+automatic testing."
+ (let ((cat0 (car (nth (1- cat) todo-categories)))
+ (file0 (or file todo-current-todo-file)))
+ (cl-letf (((symbol-function 'todo-read-category)
+ (lambda (_prompt &optional _match-type _file) (cons cat0 file0)))
+ ((symbol-function 'read-number) ; For todo-set-item-priority
+ (lambda (_prompt &optional _default) (or priority 1))))
+ (todo-move-item))))
+
+(ert-deftest todo-test-move-item01 ()
+ "Test moving a todo item to another category with a given priority."
+ (with-todo-test
+ (todo-test--show 1)
+ (let* ((cat1 (todo-current-category))
+ (cat2 (car (nth 1 todo-categories)))
+ (cat1-todo (todo-get-count 'todo cat1))
+ (cat2-todo (todo-get-count 'todo cat2))
+ (item (todo-item-string)))
+ (todo-test--move-item 2 3)
+ (should (equal (todo-current-category) cat2))
+ (should (equal (todo-item-string) item))
+ (should (equal (overlay-get (todo-get-overlay 'prefix) 'before-string)
+ "3 "))
+ (todo-backward-category) ; Go to first category again.
+ (should-error (search-forward item))
+ (should (= (todo-get-count 'todo cat1) (1- cat1-todo)))
+ (should (= (todo-get-count 'todo cat2) (1+ cat2-todo))))))
+
+(ert-deftest todo-test-move-item02 () ; bug#27609
+ "Test moving a marked todo item to previous category."
+ (with-todo-test
+ (todo-test--show 2)
+ (let* ((cat2 (todo-current-category))
+ (cat1 (car (nth 0 todo-categories)))
+ (cat2-todo (todo-get-count 'todo cat2))
+ (cat1-todo (todo-get-count 'todo cat1))
+ (item (todo-item-string)))
+ ;; If todo-toggle-mark-item is not called interactively, its
+ ;; optional prefix argument evaluates to nil and this raises a
+ ;; wrong-type-argument error.
+ (call-interactively 'todo-toggle-mark-item)
+ (todo-test--move-item 1)
+ (should (equal (todo-current-category) cat1))
+ (should (equal (todo-item-string) item))
+ (should (equal (overlay-get (todo-get-overlay 'prefix) 'before-string)
+ "1 "))
+ (todo-forward-category) ; Go to second category again.
+ (should-error (search-forward item))
+ (should (= (todo-get-count 'todo cat1) (1+ cat1-todo)))
+ (should (= (todo-get-count 'todo cat2) (1- cat2-todo))))))
+
+(ert-deftest todo-test-move-item03 () ; bug#27609
+ "Test moving a done item to another category.
+In the new category it should be the first done item."
+ (with-todo-test
+ (todo-test--show 1)
+ (let* ((cat1 (todo-current-category))
+ (cat2 (car (nth 1 todo-categories)))
+ (cat1-done (todo-get-count 'done cat1))
+ (cat2-done (todo-get-count 'done cat2)))
+ (goto-char (point-max))
+ (set-window-buffer nil (current-buffer)) ; Why is this necessary?
+ (todo-toggle-view-done-items)
+ (todo-next-item)
+ (let ((item (todo-item-string)))
+ (todo-test--move-item 2)
+ (should (equal (todo-current-category) cat2))
+ (should (equal (todo-item-string) item))
+ (should (todo-done-item-p))
+ (forward-line -1)
+ (should (looking-at todo-category-done))
+ (todo-backward-category)
+ (should-error (search-forward item))
+ (should (= (todo-get-count 'done cat1) (1- cat1-done)))
+ (should (= (todo-get-count 'done cat2) (1+ cat2-done)))))))
+
+(ert-deftest todo-test-move-item04 () ; bug#27609
+ "Test moving both a todo and a done item to another category.
+In the new category the todo item should have the provided
+priority and the done item should be the first done item."
+ (with-todo-test
+ (todo-test--show 1)
+ (let* ((cat1 (todo-current-category))
+ (cat2 (car (nth 1 todo-categories)))
+ (cat1-todo (todo-get-count 'todo cat1))
+ (cat2-todo (todo-get-count 'todo cat2))
+ (cat1-done (todo-get-count 'done cat1))
+ (cat2-done (todo-get-count 'done cat2))
+ (todo-item (todo-item-string)))
+ (call-interactively 'todo-toggle-mark-item)
+ (goto-char (point-max))
+ ;; Why is this necessary here but not below?
+ (set-window-buffer nil (current-buffer))
+ (todo-toggle-view-done-items)
+ (todo-next-item)
+ (let ((done-item (todo-item-string)))
+ (call-interactively 'todo-toggle-mark-item)
+ (todo-test--move-item 2 3)
+ (should (equal (todo-current-category) cat2))
+ ;; Point should be on the moved todo item.
+ (should (equal (todo-item-string) todo-item))
+ ;; Done items section should be visible and the move done item
+ ;; should be at the top of it.
+ (should (search-forward done-item))
+ (should (todo-done-item-p))
+ (forward-line -1)
+ (should (looking-at todo-category-done))
+ ;; Make sure marked items are no longer in first category.
+ (todo-backward-category)
+ (should-error (search-forward todo-item))
+ (todo-toggle-view-done-items)
+ (should-error (search-forward done-item))
+ (should (= (todo-get-count 'todo cat1) (1- cat1-todo)))
+ (should (= (todo-get-count 'todo cat2) (1+ cat2-todo)))
+ (should (= (todo-get-count 'done cat1) (1- cat1-done)))
+ (should (= (todo-get-count 'done cat2) (1+ cat2-done)))))))
+
+(ert-deftest todo-test-move-item05 () ; bug#27609
+ "Test moving multiple todo and done items to another category.
+Both types of item should be moved en bloc to the new category,
+and the the top todo item should have the provided priority and
+the top done item should be the first done item."
+ (with-todo-test
+ (todo-test--show 1)
+ (let* ((cat1 (todo-current-category))
+ (cat2 (car (nth 1 todo-categories)))
+ (cat1-todo (todo-get-count 'todo cat1))
+ (cat2-todo (todo-get-count 'todo cat2))
+ (cat1-done (todo-get-count 'done cat1))
+ (cat2-done (todo-get-count 'done cat2))
+ (todo-items (buffer-string))
+ (done-items (prog2 (todo-toggle-view-done-only)
+ (buffer-string)
+ (todo-toggle-view-done-only))))
+ ;; Why is this necessary here but not below?
+ (set-window-buffer nil (current-buffer))
+ (todo-toggle-view-done-items)
+ (todo-mark-category)
+ (todo-test--move-item 2 3)
+ (should (equal (todo-current-category) cat2))
+ ;; Point should be at the start of the first moved todo item.
+ (should (looking-at (regexp-quote todo-items)))
+ ;; Done items section should be visible and the move done item
+ ;; should be at the top of it.
+ (should (search-forward done-items))
+ (goto-char (match-beginning 0))
+ (should (todo-done-item-p))
+ (forward-line -1)
+ (should (looking-at todo-category-done))
+ ;; Make sure marked items are no longer in first category.
+ (todo-backward-category)
+ (should (eq (point-min) (point-max))) ; All todo items were moved.
+ ;; This passes when run interactively but fails in a batch run:
+ ;; the message is displayed but (current-message) evaluates to
+ ;; nil.
+ ;; (todo-toggle-view-done-items) ; All done items were moved.
+ ;; (let ((msg (current-message)))
+ ;; (should (equal msg "There are no done items in this category.")))
+ (todo-toggle-view-done-only)
+ (should (eq (point-min) (point-max))) ; All done items were moved.
+ (should (= (todo-get-count 'todo cat1) 0))
+ (should (= (todo-get-count 'todo cat2) (+ cat1-todo cat2-todo)))
+ (should (= (todo-get-count 'done cat1) 0))
+ (should (= (todo-get-count 'done cat2) (+ cat1-done cat2-done))))))
+
+(ert-deftest todo-test-toggle-item-header01 () ; bug#27609
+ "Test toggling item header from an empty category."
+ (with-todo-test
+ (todo-test--show 3)
+ (should (eq (point-min) (point-max))) ; Category is empty.
+ (todo-toggle-item-header)
+ (todo-backward-category)
+ ;; Header is hidden.
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))
+ (todo-forward-category)
+ (todo-toggle-item-header)
+ (todo-backward-category)
+ ;; Header is shown.
+ (should-not (todo-get-overlay 'header))))
+
+(ert-deftest todo-test-toggle-item-header02 () ; bug#27609
+ "Test navigating between items with hidden header."
+ :expected-result :failed ; FIXME
+ (with-todo-test
+ (todo-test--show 2)
+ (let* ((start0 (point))
+ (find-start (lambda ()
+ (re-search-forward
+ (concat todo-date-string-start
+ todo-date-pattern
+ "\\( " diary-time-regexp "\\)?"
+ (regexp-quote todo-nondiary-end) "?")
+ (line-end-position) t)
+ (forward-char)
+ (point)))
+ (start1 (save-excursion (funcall find-start)))
+ (start2 (save-excursion (todo-next-item) (funcall find-start))))
+ (should (looking-at todo-item-start))
+ (todo-toggle-item-header)
+ ;; Point hasn't changed...
+ (should (eq (point) start0))
+ (should (looking-at todo-item-start))
+ ;; FIXME: In the test run this puts point at todo-item-start,
+ ;; i.e. the display overlay doesn't affect this movement, unlike
+ ;; with the command in todo-mode (and using call-interactively
+ ;; here doesn't change this).
+ (todo-next-item)
+ (should (eq (point) start2))
+ (should-not (looking-at todo-item-start))
+ (todo-previous-item)
+ ;; ...but now it has.
+ (should (eq (point) start1))
+ (should-not (looking-at todo-item-start))
+ ;; This is the status quo but is it desirable?
+ (todo-toggle-item-header)
+ (should (eq (point) start1))
+ (should-not (looking-at todo-item-start)))))
+
+(ert-deftest todo-test-toggle-item-header03 () ; bug#27609
+ "Test display of hidden item header when changing item's priority."
+ (with-todo-test
+ (todo-test--show 2)
+ (todo-toggle-item-header)
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))
+ (todo-lower-item-priority)
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))
+ (todo-raise-item-priority)
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))
+ ;; Set priority noninteractively.
+ (cl-letf (((symbol-function 'read-number)
+ (lambda (_prompt &optional _default) 3)))
+ (todo-item-undone))
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))))
+
+(ert-deftest todo-test-toggle-item-header04 () ; bug#27609
+ "Test display of hidden item header under todo-item-(un)done."
+ (with-todo-test
+ (todo-test--show 1)
+ (let ((item (todo-item-string)))
+ (todo-toggle-item-header)
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))
+ (todo-item-done)
+ ;; Without set-window-buffer here this test passes when run
+ ;; interactively but fails in a batch run.
+ (set-window-buffer nil (current-buffer))
+ (todo-toggle-view-done-items)
+ (should (search-forward item))
+ (todo-item-start)
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))
+ ;; Set priority for todo-item-undone noninteractively.
+ (cl-letf (((symbol-function 'read-number)
+ (lambda (_prompt &optional _default) 1)))
+ (todo-item-undone))
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) "")))))
+
+(ert-deftest todo-test-toggle-item-header05 () ; bug#27609
+ "Test display of hidden item header under todo-move-item."
+ (with-todo-test
+ (todo-test--show 1)
+ (todo-toggle-item-header)
+ (todo-test--move-item 2 3)
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) ""))))
+
+(ert-deftest todo-test-toggle-item-header06 () ; bug#27609
+ "Test display of hidden item header under (un)archiving.
+The relocated item's header should take on the display status of
+headers in the goal file, even when the display status in the
+source file is different."
+ (with-todo-test
+ (todo-test--show 1)
+ (todo-toggle-item-header)
+ (todo-toggle-view-done-only) ; Go to first (i.e. top) done item.
+ (let ((item (todo-item-string)))
+ (todo-archive-done-item)
+ (todo-toggle-view-done-only) ; To display all items on unarchiving.
+ (todo-find-archive)
+ (should (equal (todo-item-string) item)) ; The just archived item.
+ ;; The archive file headers are displayed by default.
+ (should-not (todo-get-overlay 'header))
+ (todo-unarchive-items)
+ ;; Headers in the todo file are still hidden.
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) "")))))
+
+(defun todo-test--insert-item (item &optional priority)
+ "Insert string ITEM into current category with priority PRIORITY.
+Use defaults for all other item insertion parameters. This
+provides a noninteractive API for todo-insert-item for use in
+automatic testing."
+ (cl-letf (((symbol-function 'read-from-minibuffer)
+ (lambda (_prompt) item))
+ ((symbol-function 'read-number) ; For todo-set-item-priority
+ (lambda (_prompt &optional _default) (or priority 1))))
+ (todo-insert-item--basic)))
+
+(ert-deftest todo-test-toggle-item-header07 () ; bug#27609
+ "Test display of hidden item header under todo-insert-item."
+ (with-todo-test
+ (todo-test--show 1)
+ (todo-toggle-item-header)
+ (let ((item "Test display of hidden item header under todo-insert-item."))
+ (todo-test--insert-item item 1)
+ (should (equal (overlay-get (todo-get-overlay 'header) 'display) "")))))
+
+
(provide 'todo-mode-tests)
;;; todo-mode-tests.el ends here
projects / emacs.git / commitdiff