Improve font-lock test failure messages with a :to-have-face matcher

test/clojure-ts-mode-font-lock-test.el

@@ -48,6 +48,41 @@ Assumes the current buffer is already fontified."
         start-face
       'various-faces)))
 
+(defun clojure-ts--face-target (target)
+  "Resolve TARGET to a (START END DESCRIPTION) list in the current buffer.
+TARGET is a substring (searched for from point), a position, or a
+\(START END) range.  Return nil when a substring cannot be found."
+  (cond
+   ((stringp target)
+    (when (search-forward target nil t)
+      (list (- (point) (length target)) (1- (point)) (format "%S" target))))
+   ((integerp target)
+    (list target target (format "position %d" target)))
+   ((and (consp target) (integerp (car target)))
+    (list (nth 0 target) (nth 1 target)
+          (format "range %d-%d" (nth 0 target) (nth 1 target))))))
+
+(buttercup-define-matcher :to-have-face (target expected)
+  "Check that TARGET is fontified with face EXPECTED in the current buffer.
+TARGET is a substring (searched for from point), a position, or a
+\(START END) range.  Only meaningful after the buffer has been fontified.
+On failure the message names the text and the face that was found."
+  (let* ((target (funcall target))
+         (expected (funcall expected))
+         (resolved (clojure-ts--face-target target)))
+    (if (not resolved)
+        (cons nil (format "Expected to find %S in the buffer to check its \
+face, but it was not present" target))
+      (let* ((start (nth 0 resolved))
+             (end (nth 1 resolved))
+             (desc (nth 2 resolved))
+             (actual (clojure-ts--uniform-face start end)))
+        (cons (equal actual expected)
+              (if (equal actual expected)
+                  (format "Expected %s not to have face %S" desc expected)
+                (format "Expected %s to have face %S, but it had %S"
+                        desc expected actual)))))))
+
 (defun clojure-ts-get-face-at (start end content)
   "Get the face between START and END in CONTENT."
   (with-fontified-clojure-ts-buffer content
@@ -64,19 +99,14 @@ that repeated substrings resolve naturally in document order."
     (dolist (spec face-specs)
       (pcase spec
         (`(,(and (pred stringp) substr) ,face)
-         (let ((found (search-forward substr nil t)))
-           (expect found :not :to-be nil)
-           (when found
-             (let* ((end (1- (point)))
-                    (start (- (point) (length substr))))
-               (expect (clojure-ts--uniform-face start end)
-                       :to-equal face)))))
+         (expect substr :to-have-face face))
         (`(,(and (pred numberp) start) ,end ,face)
-         (expect (clojure-ts--uniform-face start end) :to-equal face))))))
+         (expect (list start end) :to-have-face face))))))
 
 (defun expect-face-at (content start end face)
   "Expect face in CONTENT between START and END to be equal to FACE."
-  (expect (clojure-ts-get-face-at start end content) :to-equal face))
+  (with-fontified-clojure-ts-buffer content
+    (expect (list start end) :to-have-face face)))
 
 (defun expect-faces-at (content &rest faces)
   "Expect FACES in CONTENT.

test/clojure-ts-mode-util-test.el

@@ -50,25 +50,24 @@
                                :to-equal (file-name-as-directory temp-dir))))))
 
   (describe "clojure-ts-project-relative-path"
-    (cl-letf (((symbol-function 'clojure-ts-project-dir) (lambda () project-dir)))
+    (it "returns the path relative to the project root"
+      (spy-on 'clojure-ts-project-dir :and-return-value project-dir)
       (expect (clojure-ts-project-relative-path clj-file-path)
               :to-equal project-relative-clj-file-path)))
 
   (describe "clojure-ts-expected-ns"
     (it "should return the namespace matching a path"
-      (cl-letf (((symbol-function 'clojure-ts-project-relative-path)
-                 (lambda (&optional _current-buffer-file-name)
-                   project-relative-clj-file-path)))
-        (expect (clojure-ts-expected-ns clj-file-path)
-                :to-equal clj-file-ns)))
+      (spy-on 'clojure-ts-project-relative-path
+              :and-return-value project-relative-clj-file-path)
+      (expect (clojure-ts-expected-ns clj-file-path)
+              :to-equal clj-file-ns))
 
     (it "should return the namespace even without a path"
-      (cl-letf (((symbol-function 'clojure-ts-project-relative-path)
-                 (lambda (&optional _current-buffer-file-name)
-                   project-relative-clj-file-path)))
-        (expect (let ((buffer-file-name clj-file-path))
-                  (clojure-ts-expected-ns))
-                :to-equal clj-file-ns)))))
+      (spy-on 'clojure-ts-project-relative-path
+              :and-return-value project-relative-clj-file-path)
+      (expect (let ((buffer-file-name clj-file-path))
+                (clojure-ts-expected-ns))
+              :to-equal clj-file-ns))))
 
 (describe "clojure-ts-find-ns"
   (it "should find common namespace declarations"