[elpa] externals/xr 3af4048 4/9: Suppress false positives in repetition subsumption check (bug #2)

[Mattias Engdegård]

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

    Suppress false positives in repetition subsumption check (bug #2)
    
    The sequence (Rx X) (Ry y) is not equivalent to (Rx X) if
    Rx is non-greedy and Ry is greedy.
    
    For example, "[ab]+?a*" should not elicit a repetition subsumption
    complaint; it is not equivalent to "[ab]+?".
    
    This fixes bug #2, reported by Hirofumi Ogawa.
---
 xr-test.el | 81 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++----
 xr.el      | 43 ++++++++++++++++++++-------------
 2 files changed, 103 insertions(+), 21 deletions(-)

diff --git a/xr-test.el b/xr-test.el
index e0d00b9..a0b5402 100644
--- a/xr-test.el
+++ b/xr-test.el
@@ -442,17 +442,88 @@
                    '((4 . "Branch matches superset of a previous branch"))))
     (should (equal (xr-lint "abc\\|abcd*e?")
                    '((5 . "Branch matches superset of a previous branch"))))
-    (should (equal (xr-lint "[ab]+a?,a?[ab]+,[ab]*a*,a*[ab]*")
+  ))
+
+(ert-deftest xr-lint-subsumed-repetition ()
+  (let ((text-quoting-style 'grave))
+    (should (equal (xr-lint "\\(?:a.c\\|def\\)+\\(?:abc\\)*")
+                   '((24 . "Repetition subsumed by preceding repetition"))))
+
+    ;; Exhaustive test of all possible combinations.
+    (should (equal (xr-lint "[ab]+a?,a?[ab]+,[ab]+a*,a*[ab]+")
+                   '((6 . "Repetition subsumed by preceding repetition")
+                     (14 . "Repetition subsumes preceding repetition")
+                     (22 . "Repetition subsumed by preceding repetition")
+                     (30 . "Repetition subsumes preceding repetition"))))
+
+    (should (equal (xr-lint "[ab]*a?,a?[ab]*,[ab]*a*,a*[ab]*")
                    '((6 . "Repetition subsumed by preceding repetition")
                      (14 . "Repetition subsumes preceding repetition")
                      (22 . "Repetition subsumed by preceding repetition")
                      (30 . "Repetition subsumes preceding repetition"))))
-    (should (equal (xr-lint "[^a]+b*,a?.*,a*a*,a*a+")
+
+    (should (equal (xr-lint "a+a?,a?a+,a+a*,a*a+,a*a?,a?a*,a*a*")
+                   '((3 . "Repetition subsumed by preceding repetition")
+                     (8 . "Repetition subsumes preceding repetition")
+                     (13 . "Repetition subsumed by preceding repetition")
+                     (18 . "Repetition subsumes preceding repetition")
+                     (23 . "Repetition subsumed by preceding repetition")
+                     (28 . "Repetition subsumes preceding repetition")
+                     (33 . "Repetition subsumed by preceding repetition"))))
+
+    (should (equal (xr-lint "[ab]+a??,a??[ab]+,[ab]+a*?,a*?[ab]+")
+                   '((6 . "Repetition subsumed by preceding repetition")
+                     (16 . "Repetition subsumes preceding repetition")
+                     (24 . "Repetition subsumed by preceding repetition")
+                     (34 . "Repetition subsumes preceding repetition"))))
+
+    (should (equal (xr-lint "[ab]*a??,a??[ab]*,[ab]*a*?,a*?[ab]*")
                    '((6 . "Repetition subsumed by preceding repetition")
+                     (16 . "Repetition subsumes preceding repetition")
+                     (24 . "Repetition subsumed by preceding repetition")
+                     (34 . "Repetition subsumes preceding repetition"))))
+
+    (should (equal (xr-lint "a+a??,a??a+,a+a*?,a*?a+,a*a??,a??a*,a*a*?,a*?a*")
+                   '((3 . "Repetition subsumed by preceding repetition")
+                     (10 . "Repetition subsumes preceding repetition")
+                     (15 . "Repetition subsumed by preceding repetition")
+                     (22 . "Repetition subsumes preceding repetition")
+                     (27 . "Repetition subsumed by preceding repetition")
+                     (34 . "Repetition subsumes preceding repetition")
+                     (39 . "Repetition subsumed by preceding repetition")
+                     (46 . "Repetition subsumes preceding repetition"))))
+
+    (should (equal (xr-lint "[ab]+?a?,a?[ab]+?,[ab]+?a*,a*[ab]+?")
+                   nil))
+
+    (should (equal (xr-lint "[ab]*?a?,a?[ab]*?,[ab]*?a*,a*[ab]*?")
+                   nil))
+
+    (should (equal (xr-lint "a+?a?,a?a+?,a+?a*,a*a+?,a*?a?,a?a*?,a*?a*,a*a*?")
+                   '((40 . "Repetition subsumes preceding repetition")
+                     (45 . "Repetition subsumed by preceding repetition"))))
+
+    (should (equal (xr-lint "[ab]+?a??,a??[ab]+?,[ab]+?a*?,a*?[ab]+?")
+                   '((7 . "Repetition subsumed by preceding repetition")
+                     (17 . "Repetition subsumes preceding repetition")
+                     (27 . "Repetition subsumed by preceding repetition")
+                     (37 . "Repetition subsumes preceding repetition"))))
+
+    (should (equal (xr-lint "[ab]*?a??,a??[ab]*?,[ab]*?a*?,a*?[ab]*?")
+                   '((7 . "Repetition subsumed by preceding repetition")
+                     (17 . "Repetition subsumes preceding repetition")
+                     (27 . "Repetition subsumed by preceding repetition")
+                     (37 . "Repetition subsumes preceding repetition"))))
+
+    (should (equal (xr-lint "a+?a??,a??a+?,a+?a*?,a*?a+?,a*?a??,a??a*?,a*?a*?")
+                   '((4 . "Repetition subsumed by preceding repetition")
                      (11 . "Repetition subsumes preceding repetition")
-                     (16 . "Repetition subsumed by preceding repetition")
-                     (21 . "Repetition subsumes preceding repetition"))))
-  ))
+                     (18 . "Repetition subsumed by preceding repetition")
+                     (25 . "Repetition subsumes preceding repetition")
+                     (32 . "Repetition subsumed by preceding repetition")
+                     (39 . "Repetition subsumes preceding repetition")
+                     (46 . "Repetition subsumed by preceding repetition"))))
+    ))
 
 (ert-deftest xr-skip-set ()
   (should (equal (xr-skip-set "0-9a-fA-F+*")
diff --git a/xr.el b/xr.el
index 6409554..fc5c7f7 100644
--- a/xr.el
+++ b/xr.el
@@ -713,9 +713,13 @@ UPPER may be nil, meaning infinity."
         (when (and warnings (cdr sequence))
           ;; Check for subsuming repetitions in sequence: (Rx X) (Ry Y)
           ;; where Rx and Ry are repetition operators, and X and Y are 
operands.
-          ;; We conclude that (Rx X) subsumes (Ry Y) if Rx can match
-          ;; infinitely many times, Ry can match zero times,
-          ;; and X matches a superset of Y. Example: [ab]+a?
+          ;; We conclude that (Rx X) subsumes (Ry Y), in the sense that the
+          ;; sequence is equivalent to just (Rx X), if:
+          ;;       X matches a superset of Y
+          ;;   and Rx can match infinitely many times
+          ;;   and Ry can match zero times
+          ;;   and Ry is non-greedy if Rx is non-greedy.
+          ;; Example: [ab]+a?
           (let* ((item (car sequence))
                  (expr (and (consp item)
                             (memq (car item)
@@ -729,19 +733,26 @@ UPPER may be nil, meaning infinity."
                                  '(zero-or-more one-or-more opt *? +? ??))
                            (xr--make-seq (cdr prev-item)))))
                 (when prev-expr
-                  (cond
-                   ((and (memq (car item) '(zero-or-more opt *? ??))
-                         (memq (car prev-item)
-                               '(zero-or-more one-or-more *? +?))
-                         (xr--superset-p prev-expr expr))
-                    (xr--report warnings item-start
-                                "Repetition subsumed by preceding repetition"))
-                   ((and (memq (car prev-item) '(zero-or-more opt *? ??))
-                         (memq (car item) '(zero-or-more one-or-more *? +?))
-                         (xr--superset-p expr prev-expr))
-                    (xr--report
-                     warnings item-start
-                     "Repetition subsumes preceding repetition"))))))))))
+                  (let ((op (car item))
+                        (prev-op (car prev-item)))
+                    ;; Test the same condition twice, but mirrored.
+                    (cond
+                     ((and (memq op '(zero-or-more opt *? ??))
+                           (memq prev-op '(zero-or-more one-or-more *? +?))
+                           (not (and (memq prev-op '(*? +?))
+                                     (memq op '(zero-or-more opt))))
+                           (xr--superset-p prev-expr expr))
+                      (xr--report
+                       warnings item-start
+                       "Repetition subsumed by preceding repetition"))
+                     ((and (memq prev-op '(zero-or-more opt *? ??))
+                           (memq op '(zero-or-more one-or-more *? +?))
+                           (not (and (memq op '(*? +?))
+                                     (memq prev-op '(zero-or-more opt))))
+                           (xr--superset-p expr prev-expr))
+                      (xr--report
+                       warnings item-start
+                       "Repetition subsumes preceding repetition")))))))))))
 
     (let ((item-seq (xr--rev-join-seq sequence)))
       (cond ((null item-seq)