Fix test failures in test/lisp/minibuffer-tests.el

bug#48841, bug#47711

In some instances the test code needed to be updated to make different
assumptions about implementation details.

In others, like the ones about the completions-first-difference face,
minor parts of the actual user-visible behaviour were broken.

* test/lisp/minibuffer-tests.el (completion-test1): Robustify test.
(completion--pcm-score): Don't assume completion-score is stored
in string as a property.

* lisp/minibuffer.el (completion--hilit-from-re): Take new parameter.
(completion-pcm--hilit-commonality): Use it.

diff --git a/lisp/minibuffer.el b/lisp/minibuffer.el
index 3e2e3b6c6f28b763398a9c5187b587471c96a17e..07a284134d6abaf5081017c458c18d3247233707 100644 (file)
--- a/lisp/minibuffer.el
+++ b/lisp/minibuffer.el
@@ -3838,17 +3838,26 @@ details."
       (funcall completion-lazy-hilit-fn (copy-sequence str))
     str))
 
-(defun completion--hilit-from-re (string regexp)
-  "Fontify STRING with `completions-common-part' using REGEXP."
-  (let* ((md (and regexp (string-match regexp string) (cddr (match-data t))))
-         (me (and md (match-end 0)))
-         (from 0))
-    (while md
-      (add-face-text-property from (pop md) 'completions-common-part nil string)
-      (setq from (pop md)))
-    (unless (or (not me) (= from me))
-      (add-face-text-property from me 'completions-common-part nil string))
-    string))
+(defun completion--hilit-from-re (string regexp &optional point-idx)
+  "Fontify STRING using REGEXP POINT-IDX.
+`completions-common-part' and `completions-first-difference' are
+used.  POINT-IDX is the position of point in the presumed \"PCM\"
+pattern that was used to generate derive REGEXP from."
+(let* ((md (and regexp (string-match regexp string) (cddr (match-data t))))
+       (pos (if point-idx (match-beginning point-idx) (match-end 0)))
+       (me (and md (match-end 0)))
+       (from 0))
+  (while md
+    (add-face-text-property from (pop md) 'completions-common-part nil string)
+    (setq from (pop md)))
+  (if (> (length string) pos)
+      (add-face-text-property
+       pos (1+ pos)
+       'completions-first-difference
+       nil string))
+  (unless (or (not me) (= from me))
+    (add-face-text-property from me 'completions-common-part nil string))
+  string))
 
 (defun completion--flex-score-1 (md-groups match-end len)
   "Compute matching score of completion.
@@ -3973,16 +3982,17 @@ see) for later lazy highlighting."
         completion-lazy-hilit-fn nil)
   (cond
    ((and completions (cl-loop for e in pattern thereis (stringp e)))
-    (let* ((re (completion-pcm--pattern->regex pattern 'group)))
+    (let* ((re (completion-pcm--pattern->regex pattern 'group))
+           (point-idx (completion-pcm--pattern-point-idx pattern)))
       (setq completion-pcm--regexp re)
       (cond (completion-lazy-hilit
              (setq completion-lazy-hilit-fn
-                   (lambda (str) (completion--hilit-from-re str re)))
+                   (lambda (str) (completion--hilit-from-re str re point-idx)))
              completions)
             (t
              (mapcar
               (lambda (str)
-                (completion--hilit-from-re (copy-sequence str) re))
+                (completion--hilit-from-re (copy-sequence str) re point-idx))
               completions)))))
    (t completions)))
 

diff --git a/test/lisp/minibuffer-tests.el b/test/lisp/minibuffer-tests.el
index 27d718055023648bcc8a0ad4cf6d607c25864f94..28bca60b189e90b894d5105ef3964efd1d087dc9 100644 (file)
--- a/test/lisp/minibuffer-tests.el
+++ b/test/lisp/minibuffer-tests.el
@@ -33,14 +33,13 @@
 
 (ert-deftest completion-test1 ()
   (with-temp-buffer
-    (cl-flet* ((test/completion-table (_string _pred action)
-                                      (if (eq action 'lambda)
-                                          nil
-                                        "test: "))
+    (cl-flet* ((test/completion-table (string pred action)
+                 (let ((completion-ignore-case t))
+                   (complete-with-action action '("test: ") string pred)))
                (test/completion-at-point ()
-                                         (list (copy-marker (point-min))
-                                               (copy-marker (point))
-                                               #'test/completion-table)))
+                 (list (copy-marker (point-min))
+                       (copy-marker (point))
+                       #'test/completion-table)))
       (let ((completion-at-point-functions (list #'test/completion-at-point)))
         (insert "TEST")
         (completion-at-point)
@@ -190,7 +189,8 @@
 
 (defun completion--pcm-score (comp)
   "Get `completion-score' from COMP."
-  (get-text-property 0 'completion-score comp))
+  ;; FIXME, uses minibuffer.el implementation details
+  (completion--flex-score comp completion-pcm--regexp))
 
 (defun completion--pcm-first-difference-pos (comp)
   "Get `completions-first-difference' from COMP."