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

From: Vladimir Kazanov <[email-masked]>
Date: Sun, 31 Mar 2024 17:56:38 +0000

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
From 8954a00b3f4710bd5e13ba7f1aff5c8f20da730e Mon Sep 17 00:00:00 2001
From: Vladimir Kazanov <[email-masked]>
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