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

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

[Troy Brown]

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.

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

[Vladimir Kazanov]

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

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

[Vladimir Kazanov]

[-- 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

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

[Troy Brown]

Hi Vlad, sorry for the delayed response.

I haven't pushed my change which uses this package yet, as I was
struggling to get it working and didn't want to push failing tests.  I
just discovered the package and was working on a regression test for a
bug fix involving font locking.  This seemed like the perfect reason
to use your package.  At the moment I only have this one
work-in-progress test, but I expect to use it more going forward.

I did check out your patch and for my immediate needs, it worked
perfectly.  Thanks!  Additionally, I did experiment a little with the
multi-caret functionality, which is nice as I have a use for that.  I
also experimented with the negation functionality (although I don't
have an immediate need for that), and did notice a couple things.  The
first was that the assertion would be ignored if there was a space
between the negation symbol and the face.  Also, if the actual and
expected faces didn't match and the negation flag was being used, it
acted like the negation was not indicated at all and failed the test.
I've included a diff below containing the changes I made which seemed
to address those concerns.

diff --git a/lisp/emacs-lisp/ert-font-lock.el b/lisp/emacs-lisp/ert-font-lock.el
index 06c90add9d3..1a5fe96fb09 100644
--- a/lisp/emacs-lisp/ert-font-lock.el
+++ b/lisp/emacs-lisp/ert-font-lock.el
@@ -61,6 +61,7 @@ ert-font-lock--assertion-line-re
    (group (zero-or-more (seq "^" (zero-or-more whitespace))))
    ;; optional negation of the face specification
    (group (optional "!"))
+   (zero-or-more whitespace)
    ;; 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))))
@@ -354,7 +355,7 @@ ert-font-lock--check-faces
       (when (symbolp expected-face)
         (setq expected-face (list expected-face)))

-      (when (not (equal actual-face expected-face))
+      (when (and (not negation) (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)


Thanks,

Troy.

On Tue, Mar 12, 2024 at 4:47 PM Vladimir Kazanov <vekazanov@gmail.com> wrote:
>
> 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

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

[Vladimir Kazanov]

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

Thanks a lot!

The suggestions really do make sense.

Here's the final integrated patch, complete with updated tests and
docs. If you're fine with it then I'll ask somebody to install it on
master.

PS I've got to write an additional announcement in the main mailing
list inviting people to check the updated version out.

On Wed, 13 Mar 2024 at 16:14, Troy Brown <brownts@troybrown.dev> wrote:
>
> Hi Vlad, sorry for the delayed response.
>
> I haven't pushed my change which uses this package yet, as I was
> struggling to get it working and didn't want to push failing tests.  I
> just discovered the package and was working on a regression test for a
> bug fix involving font locking.  This seemed like the perfect reason
> to use your package.  At the moment I only have this one
> work-in-progress test, but I expect to use it more going forward.
>
> I did check out your patch and for my immediate needs, it worked
> perfectly.  Thanks!  Additionally, I did experiment a little with the
> multi-caret functionality, which is nice as I have a use for that.  I
> also experimented with the negation functionality (although I don't
> have an immediate need for that), and did notice a couple things.  The
> first was that the assertion would be ignored if there was a space
> between the negation symbol and the face.  Also, if the actual and
> expected faces didn't match and the negation flag was being used, it
> acted like the negation was not indicated at all and failed the test.
> I've included a diff below containing the changes I made which seemed
> to address those concerns.
>
> diff --git a/lisp/emacs-lisp/ert-font-lock.el b/lisp/emacs-lisp/ert-font-lock.el
> index 06c90add9d3..1a5fe96fb09 100644
> --- a/lisp/emacs-lisp/ert-font-lock.el
> +++ b/lisp/emacs-lisp/ert-font-lock.el
> @@ -61,6 +61,7 @@ ert-font-lock--assertion-line-re
>     (group (zero-or-more (seq "^" (zero-or-more whitespace))))
>     ;; optional negation of the face specification
>     (group (optional "!"))
> +   (zero-or-more whitespace)
>     ;; 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))))
> @@ -354,7 +355,7 @@ ert-font-lock--check-faces
>        (when (symbolp expected-face)
>          (setq expected-face (list expected-face)))
>
> -      (when (not (equal actual-face expected-face))
> +      (when (and (not negation) (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)
>
>
> Thanks,
>
> Troy.
>
> On Tue, Mar 12, 2024 at 4:47 PM Vladimir Kazanov <vekazanov@gmail.com> wrote:
> >
> > 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



-- 
Regards,

Vladimir Kazanov

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

From 17474f4aa187034ff697e641f6979bc6f49a31d9 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.
* doc/misc/ert.texi: Update documentation.
---
 doc/misc/ert.texi                             |  29 +++-
 lisp/emacs-lisp/ert-font-lock.el              |  73 ++++++++--
 .../ert-font-lock-resources/no-asserts.js     |   2 +
 test/lisp/emacs-lisp/ert-font-lock-tests.el   | 137 ++++++++++++++----
 4 files changed, 198 insertions(+), 43 deletions(-)
 create mode 100644 test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js

diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi
index bd2ad495142..f555414bf8f 100644
--- a/doc/misc/ert.texi
+++ b/doc/misc/ert.texi
@@ -951,11 +951,13 @@ Syntax Highlighting Tests
 @code{ert-font-lock} package makes it possible to introduce unit tests
 checking face assignment.  Test assertions are included in code-level
 comments directly and can be read either from inline strings or files.
+The parser expects input string to contain at least one assertion.

 Test assertion parser extracts tests from comment-only lines.  Every
-comment assertion line starts either with a caret (@samp{^}) or an
-arrow (@samp{<-}).  A caret/arrow should be followed immediately by the
-name of a face to be checked.
+comment assertion line starts either with a caret (@samp{^}) or an arrow
+(@samp{<-}).  A single caret/arrow or carets should be followed
+immediately by the name of a face or a list of faces to be checked
+against the @code{:face} property at point.

 The test then checks if the first non-assertion column above the caret
 contains a face expected by the assertion:
@@ -967,6 +969,27 @@ Syntax Highlighting Tests
 //               ^ font-lock-punctuation-face
 // this is not an assertion, it's just a comment
 //   ^ font-lock-comment-face
+
+// multiple carets per line
+// ^^^^     ^    ^ font-lock-comment-face
+@end example
+
+Both symbol-only @code{:face} property values and assertion face values
+are normalized to single element lists so assertions below are
+equivalent:
+
+@example
+// single
+// ^ font-lock-comment-face
+// single
+// ^ (font-lock-comment-face)
+@end example
+
+It is possible to specify face lists:
+
+@example
+// TODO
+// ^^^^ (font-lock-comment-face hl-todo)
 @end example

 The arrow means that the first non-empty column of the assertion line
diff --git a/lisp/emacs-lisp/ert-font-lock.el b/lisp/emacs-lisp/ert-font-lock.el
index 29114712f92..e2325637929 100644
--- a/lisp/emacs-lisp/ert-font-lock.el
+++ b/lisp/emacs-lisp/ert-font-lock.el
@@ -39,16 +39,33 @@
 (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.")
+   (zero-or-more whitespace)
+   ;; 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 +229,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 +269,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 +283,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 +341,30 @@ 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)))
+
+      ;; fail when lists are not 'equal and the assertion is *not negated*
+      (when (and (not negation) (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))
+      ;; fail when lists are 'equal and the assertion is *negated*
+      (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..5eae9af212f
--- /dev/null
+++ b/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js
@@ -0,0 +1,2 @@
+var abc = function(d) {
+};
diff --git a/test/lisp/emacs-lisp/ert-font-lock-tests.el b/test/lisp/emacs-lisp/ert-font-lock-tests.el
index e0ba1e949b2..0469a5c7490 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
@@ -364,6 +432,19 @@ test-syntax-highlight-inline--caret-wrong-face
       (should-error (ert-font-lock--check-faces
                      (ert-font-lock--parse-comments))))))

+(ert-deftest test-syntax-highlight-inline--caret-negated-wrong-face ()
+  (let* ((str "
+var abc = function(d) {
+//   ^ !not-a-face
+};
+"))
+    (with-temp-buffer
+      (insert str)
+      (javascript-mode)
+      (font-lock-ensure)
+
+      (ert-font-lock--check-faces
+       (ert-font-lock--parse-comments)))))

 (ert-deftest test-syntax-highlight-inline--comment-face ()
   (let* ((str "
@@ -455,6 +536,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

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

[Troy Brown]

The new patch looks good to me.

One other thing I thought I'd mention.  I have places in my test where
I want to verify that there is no font lock face.  I've been able to
specify "nil" for the face and that works perfectly to check this.  I
thought I'd mention this because I wasn't sure if it was intentional
behavior, but I do find that useful.


Thanks,

Troy.

On Wed, Mar 13, 2024 at 1:04 PM Vladimir Kazanov <vekazanov@gmail.com> wrote:
>
> Thanks a lot!
>
> The suggestions really do make sense.
>
> Here's the final integrated patch, complete with updated tests and
> docs. If you're fine with it then I'll ask somebody to install it on
> master.
>
> PS I've got to write an additional announcement in the main mailing
> list inviting people to check the updated version out.
>
> On Wed, 13 Mar 2024 at 16:14, Troy Brown <brownts@troybrown.dev> wrote:
> >
> > Hi Vlad, sorry for the delayed response.
> >
> > I haven't pushed my change which uses this package yet, as I was
> > struggling to get it working and didn't want to push failing tests.  I
> > just discovered the package and was working on a regression test for a
> > bug fix involving font locking.  This seemed like the perfect reason
> > to use your package.  At the moment I only have this one
> > work-in-progress test, but I expect to use it more going forward.
> >
> > I did check out your patch and for my immediate needs, it worked
> > perfectly.  Thanks!  Additionally, I did experiment a little with the
> > multi-caret functionality, which is nice as I have a use for that.  I
> > also experimented with the negation functionality (although I don't
> > have an immediate need for that), and did notice a couple things.  The
> > first was that the assertion would be ignored if there was a space
> > between the negation symbol and the face.  Also, if the actual and
> > expected faces didn't match and the negation flag was being used, it
> > acted like the negation was not indicated at all and failed the test.
> > I've included a diff below containing the changes I made which seemed
> > to address those concerns.
> >
> > diff --git a/lisp/emacs-lisp/ert-font-lock.el b/lisp/emacs-lisp/ert-font-lock.el
> > index 06c90add9d3..1a5fe96fb09 100644
> > --- a/lisp/emacs-lisp/ert-font-lock.el
> > +++ b/lisp/emacs-lisp/ert-font-lock.el
> > @@ -61,6 +61,7 @@ ert-font-lock--assertion-line-re
> >     (group (zero-or-more (seq "^" (zero-or-more whitespace))))
> >     ;; optional negation of the face specification
> >     (group (optional "!"))
> > +   (zero-or-more whitespace)
> >     ;; 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))))
> > @@ -354,7 +355,7 @@ ert-font-lock--check-faces
> >        (when (symbolp expected-face)
> >          (setq expected-face (list expected-face)))
> >
> > -      (when (not (equal actual-face expected-face))
> > +      (when (and (not negation) (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)
> >
> >
> > Thanks,
> >
> > Troy.
> >
> > On Tue, Mar 12, 2024 at 4:47 PM Vladimir Kazanov <vekazanov@gmail.com> wrote:
> > >
> > > 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
>
>
>
> --
> Regards,
>
> Vladimir Kazanov

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

[Vladimir Kazanov]

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

Yeah, this is unintentional but I like it. "nil" is happily parsed by
both the (read) call and the guarding regex.

There's a little thing that needs to be fixed - avoid turning 'nil
into '(nil) when comparing lists. It works but for the wrong reason.
Anyway, I'll update the docs to suggest using nil and !nil in
assertions, and also add a test.

The patch looks ready. I'll wait for a few days and if nobody notices
I will give the maintainers a shout.


On Wed, 13 Mar 2024 at 17:49, Troy Brown <brownts@troybrown.dev> wrote:
>
> The new patch looks good to me.
>
> One other thing I thought I'd mention.  I have places in my test where
> I want to verify that there is no font lock face.  I've been able to
> specify "nil" for the face and that works perfectly to check this.  I
> thought I'd mention this because I wasn't sure if it was intentional
> behavior, but I do find that useful.
>
>
> Thanks,
>
> Troy.
>
> On Wed, Mar 13, 2024 at 1:04 PM Vladimir Kazanov <vekazanov@gmail.com> wrote:
> >
> > Thanks a lot!
> >
> > The suggestions really do make sense.
> >
> > Here's the final integrated patch, complete with updated tests and
> > docs. If you're fine with it then I'll ask somebody to install it on
> > master.
> >
> > PS I've got to write an additional announcement in the main mailing
> > list inviting people to check the updated version out.
> >
> > On Wed, 13 Mar 2024 at 16:14, Troy Brown <brownts@troybrown.dev> wrote:
> > >
> > > Hi Vlad, sorry for the delayed response.
> > >
> > > I haven't pushed my change which uses this package yet, as I was
> > > struggling to get it working and didn't want to push failing tests.  I
> > > just discovered the package and was working on a regression test for a
> > > bug fix involving font locking.  This seemed like the perfect reason
> > > to use your package.  At the moment I only have this one
> > > work-in-progress test, but I expect to use it more going forward.
> > >
> > > I did check out your patch and for my immediate needs, it worked
> > > perfectly.  Thanks!  Additionally, I did experiment a little with the
> > > multi-caret functionality, which is nice as I have a use for that.  I
> > > also experimented with the negation functionality (although I don't
> > > have an immediate need for that), and did notice a couple things.  The
> > > first was that the assertion would be ignored if there was a space
> > > between the negation symbol and the face.  Also, if the actual and
> > > expected faces didn't match and the negation flag was being used, it
> > > acted like the negation was not indicated at all and failed the test.
> > > I've included a diff below containing the changes I made which seemed
> > > to address those concerns.
> > >
> > > diff --git a/lisp/emacs-lisp/ert-font-lock.el b/lisp/emacs-lisp/ert-font-lock.el
> > > index 06c90add9d3..1a5fe96fb09 100644
> > > --- a/lisp/emacs-lisp/ert-font-lock.el
> > > +++ b/lisp/emacs-lisp/ert-font-lock.el
> > > @@ -61,6 +61,7 @@ ert-font-lock--assertion-line-re
> > >     (group (zero-or-more (seq "^" (zero-or-more whitespace))))
> > >     ;; optional negation of the face specification
> > >     (group (optional "!"))
> > > +   (zero-or-more whitespace)
> > >     ;; 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))))
> > > @@ -354,7 +355,7 @@ ert-font-lock--check-faces
> > >        (when (symbolp expected-face)
> > >          (setq expected-face (list expected-face)))
> > >
> > > -      (when (not (equal actual-face expected-face))
> > > +      (when (and (not negation) (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)
> > >
> > >
> > > Thanks,
> > >
> > > Troy.
> > >
> > > On Tue, Mar 12, 2024 at 4:47 PM Vladimir Kazanov <vekazanov@gmail.com> wrote:
> > > >
> > > > 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
> >
> >
> >
> > --
> > Regards,
> >
> > Vladimir Kazanov



-- 
Regards,

Vladimir Kazanov

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

From 402688f227eb786fe81ad3799f97b51cd6f7a693 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.
* doc/misc/ert.texi: Update documentation.
---
 doc/misc/ert.texi                             |  45 +++++-
 lisp/emacs-lisp/ert-font-lock.el              |  73 +++++++--
 .../ert-font-lock-resources/no-asserts.js     |   2 +
 test/lisp/emacs-lisp/ert-font-lock-tests.el   | 153 +++++++++++++++---
 4 files changed, 228 insertions(+), 45 deletions(-)
 create mode 100644 test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js

diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi
index bd2ad495142..8767de71496 100644
--- a/doc/misc/ert.texi
+++ b/doc/misc/ert.texi
@@ -951,11 +951,13 @@ Syntax Highlighting Tests
 @code{ert-font-lock} package makes it possible to introduce unit tests
 checking face assignment.  Test assertions are included in code-level
 comments directly and can be read either from inline strings or files.
+The parser expects the input string to contain at least one assertion.

 Test assertion parser extracts tests from comment-only lines.  Every
-comment assertion line starts either with a caret (@samp{^}) or an
-arrow (@samp{<-}).  A caret/arrow should be followed immediately by the
-name of a face to be checked.
+comment assertion line starts either with a caret (@samp{^}) or an arrow
+(@samp{<-}).  A single caret/arrow or carets should be followed
+immediately by the name of a face or a list of faces to be checked
+against the @code{:face} property at point.

 The test then checks if the first non-assertion column above the caret
 contains a face expected by the assertion:
@@ -967,10 +969,43 @@ Syntax Highlighting Tests
 //               ^ font-lock-punctuation-face
 // this is not an assertion, it's just a comment
 //   ^ font-lock-comment-face
+
+// multiple carets per line
+// ^^^^     ^    ^ font-lock-comment-face
+@end example
+
+Both symbol-only @code{:face} property values and assertion face values
+are normalized to single element lists so assertions below are
+equivalent:
+
+@example
+// single
+// ^ font-lock-comment-face
+// single
+// ^ (font-lock-comment-face)
+@end example
+
+Assertions can be negated:
+
+@example
+var variable = 11;
+//  ^ !font-lock-comment-face
+@end example
+
+It is possible to specify face lists in assertions:
+
+@example
+// TODO
+// ^^^^ (font-lock-comment-face hl-todo)
+     var test = 1;
+// ^    ()
+// ^    nil
+//   negation works as expected
+//   ^  !nil
 @end example

-The arrow means that the first non-empty column of the assertion line
-will be used for the check:
+The arrow (@samp{<-}) means that the first non-empty column of the
+assertion line will be used for the check:

 @example
 var variable = 1;
diff --git a/lisp/emacs-lisp/ert-font-lock.el b/lisp/emacs-lisp/ert-font-lock.el
index 29114712f92..e77c8945dc3 100644
--- a/lisp/emacs-lisp/ert-font-lock.el
+++ b/lisp/emacs-lisp/ert-font-lock.el
@@ -39,16 +39,33 @@
 (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.")
+   (zero-or-more whitespace)
+   ;; 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 +229,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 +269,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 +283,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 +341,30 @@ 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, nils or lists of symbols
+      (when (not (listp actual-face))
+        (setq actual-face (list actual-face)))
+      (when (not (listp expected-face))
+        (setq expected-face (list expected-face)))
+
+      ;; fail when lists are not 'equal and the assertion is *not negated*
+      (when (and (not negation) (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))
+      ;; fail when lists are 'equal and the assertion is *negated*
+      (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..5eae9af212f
--- /dev/null
+++ b/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js
@@ -0,0 +1,2 @@
+var abc = function(d) {
+};
diff --git a/test/lisp/emacs-lisp/ert-font-lock-tests.el b/test/lisp/emacs-lisp/ert-font-lock-tests.el
index e0ba1e949b2..fa2e5dc4db7 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,47 @@ 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--nil-list ()
+  (let ((str "
+var abc = function(d) {
+// ^ nil
+//   ^ !nil
+};
+
+"))
+    (with-temp-buffer
+      (insert str)
+      (javascript-mode)
+      (font-lock-ensure)
+
+      (ert-font-lock--check-faces
+       (ert-font-lock--parse-comments)))))
+
+(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
@@ -364,6 +448,19 @@ test-syntax-highlight-inline--caret-wrong-face
       (should-error (ert-font-lock--check-faces
                      (ert-font-lock--parse-comments))))))

+(ert-deftest test-syntax-highlight-inline--caret-negated-wrong-face ()
+  (let* ((str "
+var abc = function(d) {
+//   ^ !not-a-face
+};
+"))
+    (with-temp-buffer
+      (insert str)
+      (javascript-mode)
+      (font-lock-ensure)
+
+      (ert-font-lock--check-faces
+       (ert-font-lock--parse-comments)))))

 (ert-deftest test-syntax-highlight-inline--comment-face ()
   (let* ((str "
@@ -455,6 +552,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

bug#69714: [PATCH] Improve ert-font-lock assertion parser (Bug#69714)

[Vladimir Kazanov]

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

Dear maintainers,

I've come up with a number of improvements for ert-font-lock as
requested in Bug#69714 (which can be closed now).

The attached patch provides the fix, more unit tests and updated
documentation. I don't think we need to update NEWS as ert-font-lock
was announced there already.

Thank you

-- 
Regards,

Vladimir Kazanov

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

From 22dea1ee6bf6563047bc5b757e15843a3be1328a 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
(test-parse-comments--no-assertion-error)
(test-syntax-highlight-inline--caret-negated-wrong-face)
(test-macro-test--file-no-asserts): New test cases.
* doc/misc/ert.texi (Syntax Highlighting Tests): More syntax examples.
---
 doc/misc/ert.texi                             |  45 +++++-
 lisp/emacs-lisp/ert-font-lock.el              |  73 +++++++--
 .../ert-font-lock-resources/no-asserts.js     |   2 +
 test/lisp/emacs-lisp/ert-font-lock-tests.el   | 153 +++++++++++++++---
 4 files changed, 228 insertions(+), 45 deletions(-)
 create mode 100644 test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js

diff --git a/doc/misc/ert.texi b/doc/misc/ert.texi
index bd2ad495142..8767de71496 100644
--- a/doc/misc/ert.texi
+++ b/doc/misc/ert.texi
@@ -951,11 +951,13 @@ Syntax Highlighting Tests
 @code{ert-font-lock} package makes it possible to introduce unit tests
 checking face assignment.  Test assertions are included in code-level
 comments directly and can be read either from inline strings or files.
+The parser expects the input string to contain at least one assertion.

 Test assertion parser extracts tests from comment-only lines.  Every
-comment assertion line starts either with a caret (@samp{^}) or an
-arrow (@samp{<-}).  A caret/arrow should be followed immediately by the
-name of a face to be checked.
+comment assertion line starts either with a caret (@samp{^}) or an arrow
+(@samp{<-}).  A single caret/arrow or carets should be followed
+immediately by the name of a face or a list of faces to be checked
+against the @code{:face} property at point.

 The test then checks if the first non-assertion column above the caret
 contains a face expected by the assertion:
@@ -967,10 +969,43 @@ Syntax Highlighting Tests
 //               ^ font-lock-punctuation-face
 // this is not an assertion, it's just a comment
 //   ^ font-lock-comment-face
+
+// multiple carets per line
+// ^^^^     ^    ^ font-lock-comment-face
+@end example
+
+Both symbol-only @code{:face} property values and assertion face values
+are normalized to single element lists so assertions below are
+equivalent:
+
+@example
+// single
+// ^ font-lock-comment-face
+// single
+// ^ (font-lock-comment-face)
+@end example
+
+Assertions can be negated:
+
+@example
+var variable = 11;
+//  ^ !font-lock-comment-face
+@end example
+
+It is possible to specify face lists in assertions:
+
+@example
+// TODO
+// ^^^^ (font-lock-comment-face hl-todo)
+     var test = 1;
+// ^    ()
+// ^    nil
+//   negation works as expected
+//   ^  !nil
 @end example

-The arrow means that the first non-empty column of the assertion line
-will be used for the check:
+The arrow (@samp{<-}) means that the first non-empty column of the
+assertion line will be used for the check:

 @example
 var variable = 1;
diff --git a/lisp/emacs-lisp/ert-font-lock.el b/lisp/emacs-lisp/ert-font-lock.el
index 29114712f92..e77c8945dc3 100644
--- a/lisp/emacs-lisp/ert-font-lock.el
+++ b/lisp/emacs-lisp/ert-font-lock.el
@@ -39,16 +39,33 @@
 (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.")
+   (zero-or-more whitespace)
+   ;; 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 +229,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 +269,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 +283,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 +341,30 @@ 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, nils or lists of symbols
+      (when (not (listp actual-face))
+        (setq actual-face (list actual-face)))
+      (when (not (listp expected-face))
+        (setq expected-face (list expected-face)))
+
+      ;; fail when lists are not 'equal and the assertion is *not negated*
+      (when (and (not negation) (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))
+      ;; fail when lists are 'equal and the assertion is *negated*
+      (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..5eae9af212f
--- /dev/null
+++ b/test/lisp/emacs-lisp/ert-font-lock-resources/no-asserts.js
@@ -0,0 +1,2 @@
+var abc = function(d) {
+};
diff --git a/test/lisp/emacs-lisp/ert-font-lock-tests.el b/test/lisp/emacs-lisp/ert-font-lock-tests.el
index e0ba1e949b2..fa2e5dc4db7 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,47 @@ 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--nil-list ()
+  (let ((str "
+var abc = function(d) {
+// ^ nil
+//   ^ !nil
+};
+
+"))
+    (with-temp-buffer
+      (insert str)
+      (javascript-mode)
+      (font-lock-ensure)
+
+      (ert-font-lock--check-faces
+       (ert-font-lock--parse-comments)))))
+
+(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
@@ -364,6 +448,19 @@ test-syntax-highlight-inline--caret-wrong-face
       (should-error (ert-font-lock--check-faces
                      (ert-font-lock--parse-comments))))))

+(ert-deftest test-syntax-highlight-inline--caret-negated-wrong-face ()
+  (let* ((str "
+var abc = function(d) {
+//   ^ !not-a-face
+};
+"))
+    (with-temp-buffer
+      (insert str)
+      (javascript-mode)
+      (font-lock-ensure)
+
+      (ert-font-lock--check-faces
+       (ert-font-lock--parse-comments)))))

 (ert-deftest test-syntax-highlight-inline--comment-face ()
   (let* ((str "
@@ -455,6 +552,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

bug#69714: [PATCH] Improve ert-font-lock assertion parser (Bug#69714)

[Eli Zaretskii]

> From: Vladimir Kazanov <vekazanov@gmail.com>
> Date: Fri, 15 Mar 2024 11:47:27 +0000
> 
> I've come up with a number of improvements for ert-font-lock as
> requested in Bug#69714 (which can be closed now).
> 
> The attached patch provides the fix, more unit tests and updated
> documentation. I don't think we need to update NEWS as ert-font-lock
> was announced there already.

Thanks, installed on master, and closing the bug.

bug#69714: [PATCH] Improve ert-font-lock assertion parser

[Mattias Engdegård]

Vladimir, thank you for your patch. However, this regexp:

> (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.")

is rather inefficient. (Relint complained about it, which is why I am here).

The problem is that

      (one-or-more
       (seq (one-or-more (or alphanumeric "-" "_" "."))
            (* whitespace)))

can match a string that consists of alphanumeric characters, say, in many different ways because of the nested `one-or-more`; the (* whitespace) can match the empty string anywhere.
Try, for instance:

  (string-match ert-font-lock--face-symbol-list-re
                (concat "(" (make-string 20 ?a)))

which should return nil as it doesn't match.
Now try raising the number from 20 to 25, then 30.

If you want the regexp to match a list of one or more symbols, what about this:

  (rx "("
      (* whitespace)
      (regexp ert-font-lock--face-symbol-re)
      (* (+ whitespace)
         (regexp ert-font-lock--face-symbol-re))
      ")")

bug#69714: [PATCH] Improve ert-font-lock assertion parser

[Vladimir Kazanov]

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

Hi Mattias,

Thanks for noticing this!

> If you want the regexp to match a list of one or more symbols, what about this:
>
>   (rx "("
>       (* whitespace)
>       (regexp ert-font-lock--face-symbol-re)
>       (* (+ whitespace)
>          (regexp ert-font-lock--face-symbol-re))
>       ")")
>

Got it, thanks. I forgot about relint! Regex performance is easy to
get wrong. I'd really like peg.el to be merged and used for this kind
of parsing.

Anyway, can you please take a look at the patch? It fixes the problem
noticed by relint as well as a couple of other minor things, and adds
tests to make sure regexes work the way I want them to.

Thank you
Vlad


-- 
Regards,

Vladimir Kazanov

[-- Attachment #2: v1-0001-Fix-symbol-list-matching-regexps.patch --]
[-- Type: text/x-patch, Size: 4976 bytes --]

From 8954a00b3f4710bd5e13ba7f1aff5c8f20da730e Mon Sep 17 00:00:00 2001
From: Vladimir Kazanov <vekazanov@gmail.com>
Date: Sun, 31 Mar 2024 18:32:59 +0100
Subject: [PATCH v1] Fix symbol list matching regexps.
Fix symbol list matching regexp performance

Allow empty face lists, improve the face list matching regexp (see
discussion in Bug#69714) based on relint's comments, add tests:
* test/lisp/emacs-lisp/ert-font-lock-tests.el: Add tests.
* lisp/emacs-lisp/ert-font-lock.el: Fix regexps.

---
 lisp/emacs-lisp/ert-font-lock.el            | 22 ++++++----
 test/lisp/emacs-lisp/ert-font-lock-tests.el | 47 ++++++++++++++++++++-
 2 files changed, 58 insertions(+), 11 deletions(-)

diff --git a/lisp/emacs-lisp/ert-font-lock.el b/lisp/emacs-lisp/ert-font-lock.el
index e77c8945dc3..951caa0aa25 100644
--- a/lisp/emacs-lisp/ert-font-lock.el
+++ b/lisp/emacs-lisp/ert-font-lock.el
@@ -40,30 +40,34 @@
 (require 'pcase)

 (defconst ert-font-lock--face-symbol-re
-  (rx (one-or-more (or alphanumeric "-" "_" ".")))
-  "A face symbol matching regex.")
+  (rx (one-or-more (or alphanumeric "-" "_" "." "/")))
+  "A face symbol matching regex.
+The regexp cannot use character classes as these can be redefined by the
+major mode of the host language.")

 (defconst ert-font-lock--face-symbol-list-re
   (rx "("
       (* whitespace)
-      (one-or-more
-       (seq (regexp ert-font-lock--face-symbol-re)
-            (* whitespace)))
+      (opt (regexp ert-font-lock--face-symbol-re))
+      (zero-or-more
+       (seq (+ whitespace)
+            (regexp ert-font-lock--face-symbol-re)))
+      (* whitespace)
       ")")
   "A face symbol list matching regex.")

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

diff --git a/test/lisp/emacs-lisp/ert-font-lock-tests.el b/test/lisp/emacs-lisp/ert-font-lock-tests.el
index fa2e5dc4db7..33ef2c52288 100644
--- a/test/lisp/emacs-lisp/ert-font-lock-tests.el
+++ b/test/lisp/emacs-lisp/ert-font-lock-tests.el
@@ -44,13 +44,56 @@ with-temp-buffer-str-mode
      (goto-char (point-min))
      ,@body))

+(defun ert-font-lock--wrap-begin-end (re)
+  (concat "^" re "$"))
+
+;;; Regexp tests
+;;;
+
+(ert-deftest test-regexp--face-symbol-re ()
+  (let ((re (ert-font-lock--wrap-begin-end
+             ert-font-lock--face-symbol-re)))
+    (should (string-match-p re "font-lock-keyword-face"))
+    (should (string-match-p re "-face"))
+    (should (string-match-p re "weird-package/-face"))
+    (should (string-match-p re "-"))
+    (should (string-match-p re "font-lock.face"))
+    (should-not (string-match-p re "face suffix-with"))
+    (should-not (string-match-p re "("))))
+
+(ert-deftest test-regexp--face-symbol-list-re ()
+  (let ((re (ert-font-lock--wrap-begin-end
+             ert-font-lock--face-symbol-list-re)))
+    (should (string-match-p re "(face1 face2)"))
+    (should (string-match-p re "(face1)"))
+    (should (string-match-p re "()"))
+    (should-not (string-match-p re ")"))
+    (should-not (string-match-p re "("))))
+
+(ert-deftest test-regexp--assertion-line-re ()
+  (let ((re (ert-font-lock--wrap-begin-end
+             ert-font-lock--assertion-line-re)))
+    (should (string-match-p re "^   something-face"))
+    (should (string-match-p re "^   !something-face"))
+    (should (string-match-p re "^   (face1 face2)"))
+    (should (string-match-p re "^   !(face1 face2)"))
+    (should (string-match-p re "^   ()"))
+    (should (string-match-p re "^   !()"))
+    (should (string-match-p re "^   nil"))
+    (should (string-match-p re "^   !nil"))
+    (should (string-match-p re "<-   something-face"))
+    (should (string-match-p re "<- ^  something-face"))
+    (should (string-match-p re "^^ ^  something-face"))
+    (should (string-match-p re "^     ^something-face"))
+    (should-not (string-match-p re "^   <-  ^something-face"))))
+
 ;;; Comment parsing tests
 ;;

 (ert-deftest test-line-comment-p--fundamental ()
   (with-temp-buffer-str-mode fundamental-mode
-                             "// comment\n"
-                             (should-not (ert-font-lock--line-comment-p))))
+    "// comment\n"
+    (should-not (ert-font-lock--line-comment-p))))

 (ert-deftest test-line-comment-p--emacs-lisp ()
   (with-temp-buffer-str-mode emacs-lisp-mode
--
2.34.1

bug#69714: [PATCH] Improve ert-font-lock assertion parser

[Mattias Engdegård]

31 mars 2024 kl. 19.56 skrev Vladimir Kazanov <vekazanov@gmail.com>:

>    (rx "("
>        (* whitespace)
> -      (one-or-more
> -       (seq (regexp ert-font-lock--face-symbol-re)
> -            (* whitespace)))
> +      (opt (regexp ert-font-lock--face-symbol-re))
> +      (zero-or-more
> +       (seq (+ whitespace)
> +            (regexp ert-font-lock--face-symbol-re)))
> +      (* whitespace)
>        ")")

Since you want to match zero or more symbols, this can be improved further:

   (rx "("
       (* whitespace)
       (* (regexp ert-font-lock--face-symbol-re)
          (+ whitespace)))
       ")")

(Note that most rx operators have an implicit `seq` inside.)

You may want to use ´rx-define` instead of `defconst` as well -- it avoids some use of the `regexp` construct and removes some load-time string building.

bug#69714: [PATCH] Improve ert-font-lock assertion parser

[Mattias Engdegård]

1 apr. 2024 kl. 10.04 skrev Mattias Engdegård <mattias.engdegard@gmail.com>:

>   (rx "("
>       (* whitespace)
>       (* (regexp ert-font-lock--face-symbol-re)
>          (+ whitespace)))
>       ")")

Sorry, that was not very well thought-out, was it? Try

  (rx "("
      (* whitespace)
      (? (regexp ert-font-lock--face-symbol-re)
         (* (+ whitespace)
            (regexp ert-font-lock--face-symbol-re))
         (* whitespace))
      ")")

instead. Not as pretty but should actually work.

bug#69714: [PATCH] Improve ert-font-lock assertion parser

[Vladimir Kazanov]

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

>   (rx "("
>       (* whitespace)
>       (? (regexp ert-font-lock--face-symbol-re)
>          (* (+ whitespace)
>             (regexp ert-font-lock--face-symbol-re))
>          (* whitespace))
>       ")")
>
> instead. Not as pretty but should actually work.
>

Yeah, somewhat cleaner. Added to the patch.

Not sure using rx-define et al makes sense for 3 regular expressions I
need to test directly.

Here's patch v2.

--
Regards,

Vladimir Kazanov

[-- Attachment #2: v2-0001-Fix-symbol-list-matching-regexps.patch --]
[-- Type: application/x-patch, Size: 5064 bytes --]

bug#69714: [PATCH] Improve ert-font-lock assertion parser

[Mattias Engdegård]

1 apr. 2024 kl. 10.34 skrev Vladimir Kazanov <vekazanov@gmail.com>:

> Not sure using rx-define et al makes sense for 3 regular expressions I
> need to test directly.

Well, ert-font-lock--face-symbol-list-re is only used in other regexps. (And in tests, but you can always write `(rx ert-font-lock--face-symbol-list-re)`.)

But it's not very important.

> Here's patch v2.

Looks fine!

bug#69714: [PATCH] Improve ert-font-lock assertion parser

[Vladimir Kazanov]

> Looks fine!

Thanks a lot! Can you install it for me? Or should I wait for Eli to
have time to handle this?

-- 
Regards,

Vladimir Kazanov

bug#69714: [PATCH] Improve ert-font-lock assertion parser

[Mattias Engdegård]

> Can you install it for me?

Certainly, now done.