master cdd7093e17a: Improve ert-font-lock assertion parser (Bug#69714)

[Eli Zaretskii]

branch: master
commit cdd7093e17a33a6efc4721af461af180e5af602d
Author: Vladimir Kazanov <vekazanov@gmail.com>
Commit: Eli Zaretskii <eliz@gnu.org>

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

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 @@ that assigns face properties to parts of the buffer.  The
 @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 @@ var variable = 11;
 //               ^ 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 @@ be used through `ert'.
   (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 @@ be used through `ert'.
           (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 @@ be used through `ert'.
                                      (- (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 @@ The function is meant to be run from within an ERT test."
     (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 @@ print(\"Hello, world!\")"
                              (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 @@ first
       (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 @@ first
       (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 @@ first
       (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 @@ third
       (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 @@ first
       (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 @@ first
       (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 @@ first
       (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 @@ first
       (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 @@ first
       (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 @@ first
       (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 @@ var abc = function(d) {
       (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 @@ var abc = function(d) {
   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