branch: externals/xr
commit 666bf87a02f736517e62b25f9236a7cc53ada357
Author: Mattias EngdegĂ„rd <[email protected]>
Commit: Mattias EngdegĂ„rd <[email protected]>

    Improved superset check for empty strings, and diag extent
    
    Recognise the empty string as a subset of any repetition that can be
    done zero times.
    
    Don't produce diagnostics whose endpoint precede the starting point,
    which could happen when the extent length is zero.
    In such cases, just use nil for the endpoint instead.
---
 xr-test.el | 41 +++++++++++++++++++++++++++++++++++++++++
 xr.el      | 54 +++++++++++++++++++++++++++++++-----------------------
 2 files changed, 72 insertions(+), 23 deletions(-)

diff --git a/xr-test.el b/xr-test.el
index 62e7970834..bc2eeebfb9 100644
--- a/xr-test.el
+++ b/xr-test.el
@@ -811,6 +811,47 @@
      (equal (xr-lint "[ab]?\\|a?")
             '(((7 8 "Branch matches subset of a previous branch" warning)
                (0 4 "This is the superset branch" info)))))
+
+    (should
+     (equal (xr-lint "a*\\|")
+            '(((4 nil "Branch matches subset of a previous branch" warning)
+               (0 1 "This is the superset branch" info)))))
+    (should
+     (equal (xr-lint "\\|a*")
+            '(((2 3 "Branch matches superset of a previous branch" warning)
+               (0 nil "This is the subset branch" info)))))
+    (should
+     (equal (xr-lint "a?\\|")
+            '(((4 nil "Branch matches subset of a previous branch" warning)
+               (0 1 "This is the superset branch" info)))))
+    (should
+     (equal (xr-lint "\\|a?")
+            '(((2 3 "Branch matches superset of a previous branch" warning)
+               (0 nil "This is the subset branch" info)))))
+    (should
+     (equal (xr-lint "a*?\\|")
+            '(((5 nil "Branch matches subset of a previous branch" warning)
+               (0 2 "This is the superset branch" info)))))
+    (should
+     (equal (xr-lint "\\|a*?")
+            '(((2 4 "Branch matches superset of a previous branch" warning)
+               (0 nil "This is the subset branch" info)))))
+    (should
+     (equal (xr-lint "a??\\|")
+            '(((5 nil "Branch matches subset of a previous branch" warning)
+               (0 2 "This is the superset branch" info)))))
+    (should
+     (equal (xr-lint "\\|a??")
+            '(((2 4 "Branch matches superset of a previous branch" warning)
+               (0 nil "This is the subset branch" info)))))
+    (should
+     (equal (xr-lint "a\\{0,4\\}\\|")
+            '(((10 nil "Branch matches subset of a previous branch" warning)
+               (0 7 "This is the superset branch" info)))))
+    (should
+     (equal (xr-lint "\\|a\\{0,4\\}")
+            '(((2 9 "Branch matches superset of a previous branch" warning)
+               (0 nil "This is the subset branch" info)))))
     ))
 
 (ert-deftest xr-lint-subsumed-repetition ()
diff --git a/xr.el b/xr.el
index 3f2b23e33d..b7846f789e 100644
--- a/xr.el
+++ b/xr.el
@@ -1618,26 +1618,29 @@ A-SETS and B-SETS are arguments to `any'."
          ((eq a-op 'or)
           (xr--some (lambda (a-expr) (xr--superset-p a-expr b)) a-body))
 
-         ((eq a-op 'zero-or-more)
-          (if (memq (car-safe b) '(opt zero-or-more one-or-more))
-              (let ((b-body (cdr b)))
-                (xr--superset-p (xr--make-seq a-body) (xr--make-seq b-body)))
-            (xr--superset-p (xr--make-seq a-body) b)))
-         ((eq a-op 'one-or-more)
-          (if (eq (car-safe b) 'one-or-more)
-              (let ((b-body (cdr b)))
-                (xr--superset-p (xr--make-seq a-body) (xr--make-seq b-body)))
-            (xr--superset-p (xr--make-seq a-body) b)))
-         ((eq a-op 'opt)
-          (if (eq (car-safe b) 'opt)
+         ((memq a-op '(zero-or-more *?))
+          (if (memq (car-safe b) '(opt zero-or-more one-or-more ?? *? +?))
+            (let ((b-body (cdr b)))
+              (xr--superset-p (xr--make-seq a-body) (xr--make-seq b-body)))
+            (or (equal b '(seq))
+                (xr--superset-p (xr--make-seq a-body) b))))
+         ((memq a-op '(one-or-more +?))
+          (if (memq (car-safe b) '(one-or-more +?))
               (let ((b-body (cdr b)))
                 (xr--superset-p (xr--make-seq a-body) (xr--make-seq b-body)))
             (xr--superset-p (xr--make-seq a-body) b)))
+         ((memq a-op '(opt ??))
+          (if (memq (car-safe b) '(opt ??))
+            (let ((b-body (cdr b)))
+              (xr--superset-p (xr--make-seq a-body) (xr--make-seq b-body)))
+            (or (equal b '(seq))
+                (xr--superset-p (xr--make-seq a-body) b))))
          ((eq a-op 'repeat)
           (let ((lo (car a-body))
                 (a-body (cddr a-body)))
             (if (<= lo 1)
-                (xr--superset-p (xr--make-seq a-body) b)
+                (or (and (= lo 0) (equal b '(seq)))
+                    (xr--superset-p (xr--make-seq a-body) b))
               (equal a b))))
          
          ;; We do not expand through groups on the subset (b) side to
@@ -1704,26 +1707,31 @@ A-SETS and B-SETS are arguments to `any'."
                      (let ((branch (car alts)))
                        (cond
                         ((xr--superset-p seq branch)
-                         (let ((duplicate (equal seq branch)))
+                         (let ((duplicate (equal seq branch))
+                               (prev-beg (cadr locs))
+                               (prev-end (- (car locs) 3)))
                            (xr--warn
                             warnings
-                            pos (1- xr--idx)
+                            pos (and (< pos xr--idx) (1- xr--idx))
                             (if duplicate
                                 "Duplicated alternative branch"
                               "Branch matches superset of a previous branch")
-                            (cadr locs) (- (car locs) 3)
+                            prev-beg (and (>= prev-end prev-beg) prev-end)
                             (if duplicate
                                 "Previous occurrence here"
                               "This is the subset branch"))
                            nil))
                         ((xr--superset-p branch seq)
-                         (xr--warn warnings
-                                   pos (1- xr--idx)
-                                   "Branch matches subset of a previous branch"
-                                   (cadr locs) (- (car locs) 3)
-                                   "This is the superset branch")
-                         nil)
-                        (t t))))
+                         (let ((prev-beg (cadr locs))
+                               (prev-end (- (car locs) 3)))
+                           (xr--warn
+                            warnings
+                            pos (and (< pos xr--idx) (1- xr--idx))
+                            "Branch matches subset of a previous branch"
+                            prev-beg (and (>= prev-end prev-beg) prev-end)
+                            "This is the superset branch")
+                           nil))
+                         (t t))))
               (setq locs (cdr locs))
               (setq alts (cdr alts))))
           (when (and (eq checks 'all)

Reply via email to