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

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

Browse source 
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.
This commit is contained in:
João Távora 2023-11-11 15:29:46 +00:00
parent c9d7740574
commit fff9b6e37a
2 changed files with 32 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

38
lisp/minibuffer.el
View file

@ -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)))

16
test/lisp/minibuffer-tests.el
View file

@ -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."