[elpa] externals/xr a49b9b7 4/6: Check for repetition of empty-matching expression

[Mattias Engdegård]

branch: externals/xr
commit a49b9b7f4af99f50e3cbbf678a6aa0a254b2e89e
Author: Mattias Engdegård <address@hidden>
Commit: Mattias Engdegård <address@hidden>

    Check for repetition of empty-matching expression
    
    Add check for repetition of expressions that may match an empty string,
    and repetition of zero-width assertions.
    The former is experimental but seems useful since such expressions can be
    very slow on the backtracking regexp engine in Emacs.
    The latter is just to catch silly mistakes, which it occasionally does.
---
 xr-test.el |  8 ++++++++
 xr.el      | 60 ++++++++++++++++++++++++++++++++++++++++++++++++++----------
 2 files changed, 58 insertions(+), 10 deletions(-)

diff --git a/xr-test.el b/xr-test.el
index ee45bca..82585a0 100644
--- a/xr-test.el
+++ b/xr-test.el
@@ -370,6 +370,14 @@
   (should (equal
            (xr-lint "[-A-Z][A-Z-][A-Z-a][^-A-Z][]-a][A-Z---.]")
            '((16 . "Literal `-' not first or last in character alternative"))))
+  (should (equal
+           (xr-lint "\\(?:a*b?\\)*\\(c\\|d\\|\\)+\\(^\\|e\\)*")
+           '((10 . "Repetition of expression matching an empty string")
+             (21 . "Repetition of expression matching an empty string"))))
+  (should (equal (xr-lint "\\'*\\<?\\(?:$\\)+")
+                 '((2 . "Repetition of zero-width assertion")
+                   (5 . "Repetition of zero-width assertion")
+                   (13 . "Repetition of zero-width assertion"))))
   )
 
 (ert-deftest xr-skip-set ()
diff --git a/xr.el b/xr.el
index d838fb4..d97f147 100644
--- a/xr.el
+++ b/xr.el
@@ -107,6 +107,7 @@
 ;;; Code:
 
 (require 'rx)
+(require 'cl-lib)
 
 (defun xr--report (warnings position message)
   "Add the report MESSAGE at POSITION to WARNINGS."
@@ -432,6 +433,28 @@ UPPER may be nil, meaning infinity."
                  (list operand))))
     (append operator body)))
   
+(defconst xr--zero-width-assertions
+  '(bol eol bos eos bow eow word-boundary not-word-boundary
+    symbol-start symbol-end point))
+
+(defun xr--matches-empty-p (rx)
+  "Whether RX can match the empty string regardless of context."
+  (pcase rx
+    (`(,(or `seq `one-or-more `group) . ,body)
+     (cl-every #'xr--matches-empty-p body))
+    (`(or . ,body)
+     (cl-some #'xr--matches-empty-p body))
+    (`(group-n ,_ . ,body)
+     (cl-every #'xr--matches-empty-p body))
+    (`(,(or `opt `zero-or-more) . ,_)
+     t)
+    (`(repeat ,from ,_ . ,body)
+     (or (= from 0)
+         (cl-every #'xr--matches-empty-p body)))
+    (`(,(or `= `>=) ,_ . ,body)
+     (cl-every #'xr--matches-empty-p body))
+    ("" t)))
+
 (defun xr--parse-seq (warnings)
   (let ((sequence nil))                 ; reversed
     (while (not (looking-at (rx (or "\\|" "\\)" eos))))
@@ -458,11 +481,20 @@ UPPER may be nil, meaning infinity."
         (if (and sequence
                  (not (and (eq (car sequence) 'bol) (eq (preceding-char) ?^))))
             (let ((operator (match-string 0)))
-              (when (and (consp (car sequence))
-                         (memq (caar sequence)
-                               '(opt zero-or-more one-or-more +? *? ??)))
-                (xr--report warnings (match-beginning 0)
-                            "Repetition of repetition"))
+              (when warnings
+                (cond
+                 ((and (consp (car sequence))
+                       (memq (caar sequence)
+                             '(opt zero-or-more one-or-more +? *? ??)))
+                  (xr--report warnings (match-beginning 0)
+                              "Repetition of repetition"))
+                 ((memq (car sequence) xr--zero-width-assertions)
+                  (xr--report warnings (match-beginning 0)
+                              "Repetition of zero-width assertion"))
+                 ((xr--matches-empty-p (car sequence))
+                  (xr--report
+                   warnings (match-beginning 0)
+                   "Repetition of expression matching an empty string"))))
               (goto-char (match-end 0))
               (setq sequence (cons (xr--postfix operator (car sequence))
                                    (cdr sequence))))
@@ -477,11 +509,19 @@ UPPER may be nil, meaning infinity."
              sequence
              (not (and (eq (car sequence) 'bol) (eq (preceding-char) ?^))))
         (forward-char 2)
-        (when (and (consp (car sequence))
-                   (memq (caar sequence)
-                         '(opt zero-or-more one-or-more +? *? ??)))
-          (xr--report warnings (match-beginning 0)
-                      "Repetition of repetition"))
+        (when warnings
+          (cond
+           ((and (consp (car sequence))
+                 (memq (caar sequence)
+                       '(opt zero-or-more one-or-more +? *? ??)))
+            (xr--report warnings (match-beginning 0)
+                        "Repetition of repetition"))
+           ((memq (car sequence) xr--zero-width-assertions)
+            (xr--report warnings (match-beginning 0)
+                        "Repetition of zero-width assertion"))
+           ((xr--matches-empty-p (car sequence))
+            (xr--report warnings (match-beginning 0)
+                        "Repetition of expression matching an empty string"))))
         (if (looking-at (rx (opt (group (one-or-more digit)))
                             (opt (group ",")
                                  (opt (group (one-or-more digit))))