Add tests for bug#42149

* test/lisp/minibuffer-tests.el (completion--pcm-score)
(completion--pcm-first-difference-pos): New helpers.
(completion-pcm-test-1, completion-pcm-test-2)
(completion-pcm-test-3, completion-pcm-test-4)
(completion-pcm-test-5, completion-pcm-test-6)
(completion-substring-test-1, completion-substring-test-2)
(completion-substring-test-3, completion-substring-test-4)
(completion-flex-test-1, completion-flex-test-2)
(completion-flex-test-3): New tests.

Co-authored-by: Dario Gjorgjevski <dario.gjorgjevski@gmail.com>

diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index 32734794413a328eb92cc315acdad0b4d755dbd0..5988656bd7f6f7b390ff36c82b688cf8e290a0a6 100644 (file)
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -107,5 +107,152 @@
                                                 nil (length input))
                      (cons output (length output)))))))
 
+(defun completion--pcm-score (comp)
+  (get-text-property 0 'completion-score comp))
+
+(defun completion--pcm-first-difference-pos (comp)
+  (cl-loop for pos = (next-single-property-change 0 'face comp)
+           then (next-single-property-change pos 'face comp)
+           while pos
+           when (eq (get-text-property pos 'face comp)
+                    'completions-first-difference)
+           return pos))
+
+(ert-deftest completion-pcm-test-1 ()
+  ;; Point is at end, this does not match anything
+  (should (equal
+           (completion-pcm-all-completions
+            "foo" '("hello" "world" "barfoobar") nil 3)
+           nil)))
+
+(ert-deftest completion-pcm-test-2 ()
+  ;; Point is at beginning, this matches "barfoobar"
+  (should (equal
+           (car (completion-pcm-all-completions
+                 "foo" '("hello" "world" "barfoobar") nil 0))
+           "barfoobar")))
+
+(ert-deftest completion-pcm-test-3 ()
+  ;; Full match!
+  (should (eql
+           (completion--pcm-score
+            (car (completion-pcm-all-completions
+                  "R" '("R" "hello") nil 1)))
+           1.0)))
+
+(ert-deftest completion-pcm-test-4 ()
+  ;; One fourth of a match and no match due to point being at the end
+  (should (eql
+           (completion--pcm-score
+            (car (completion-pcm-all-completions
+                  "RO" '("RaOb") nil 1)))
+           (/ 1.0 4.0)))
+  (should (equal
+           (completion-pcm-all-completions
+            "RO" '("RaOb") nil 2)
+           nil)))
+
+(ert-deftest completion-pcm-test-5 ()
+  ;; Point is at beginning, but `completions-first-difference' is
+  ;; moved after it
+  (should (eql
+           (completion--pcm-first-difference-pos
+            (car (completion-pcm-all-completions
+                  "f" '("few" "many") nil 0)))
+           1)))
+
+(ert-deftest completion-pcm-test-6 ()
+  ;; Wildcards and delimiters work
+  (should (equal
+           (car (completion-pcm-all-completions
+                 "li-pac*" '("list-packages") nil 7))
+           "list-packages"))
+  (should (equal
+             (car (completion-pcm-all-completions
+                   "li-pac*" '("do-not-list-packages") nil 7))
+             nil)))
+
+(ert-deftest completion-substring-test-1 ()
+  ;; One third of a match!
+  (should (equal
+           (car (completion-substring-all-completions
+                 "foo" '("hello" "world" "barfoobar") nil 3))
+           "barfoobar"))
+  (should (eql
+           (completion--pcm-score
+            (car (completion-substring-all-completions
+                  "foo" '("hello" "world" "barfoobar") nil 3)))
+           (/ 1.0 3.0))))
+
+(ert-deftest completion-substring-test-2 ()
+  ;; Full match!
+  (should (eql
+           (completion--pcm-score
+            (car (completion-substring-all-completions
+                  "R" '("R" "hello") nil 1)))
+           1.0)))
+
+(ert-deftest completion-substring-test-3 ()
+  ;; Substring match
+  (should (equal
+           (car (completion-substring-all-completions
+                  "custgroup" '("customize-group") nil 4))
+           "customize-group"))
+  (should (equal
+           (car (completion-substring-all-completions
+                  "custgroup" '("customize-group") nil 5))
+           nil)))
+
+(ert-deftest completion-substring-test-4 ()
+  ;; `completions-first-difference' should be at the right place
+  (should (eql
+           (completion--pcm-first-difference-pos
+            (car (completion-substring-all-completions
+                  "jab" '("dabjobstabby" "many") nil 1)))
+           4))
+  (should (equal
+           (completion--pcm-first-difference-pos
+            (car (completion-substring-all-completions
+                  "jab" '("dabjabstabby" "many") nil 1)))
+           6))
+  (should (equal
+           (completion--pcm-first-difference-pos
+            (car (completion-substring-all-completions
+                  "jab" '("dabjabstabby" "many") nil 3)))
+           6)))
+
+(ert-deftest completion-flex-test-1 ()
+  ;; Fuzzy match
+  (should (equal
+           (car (completion-flex-all-completions
+                 "foo" '("hello" "world" "fabrobazo") nil 3))
+           "fabrobazo")))
+
+(ert-deftest completion-flex-test-2 ()
+  ;; Full match!
+  (should (eql
+           (completion--pcm-score
+            (car (completion-flex-all-completions
+                  "R" '("R" "hello") nil 1)))
+           1.0)))
+
+(ert-deftest completion-flex-test-3 ()
+  ;; Another fuzzy match, but more of a "substring" one
+  (should (equal
+           (car (completion-flex-all-completions
+                 "custgroup" '("customize-group-other-window") nil 4))
+           "customize-group-other-window"))
+  ;; `completions-first-difference' should be at the right place
+  (should (equal
+           (completion--pcm-first-difference-pos
+            (car (completion-flex-all-completions
+                  "custgroup" '("customize-group-other-window") nil 4)))
+           4))
+  (should (equal
+           (completion--pcm-first-difference-pos
+            (car (completion-flex-all-completions
+                  "custgroup" '("customize-group-other-window") nil 9)))
+           15)))
+
 (provide 'completion-tests)
 ;;; completion-tests.el ends here