procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

mh-utils-tests: 'mh-sub-folders-actual' coverage

Browse source 
* test/lisp/mh-e/mh-utils.el (mh-sub-folders-parse-no-folder)
(mh-sub-folders-parse-relative-folder, mh-sub-folders-parse-root-folder):
New tests.
* lisp/mh-e/mh-utils.el (mh-sub-folders-parse): New function,
refactored out of 'mh-sub-folders-actual' to create a testing seam.
This commit is contained in:
Stephen Gildea 2021-11-24 18:38:24 -08:00
parent 11e5c7d8ca
commit 82233c2c1d
2 changed files with 77 additions and 24 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

55
lisp/mh-e/mh-utils.el
View file

@ -562,7 +562,6 @@ Expects FOLDER to have already been normalized with
(let ((arg-list `(,(expand-file-name "folders" mh-progs)
nil (t nil) nil "-noheader" "-norecurse" "-nototal"
,@(if (stringp folder) (list folder) ())))
(results ())
(current-folder (concat
(with-temp-buffer
(call-process (expand-file-name "folder" mh-progs)
@ -571,29 +570,37 @@ Expects FOLDER to have already been normalized with
"+")))
(with-temp-buffer
(apply #'call-process arg-list)
(goto-char (point-min))
(while (not (and (eolp) (bolp)))
(goto-char (line-end-position))
(let ((start-pos (line-beginning-position))
(has-pos (search-backward " has "
(line-beginning-position) t)))
(when (integerp has-pos)
(while (equal (char-after has-pos) ? )
(cl-decf has-pos))
(cl-incf has-pos)
(while (equal (char-after start-pos) ? )
(cl-incf start-pos))
(let* ((name (buffer-substring start-pos has-pos))
(first-char (aref name 0))
(last-char (aref name (1- (length name)))))
(unless (member first-char '(?. ?# ?,))
(when (and (equal last-char ?+) (equal name current-folder))
(setq name (substring name 0 (1- (length name)))))
(push
(cons name
(search-forward "(others)" (line-end-position) t))
results))))
(forward-line 1))))
(mh-sub-folders-parse folder current-folder))))
(defun mh-sub-folders-parse (folder current-folder)
"Parse the results of \"folders FOLDER\" and return a list of sub-folders.
CURRENT-FOLDER is the result of \"folder -fast\".
FOLDER will be nil or start with '+'; CURRENT-FOLDER will end with '+'.
This function is a testable helper of `mh-sub-folders-actual'."
(let ((results ()))
(goto-char (point-min))
(while (not (and (eolp) (bolp)))
(goto-char (line-end-position))
(let ((start-pos (line-beginning-position))
(has-pos (search-backward " has "
(line-beginning-position) t)))
(when (integerp has-pos)
(while (equal (char-after has-pos) ? )
(cl-decf has-pos))
(cl-incf has-pos)
(while (equal (char-after start-pos) ? )
(cl-incf start-pos))
(let* ((name (buffer-substring start-pos has-pos))
(first-char (aref name 0))
(last-char (aref name (1- (length name)))))
(unless (member first-char '(?. ?# ?,))
(when (and (equal last-char ?+) (equal name current-folder))
(setq name (substring name 0 (1- (length name)))))
(push
(cons name
(search-forward "(others)" (line-end-position) t))
results))))
(forward-line 1)))
(setq results (nreverse results))
(when (stringp folder)
(setq results (cdr results))

46
test/lisp/mh-e/mh-utils-tests.el
View file

@ -80,6 +80,52 @@
(mh-normalize-folder-name "+inbox////../news/" nil t)))
(should (equal "+inbox/news" (mh-normalize-folder-name "+inbox////./news"))))
(ert-deftest mh-sub-folders-parse-no-folder ()
"Test `mh-sub-folders-parse' with no starting folder."
(let (others-position)
(with-temp-buffer
(insert "lines without has-string are ignored\n")
(insert "onespace has no messages.\n")
(insert "twospace has no messages.\n")
(insert " precedingblanks has no messages.\n")
(insert ".leadingdot has no messages.\n")
(insert "#leadinghash has no messages.\n")
(insert ",leadingcomma has no messages.\n")
(insert "withothers has no messages ; (others)")
(setq others-position (point))
(insert ".\n")
(insert "curf has no messages.\n")
(insert "curf+ has 123 messages.\n")
(insert "curf2+ has 17 messages.\n")
(insert "\ntotal after blank line is ignored has no messages.\n")
(should (equal
(mh-sub-folders-parse nil "curf+")
(list '("onespace") '("twospace") '("precedingblanks")
(cons "withothers" others-position)
'("curf") '("curf") '("curf2+")))))))
(ert-deftest mh-sub-folders-parse-relative-folder ()
"Test `mh-sub-folders-parse' with folder."
(let (others-position)
(with-temp-buffer
(insert "testf+ has no messages.\n")
(insert "testf/sub1 has no messages.\n")
(insert "testf/sub2 has no messages ; (others)")
(setq others-position (point))
(insert ".\n")
(should (equal
(mh-sub-folders-parse "+testf" "testf+")
(list '("sub1") (cons "sub2" others-position)))))))
(ert-deftest mh-sub-folders-parse-root-folder ()
"Test `mh-sub-folders-parse' with root folder."
(with-temp-buffer
(insert "/+ has no messages.\n")
(insert "//nmh-style has no messages.\n")
(should (equal
(mh-sub-folders-parse "+/" "inbox+")
'(("nmh-style"))))))
;; Folder names that are used by the following tests.
(defvar mh-test-rel-folder "rela-folder")