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