bug#69714: 30.0.50; ert-font-lock doesn't handle list of faces

[Vladimir Kazanov <vekazanov@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 3102 bytes --]

Hi,

I've attached a patch that handles face lists, fails on files without
assertions and expands the parser a bit to support multiple carets per
line.

For faces it does the following:

1. Turn symbols into single element lists.
2. Parses face lists from the assertions.
3. Compare face lists using equas.

Could you please check if this works for you?

Thanks

On Mon, 11 Mar 2024 at 08:36, Vladimir Kazanov <vekazanov@gmail.com> wrote:
>
> Hi,
>
> Thanks for reporting this! I have a bunch of ert-font-lock
> improvements in my local repo getting ready for submission, and can
> look into your suggestions as well.
>
> Do you have your unit test code somewhere in a public repo? It'd be
> great to think of further improvements to support your use case.
>
> Thanks,
> Vlad
>
> On Sun, 10 Mar 2024 at 20:33, Troy Brown <brownts@troybrown.dev> wrote:
> >
> > I'm trying to use this package to test out my tree-sitter mode, but am
> > running into an issue with lists of faces.  It's possible that the
> > face for a location in the buffer will contain a list of 1 or more
> > faces.  For example, when I use the ":override 'prepend" keyword in
> > the call to treesit-font-lock-rules, even if only a single face is
> > specified for the rule that matches that section of the buffer, this
> > will result in a list of one entry (i.e., "(face-name)").
> >
> > When this happens, ert-font-lock fails to recognize that this matches
> > the face "face-name" (e.g., "^ face-name" will fail to match in this
> > case).  I feel the tool should recognize a list containing a single
> > face as matching the face.  Even worse however, it appears
> > ert-font-lock doesn't support a list of faces in the comment.  I tried
> > to work around the original issue by using "^ (face-name)", but the
> > tool silently ignores this, as it doesn't match the internal regular
> > expression (which ended up allowing my test to pass without actually
> > checking anything).
> >
> > I can't figure out a way to use this tool in its current state due to
> > its lack of support for a list of faces.  Also, I find that since it
> > silently ignores incorrect comment syntax (e.g., "^face-name", "^
> > (face-name)"), it gives a false illusion that it's actually performing
> > those checks (and the checks are passing), when it's really just
> > ignoring them.  Maybe any comment line starting with a "^" or "<-"
> > should be considered an assertion check and to fail if the rest of the
> > syntax is not as expected.  Maybe it should also fail the test if no
> > assertion checks are found in a source file or string.
> >
> > Even if the tool would allow a list of a single face to match the
> > supplied face in the comment, I think it should also allow for
> > multiple faces to be listed in the comment.  I have other places where
> > multiple faces are used (e.g., "(font-lock-constant-face
> > font-lock-variable-name-face)" to highlight a constant variable),
> > which would not be testable with the current state of the package.
> >
> >
> >
>
>
> --
> Regards,
>
> Vladimir Kazanov



-- 
Regards,

Vladimir Kazanov

[-- Attachment #2: 0001-Improve-ert-font-lock-assertion-parser-Bug-69714.patch --]
[-- Type: text/x-patch, Size: 17935 bytes --]

From 3260b11c61a0ac414ef0d4d8715fd7b31c1c3e9e Mon Sep 17 00:00:00 2001
From: Vladimir Kazanov <vekazanov@gmail.com>
Date: Tue, 12 Mar 2024 11:14:54 +0000
Subject: [PATCH] Improve ert-font-lock assertion parser (Bug#69714)

Fail on files with no assertions, parser now accepts multiple
carets per line and face lists:
* lisp/emacs-lisp/ert-font-lock.el: Assertion parser fix.
* test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js:
* test/lisp/emacs-lisp/ert-font-lock-tests.el: Update unit tests.
---
 lisp/emacs-lisp/ert-font-lock.el              |  70 +++++++---
 .../ert-font-lock-resources/no-asserts.js     |   3 +
 test/lisp/emacs-lisp/ert-font-lock-tests.el   | 124 ++++++++++++++----
 3 files changed, 157 insertions(+), 40 deletions(-)
 create mode 100644 test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js

diff --git a/lisp/emacs-lisp/ert-font-lock.el b/lisp/emacs-lisp/ert-font-lock.el
index 29114712f92..06c90add9d3 100644
--- a/lisp/emacs-lisp/ert-font-lock.el
+++ b/lisp/emacs-lisp/ert-font-lock.el
@@ -39,16 +39,32 @@
 (require 'newcomment)
 (require 'pcase)

-(defconst ert-font-lock--assertion-re
+(defconst ert-font-lock--face-symbol-re
+  (rx (one-or-more (or alphanumeric "-" "_" ".")))
+  "A face symbol matching regex.")
+
+(defconst ert-font-lock--face-symbol-list-re
+  (rx "("
+      (* whitespace)
+      (one-or-more
+       (seq (regexp ert-font-lock--face-symbol-re)
+            (* whitespace)))
+      ")")
+  "A face symbol list matching regex.")
+
+(defconst ert-font-lock--assertion-line-re
   (rx
-   ;; column specifiers
+   ;; leading column assertion (arrow/caret)
    (group (or "^" "<-"))
-   (one-or-more " ")
+   (zero-or-more whitespace)
+   ;; possible to have many carets on an assertion line
+   (group (zero-or-more (seq "^" (zero-or-more whitespace))))
    ;; optional negation of the face specification
    (group (optional "!"))
-   ;; face symbol name
-   (group (one-or-more (or alphanumeric "-" "_" "."))))
-  "An ert-font-lock assertion regex.")
+   ;; face symbol name or a list of symbols
+   (group (or (regexp ert-font-lock--face-symbol-re)
+              (regexp ert-font-lock--face-symbol-list-re))))
+  "An ert-font-lock assertion line regex.")

 (defun ert-font-lock--validate-major-mode (mode)
   "Validate if MODE is a valid major mode."
@@ -212,7 +228,7 @@ ert-font-lock--line-assertion-p
   (save-excursion
     (beginning-of-line)
     (skip-syntax-forward " ")
-    (re-search-forward ert-font-lock--assertion-re
+    (re-search-forward ert-font-lock--assertion-line-re
                        (line-end-position) t 1)))

 (defun ert-font-lock--goto-first-char ()
@@ -252,8 +268,8 @@ ert-font-lock--parse-comments
           (throw 'nextline t))


-        ;; Collect the assertion
-        (when (re-search-forward ert-font-lock--assertion-re
+        ;; Collect the first line assertion (caret or arrow)
+        (when (re-search-forward ert-font-lock--assertion-line-re
                                  (line-end-position) t 1)

           (unless (> linetocheck -1)
@@ -266,21 +282,38 @@ ert-font-lock--parse-comments
                                      (- (match-beginning 1) (line-beginning-position))
                                    (ert-font-lock--get-first-char-column)))
                  ;; negate the face?
-                 (negation (string-equal (match-string-no-properties 2) "!"))
+                 (negation (string-equal (match-string-no-properties 3) "!"))
                  ;; the face that is supposed to be in the position specified
-                 (face (match-string-no-properties 3)))
+                 (face (read (match-string-no-properties 4))))

+            ;; Collect the first assertion on the line
             (push (list :line-checked linetocheck
                         :line-assert curline
                         :column-checked column-checked
                         :face face
                         :negation negation)
-                  tests))))
+                  tests)
+
+            ;; Collect all the other line carets (if present)
+            (goto-char (match-beginning 2))
+            (while (equal (following-char) ?^)
+              (setq column-checked (- (point) (line-beginning-position)))
+              (push (list :line-checked linetocheck
+                          :line-assert curline
+                          :column-checked column-checked
+                          :face face
+                          :negation negation)
+                    tests)
+              (forward-char)
+              (skip-syntax-forward " ")))))

       ;; next line
       (setq curline (1+ curline))
       (forward-line 1))

+    (unless tests
+      (user-error "No test assertions found"))
+
     (reverse tests)))

 (defun ert-font-lock--point-at-line-and-column (line column)
@@ -307,21 +340,28 @@ ert-font-lock--check-faces
     (let* ((line-checked (plist-get test :line-checked))
            (line-assert (plist-get test :line-assert))
            (column-checked (plist-get test :column-checked))
-           (expected-face (intern (plist-get test :face)))
+           (expected-face (plist-get test :face))
            (negation (plist-get test :negation))

            (actual-face (get-text-property (ert-font-lock--point-at-line-and-column line-checked column-checked) 'face))
            (line-str (ert-font-lock--get-line line-checked))
            (line-assert-str (ert-font-lock--get-line line-assert)))

-      (when (not (eq actual-face expected-face))
+      ;; normalize both expected and resulting face - these can be
+      ;; either symbols or lists of symbols
+      (when (symbolp actual-face)
+        (setq actual-face (list actual-face)))
+      (when (symbolp expected-face)
+        (setq expected-face (list expected-face)))
+
+      (when (not (equal actual-face expected-face))
         (ert-fail
          (list (format "Expected face %S, got %S on line %d column %d"
                        expected-face actual-face line-checked column-checked)
                :line line-str
                :assert line-assert-str)))

-      (when (and negation (eq actual-face expected-face))
+      (when (and negation (equal actual-face expected-face))
         (ert-fail
          (list (format "Did not expect face %S face on line %d, column %d"
                        actual-face line-checked column-checked)
diff --git a/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js b/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js
new file mode 100644
index 00000000000..9e02d56c633
--- /dev/null
+++ b/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js
@@ -0,0 +1,3 @@
+var abc = function(d) {
+    //  ^ test-face
+};
diff --git a/test/lisp/emacs-lisp/ert-font-lock-tests.el b/test/lisp/emacs-lisp/ert-font-lock-tests.el
index e0ba1e949b2..b0bb8c31c60 100644
--- a/test/lisp/emacs-lisp/ert-font-lock-tests.el
+++ b/test/lisp/emacs-lisp/ert-font-lock-tests.el
@@ -138,13 +138,24 @@ test-line-comment-p--c
                              (forward-line)
                              (should (ert-font-lock--line-comment-p))))

+(ert-deftest test-parse-comments--no-assertion-error ()
+  (let* ((str "
+not_an_assertion
+random_symbol
+"))
+    (with-temp-buffer
+      (insert str)
+      (javascript-mode)
+
+      (should-error (ert-font-lock--parse-comments) :type 'user-error))))
+
 (ert-deftest test-parse-comments--single-line-error ()
   (let* ((str "// ^ face.face1"))
     (with-temp-buffer
       (insert str)
       (javascript-mode)

-      (should-error (ert-font-lock--parse-comments)))))
+      (should-error (ert-font-lock--parse-comments) :type 'user-error))))

 (ert-deftest test-parse-comments--single-line-single-caret ()
   (let* ((str "
@@ -159,7 +170,46 @@ test-parse-comments--single-line-single-caret
       (setq asserts (ert-font-lock--parse-comments))
       (should (eql (length asserts) 1))
       (should (equal (car asserts)
-                     '(:line-checked 2 :line-assert 3 :column-checked 3 :face "face.face1" :negation nil))))))
+                     '(:line-checked 2 :line-assert 3 :column-checked 3 :face face.face1 :negation nil))))))
+
+(ert-deftest test-parse-comments--single-line-many-carets ()
+  (let* ((str "
+multiplecarets
+//^^^ ^^ ^ face.face1
+")
+         asserts)
+    (with-temp-buffer
+      (insert str)
+      (javascript-mode)
+
+      (setq asserts (ert-font-lock--parse-comments))
+      (should (eql (length asserts) 6))
+      (should (equal asserts
+                     '((:line-checked 2 :line-assert 3 :column-checked 2 :face face.face1 :negation nil)
+                       (:line-checked 2 :line-assert 3 :column-checked 3 :face face.face1 :negation nil)
+                       (:line-checked 2 :line-assert 3 :column-checked 4 :face face.face1 :negation nil)
+                       (:line-checked 2 :line-assert 3 :column-checked 6 :face face.face1 :negation nil)
+                       (:line-checked 2 :line-assert 3 :column-checked 7 :face face.face1 :negation nil)
+                       (:line-checked 2 :line-assert 3 :column-checked 9 :face face.face1 :negation nil)))))))
+
+(ert-deftest test-parse-comments--face-list ()
+  (let* ((str "
+facelist
+// ^ (face1 face2)
+// ^ !(face3 face4)
+// ^ (face5)
+")
+         asserts)
+    (with-temp-buffer
+      (insert str)
+      (javascript-mode)
+
+      (setq asserts (ert-font-lock--parse-comments))
+      (should (eql (length asserts) 3))
+      (should (equal asserts
+                     '((:line-checked 2 :line-assert 3 :column-checked 3 :face (face1 face2) :negation nil)
+                       (:line-checked 2 :line-assert 4 :column-checked 3 :face (face3 face4) :negation t)
+                       (:line-checked 2 :line-assert 5 :column-checked 3 :face (face5) :negation nil)))))))

 (ert-deftest test-parse-comments--caret-negation ()
   (let* ((str "
@@ -175,11 +225,11 @@ test-parse-comments--caret-negation
       (setq asserts (ert-font-lock--parse-comments))
       (should (eql (length asserts) 2))
       (should (equal asserts
-                     '((:line-checked 2 :line-assert 3 :column-checked 3 :face "face" :negation t)
-                       (:line-checked 2 :line-assert 4 :column-checked 3 :face "face" :negation nil)))))))
+                     '((:line-checked 2 :line-assert 3 :column-checked 3 :face face :negation t)
+                       (:line-checked 2 :line-assert 4 :column-checked 3 :face face :negation nil)))))))


-(ert-deftest test-parse-comments--single-line-multiple-carets ()
+(ert-deftest test-parse-comments--single-line-multiple-assert-lines ()
   (let* ((str "
 first
 // ^ face1
@@ -196,12 +246,12 @@ test-parse-comments--single-line-multiple-carets
       (setq asserts (ert-font-lock--parse-comments))
       (should (eql (length asserts) 4))
       (should (equal asserts
-                     '((:line-checked 2 :line-assert 3 :column-checked 3 :face "face1" :negation nil)
-                       (:line-checked 2 :line-assert 4 :column-checked 7 :face "face.face2" :negation nil)
-                       (:line-checked 2 :line-assert 5 :column-checked 7 :face "face-face.face3" :negation nil)
-                       (:line-checked 2 :line-assert 6 :column-checked 7 :face "face_face.face4" :negation nil)))))))
+                     '((:line-checked 2 :line-assert 3 :column-checked 3 :face face1 :negation nil)
+                       (:line-checked 2 :line-assert 4 :column-checked 7 :face face.face2 :negation nil)
+                       (:line-checked 2 :line-assert 5 :column-checked 7 :face face-face.face3 :negation nil)
+                       (:line-checked 2 :line-assert 6 :column-checked 7 :face face_face.face4 :negation nil)))))))

-(ert-deftest test-parse-comments--multiple-line-multiple-carets ()
+(ert-deftest test-parse-comments--multiple-line-multiple-assert-lines ()
   (let* ((str "
 first
 // ^ face1
@@ -218,9 +268,9 @@ test-parse-comments--multiple-line-multiple-carets
       (setq asserts (ert-font-lock--parse-comments))
       (should (eql (length asserts) 3))
       (should (equal asserts
-                     '((:line-checked 2  :line-assert 3 :column-checked 3 :face "face1" :negation nil)
-                       (:line-checked 4  :line-assert 5 :column-checked 3 :face "face2" :negation nil)
-                       (:line-checked 4  :line-assert 6 :column-checked 5 :face "face3" :negation nil)))))))
+                     '((:line-checked 2  :line-assert 3 :column-checked 3 :face face1 :negation nil)
+                       (:line-checked 4  :line-assert 5 :column-checked 3 :face face2 :negation nil)
+                       (:line-checked 4  :line-assert 6 :column-checked 5 :face face3 :negation nil)))))))


 (ert-deftest test-parse-comments--arrow-single-line-single ()
@@ -236,7 +286,7 @@ test-parse-comments--arrow-single-line-single
       (setq asserts (ert-font-lock--parse-comments))
       (should (eql (length asserts) 1))
       (should (equal (car asserts)
-                     '(:line-checked 2 :line-assert 3 :column-checked 0 :face "face1" :negation nil))))))
+                     '(:line-checked 2 :line-assert 3 :column-checked 0 :face face1 :negation nil))))))


 (ert-deftest test-parse-comments-arrow-multiple-line-single ()
@@ -254,9 +304,9 @@ test-parse-comments-arrow-multiple-line-single
       (setq asserts (ert-font-lock--parse-comments))
       (should (eql (length asserts) 3))
       (should (equal asserts
-                     '((:line-checked 2 :line-assert 3 :column-checked 0 :face "face1" :negation nil)
-                       (:line-checked 2 :line-assert 4 :column-checked 2 :face "face2" :negation nil)
-                       (:line-checked 2 :line-assert 5 :column-checked 4 :face "face3" :negation nil)))))))
+                     '((:line-checked 2 :line-assert 3 :column-checked 0 :face face1 :negation nil)
+                       (:line-checked 2 :line-assert 4 :column-checked 2 :face face2 :negation nil)
+                       (:line-checked 2 :line-assert 5 :column-checked 4 :face face3 :negation nil)))))))

 (ert-deftest test-parse-comments--non-assert-comment-single ()
   (let* ((str "
@@ -271,7 +321,7 @@ test-parse-comments--non-assert-comment-single
       (setq asserts (ert-font-lock--parse-comments))
       (should (eql (length asserts) 1))
       (should (equal (car asserts)
-                     '(:line-checked 2 :line-assert 3 :column-checked 4 :face "comment-face" :negation nil))))))
+                     '(:line-checked 2 :line-assert 3 :column-checked 4 :face comment-face :negation nil))))))

 (ert-deftest test-parse-comments--non-assert-comment-multiple ()
   (let* ((str "
@@ -288,9 +338,9 @@ test-parse-comments--non-assert-comment-multiple
       (setq asserts (ert-font-lock--parse-comments))
       (should (eql (length asserts) 3))
       (should (equal asserts
-                     '((:line-checked 2 :line-assert 3 :column-checked 4 :face "comment-face" :negation nil)
-                       (:line-checked 2 :line-assert 4 :column-checked 10 :face "comment-face" :negation nil)
-                       (:line-checked 2 :line-assert 5 :column-checked 18 :face "comment-face" :negation nil)))))))
+                     '((:line-checked 2 :line-assert 3 :column-checked 4 :face comment-face :negation nil)
+                       (:line-checked 2 :line-assert 4 :column-checked 10 :face comment-face :negation nil)
+                       (:line-checked 2 :line-assert 5 :column-checked 18 :face comment-face :negation nil)))))))


 (ert-deftest test-parse-comments--multiline-comment-single ()
@@ -308,7 +358,7 @@ test-parse-comments--multiline-comment-single
       (setq asserts (ert-font-lock--parse-comments))
       (should (eql (length asserts) 1))
       (should (equal (car asserts)
-                     '(:line-checked 3 :line-assert 4 :column-checked 3 :face "comment-face" :negation nil))))))
+                     '(:line-checked 3 :line-assert 4 :column-checked 3 :face comment-face :negation nil))))))

 (ert-deftest test-parse-comments--multiline-comment-multiple ()
   (let* ((str "
@@ -327,13 +377,31 @@ test-parse-comments--multiline-comment-multiple
       (setq asserts (ert-font-lock--parse-comments))
       (should (eql (length asserts) 2))
       (should (equal asserts
-                     '((:line-checked 3 :line-assert 4 :column-checked 3 :face "comment-face" :negation nil)
-                       (:line-checked 5 :line-assert 6 :column-checked 4 :face "comment-face" :negation nil)))))))
+                     '((:line-checked 3 :line-assert 4 :column-checked 3 :face comment-face :negation nil)
+                       (:line-checked 5 :line-assert 6 :column-checked 4 :face comment-face :negation nil)))))))

 ;;; Syntax highlighting assertion tests
 ;;

-(ert-deftest test-syntax-highlight-inline--caret-multiple-faces ()
+(ert-deftest test-syntax-highlight-inline--face-list ()
+  (let ((str "
+var abc = function(d) {
+//   ^ (test-face-2 test-face-1 font-lock-variable-name-face)
+};
+
+"))
+    (with-temp-buffer
+      (insert str)
+      (javascript-mode)
+      (font-lock-ensure)
+
+      (add-face-text-property (point-min) (point-max) 'test-face-1)
+      (add-face-text-property (point-min) (point-max) 'test-face-2)
+
+      (ert-font-lock--check-faces
+       (ert-font-lock--parse-comments)))))
+
+(ert-deftest test-syntax-highlight-inline--caret-multiple-assertions ()
   (let ((str "
 var abc = function(d) {
 //   ^ font-lock-variable-name-face
@@ -455,6 +523,12 @@ test-macro-test--file
   javascript-mode
   "correct.js")

+(ert-font-lock-deftest-file test-macro-test--file-no-asserts
+    "Check failing on files without assertions"
+  :expected-result :failed
+  javascript-mode
+  "no-asserts.js")
+
 (ert-font-lock-deftest-file test-macro-test--file-failing
     "Test reading wrong assertions from a file"
   :expected-result :failed
--
2.34.1