mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-23 18:47:57 +00:00
Code Issues Releases Activity

Fix hi-lock test and add new test for unhighlight (bug#40337)

Browse Source 
* lisp/hi-lock.el (hi-lock-unface-buffer): Use hi-lock--hashcons
only on strings, not lists.

* test/lisp/hi-lock-tests.el (hi-lock-bug26666): Revert previous change,
use "a" instead of "b".
(hi-lock-unhighlight): New test.
This commit is contained in:
Juri Linkov 2020-04-14 02:33:52 +03:00
parent 086faceb1c
commit 7a9fb5d55c
2 changed files with 61 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
lisp/hi-lock.el
View File

@ -681,8 +681,8 @@ then remove all hi-lock highlighting."
(delq keyword hi-lock-interactive-patterns))
(remove-overlays
nil nil 'hi-lock-overlay-regexp
(hi-lock--hashcons (or (car (rassq keyword hi-lock-interactive-lighters))
(car keyword))))
(or (car (rassq keyword hi-lock-interactive-lighters))
(hi-lock--hashcons (car keyword))))
(setq hi-lock-interactive-lighters
(rassq-delete-all keyword hi-lock-interactive-lighters))
(font-lock-flush))))

62
test/lisp/hi-lock-tests.el
View File

@ -33,9 +33,7 @@
(car defaults))))
(dotimes (_ 2)
(let ((face (hi-lock-read-face-name)))
;; This test should use regexp "b" different from "a"
;; used in another test because hi-lock--hashcons is global.
(hi-lock-set-pattern "b" face))))
(hi-lock-set-pattern "a" face))))
(should (equal hi-lock--unused-faces (cdr faces))))))
(ert-deftest hi-lock-test-set-pattern ()
@ -148,5 +146,63 @@
(call-interactively 'unhighlight-regexp))
(should (null (get-text-property 1 'face))))))
(ert-deftest hi-lock-unhighlight ()
"Test for unhighlighting and `hi-lock--regexps-at-point'."
(let ((hi-lock-auto-select-face t))
(with-temp-buffer
(insert "aAbB\n")
(cl-letf (((symbol-function 'completing-read)
(lambda (_prompt _coll _x _y _z _hist defaults)
(car defaults))))
(highlight-regexp "a")
(highlight-regexp "b")
(should (= (length (overlays-in (point-min) (point-max))) 4))
;; `hi-lock--regexps-at-point' should take regexp "a" at point 1,
;; not the last regexp "b"
(goto-char 1)
(call-interactively 'unhighlight-regexp)
(should (= (length (overlays-in 1 3)) 0))
(should (= (length (overlays-in 3 5)) 2))
;; Next call should unhighlight remaining regepxs
(call-interactively 'unhighlight-regexp)
(should (= (length (overlays-in 3 5)) 0))
;; Test unhighlight all
(highlight-regexp "a")
(highlight-regexp "b")
(should (= (length (overlays-in (point-min) (point-max))) 4))
(unhighlight-regexp t)
(should (= (length (overlays-in (point-min) (point-max))) 0))
(emacs-lisp-mode)
(setq font-lock-mode t)
(highlight-regexp "a")
(highlight-regexp "b")
(font-lock-ensure)
(should (memq 'hi-yellow (get-text-property 1 'face)))
(should (memq 'hi-yellow (get-text-property 3 'face)))
;; `hi-lock--regexps-at-point' should take regexp "a" at point 1,
;; not the last regexp "b"
(goto-char 1)
(let ((font-lock-fontified t)) (call-interactively 'unhighlight-regexp))
(should (null (get-text-property 1 'face)))
(should (memq 'hi-yellow (get-text-property 3 'face)))
;; Next call should unhighlight remaining regepxs
(let ((font-lock-fontified t)) (call-interactively 'unhighlight-regexp))
(should (null (get-text-property 3 'face)))
;; Test unhighlight all
(highlight-regexp "a")
(highlight-regexp "b")
(font-lock-ensure)
(should (memq 'hi-yellow (get-text-property 1 'face)))
(should (memq 'hi-yellow (get-text-property 3 'face)))
(let ((font-lock-fontified t)) (unhighlight-regexp t))
(should (null (get-text-property 1 'face)))
(should (null (get-text-property 3 'face)))))))
(provide 'hi-lock-tests)
;;; hi-lock-tests.el ends here