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

* 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.

diff --git a/lisp/mh-e/mh-utils.el b/lisp/mh-e/mh-utils.el
index 992943e304222298a8706c6ecea2a994d4f403d0..ad23bd1911817dcdeeb69c26b559394d42808c4d 100644 (file)
--- a/lisp/mh-e/mh-utils.el
+++ b/lisp/mh-e/mh-utils.el
@@ -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))

diff --git a/test/lisp/mh-e/mh-utils-tests.el b/test/lisp/mh-e/mh-utils-tests.el
index 5f6accc6470ef76e717223611f0289dfdc94de09..83949204a6e708669a0ef3416e3a75197782f7d8 100644 (file)
--- a/test/lisp/mh-e/mh-utils-tests.el
+++ b/test/lisp/mh-e/mh-utils-tests.el
@@ -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")