From: Juri Linkov <juri@linkov.net>
Date: Mon, 13 Apr 2020 23:33:52 +0000 (+0300)
Subject: Fix hi-lock test and add new test for unhighlight (bug#40337)
X-Git-Tag: emacs-28.0.90~7587
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=7a9fb5d55c9bf612a38348d59e769ee915175e28;p=emacs.git

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

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

diff --git a/lisp/hi-lock.el b/lisp/hi-lock.el
index 1d8dc0624ba..bf79e48f856 100644
--- a/lisp/hi-lock.el
+++ b/lisp/hi-lock.el
@@ -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))))
diff --git a/test/lisp/hi-lock-tests.el b/test/lisp/hi-lock-tests.el
index 252caaa2650..59f3e73b17d 100644
--- a/test/lisp/hi-lock-tests.el
+++ b/test/lisp/hi-lock-tests.el
@@ -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