From c69264553523fc3c597099b85de24e1636264d6c Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Wed, 8 Jul 2026 11:25:29 +0300 Subject: [PATCH 1/2] Add a :to-have-face matcher for font-lock tests The face helpers asserted with a bare (expect ACTUAL :to-equal EXPECTED), so a failure read "Expected face-a to equal face-b" with no hint of which token was wrong. Add a :to-have-face matcher that resolves a substring (searched from point), a position, or a (START END) range and reports e.g. "Expected \"def\" to have face font-lock-string-face, but it had font-lock-keyword-face". Route expect-face-at, expect-face-of and clojure-test--check-faces (hence when-fontifying-it) through it, so the whole font-lock suite gains the better messages. --- test/clojure-mode-font-lock-test.el | 54 ++++++++++++++++++++++------- 1 file changed, 42 insertions(+), 12 deletions(-) diff --git a/test/clojure-mode-font-lock-test.el b/test/clojure-mode-font-lock-test.el index b8e6efdb..e15ee277 100644 --- a/test/clojure-mode-font-lock-test.el +++ b/test/clojure-mode-font-lock-test.el @@ -50,6 +50,41 @@ Assumes the current buffer is already fontified." start-face 'various-faces))) +(defun clojure-test--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-test--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-test--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-get-face-at (start end content) "Get the face between START and END in CONTENT." (with-fontified-clojure-buffer content @@ -57,7 +92,8 @@ Assumes the current buffer is already fontified." (defun expect-face-at (content start end face) "Expect face in CONTENT between START and END to be equal to FACE." - (expect (clojure-get-face-at start end content) :to-equal face)) + (with-fontified-clojure-buffer content + (expect (list start end) :to-have-face face))) (defun expect-face-of (content substring face &optional nth) "Expect FACE on the NTH occurrence of SUBSTRING in fontified CONTENT. @@ -66,9 +102,9 @@ NTH defaults to 1." (goto-char (point-min)) (dotimes (_ (or nth 1)) (search-forward substring)) - (let* ((end (1- (point))) - (start (- (point) (length substring)))) - (expect (clojure-test--uniform-face start end) :to-equal face)))) + (let ((start (- (point) (length substring))) + (end (1- (point)))) + (expect (list start end) :to-have-face face)))) (defun clojure-test--check-faces (content face-specs) "Fontify CONTENT and check all FACE-SPECS. @@ -82,15 +118,9 @@ without any special annotation." (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-test--uniform-face start end) - :to-equal face))))) + (expect substr :to-have-face face)) (`(,(and (pred numberp) start) ,end ,face) - (expect (clojure-test--uniform-face start end) :to-equal face)))))) + (expect (list start end) :to-have-face face)))))) (defconst clojure-test-syntax-classes [whitespace punctuation word symbol open-paren close-paren expression-prefix From 558f30372c76b95adb5cf9b6f2adcfe52bf0e7e3 Mon Sep 17 00:00:00 2001 From: Bozhidar Batsov Date: Wed, 8 Jul 2026 11:25:29 +0300 Subject: [PATCH 2/2] Use spy-on instead of cl-letf for project stubs in tests Replace (cl-letf ((symbol-function ...))) with buttercup's spy-on, which auto-restores after each spec. The clojure-project-relative-path check was a bare expect directly under describe (so it never ran as a spec); wrap it in an it, which both fixes that and lets it use spy-on. --- test/clojure-mode-util-test.el | 25 ++++++++++++------------- 1 file changed, 12 insertions(+), 13 deletions(-) diff --git a/test/clojure-mode-util-test.el b/test/clojure-mode-util-test.el index bd503350..6a5f24ce 100644 --- a/test/clojure-mode-util-test.el +++ b/test/clojure-mode-util-test.el @@ -85,24 +85,23 @@ :to-equal subdir))))) (describe "clojure-project-relative-path" - (cl-letf (((symbol-function 'clojure-project-dir) (lambda () project-dir))) - (expect (string= (clojure-project-relative-path clj-file-path) - project-relative-clj-file-path)))) + (it "returns the path relative to the project root" + (spy-on 'clojure-project-dir :and-return-value project-dir) + (expect (clojure-project-relative-path clj-file-path) + :to-equal project-relative-clj-file-path))) (describe "clojure-expected-ns" (it "should return the namespace matching a path" - (cl-letf (((symbol-function 'clojure-project-relative-path) - (lambda (&optional _current-buffer-file-name) - project-relative-clj-file-path))) - (expect (string= (clojure-expected-ns clj-file-path) clj-file-ns)))) + (spy-on 'clojure-project-relative-path + :and-return-value project-relative-clj-file-path) + (expect (string= (clojure-expected-ns clj-file-path) clj-file-ns))) (it "should return the namespace even without a path" - (cl-letf (((symbol-function 'clojure-project-relative-path) - (lambda (&optional _current-buffer-file-name) - project-relative-clj-file-path))) - (expect (string= (let ((buffer-file-name clj-file-path)) - (clojure-expected-ns)) - clj-file-ns)))))) + (spy-on 'clojure-project-relative-path + :and-return-value project-relative-clj-file-path) + (expect (string= (let ((buffer-file-name clj-file-path)) + (clojure-expected-ns)) + clj-file-ns))))) (describe "clojure-find-ns" (it "should find common namespace declarations"