branch: externals/xr
commit 32546a7c7eece83f486db88375b160fa050188af
Author: Mattias Engdegård <matti...@acm.org>
Commit: Mattias Engdegård <matti...@acm.org>
Fix character alternative duplication removal
Duplications such as "[aaaaa]" were not always removed correctly,
nor were some cases of overlapping character ranges.
Reported by Shigeru Fukaya.
---
xr-test.el | 4 ++++
xr.el | 80 ++++++++++++++++++++++++++++++--------------------------------
2 files changed, 43 insertions(+), 41 deletions(-)
diff --git a/xr-test.el b/xr-test.el
index d62d02d..90e5be2 100644
--- a/xr-test.el
+++ b/xr-test.el
@@ -197,6 +197,10 @@
(should-error (xr "[[:=:]]"))
(should-error (xr "[[:letter:]]"))
(should-error (xr "[a-f"))
+ (should (equal (xr "[aaaaaa][bananabanana][aaaa-cccc][a-ca-ca-c]")
+ '(seq "a" (any "abn") (any "a-c") (any "a-c"))))
+ (should (equal (xr "[a-fb-gc-h][a-fc-kh-p]")
+ '(seq (any "a-h") (any "a-p"))))
)
(ert-deftest xr-empty ()
diff --git a/xr.el b/xr.el
index 03ab308..d314f9d 100644
--- a/xr.el
+++ b/xr.el
@@ -192,47 +192,45 @@
(while (cdr s)
(let ((this (car s))
(next (cadr s)))
- (when (>= (aref this 1) (aref next 0))
- (let ((message
- (cond
- ;; Duplicate character: drop it and warn.
- ((and (eq (aref this 0) (aref this 1))
- (eq (aref next 0) (aref next 1)))
- (setcdr s (cddr s))
- (format-message
- "Duplicated `%c' inside character alternative"
- (aref this 0)))
- ;; Duplicate range: drop it and warn.
- ((and (eq (aref this 0) (aref next 0))
- (eq (aref this 1) (aref next 1)))
- (setcdr s (cddr s))
- (format-message
- "Duplicated `%c-%c' inside character alternative"
- (aref this 0) (aref this 1)))
- ;; Character in range: drop it and warn.
- ((eq (aref this 0) (aref this 1))
- (setcar s next)
- (setcdr s (cddr s))
- (format-message
- "Character `%c' included in range `%c-%c'"
- (aref this 0) (aref next 0) (aref next 1)))
- ;; Same but other way around.
- ((eq (aref next 0) (aref next 1))
- (setcdr s (cddr s))
- (format-message
- "Character `%c' included in range `%c-%c'"
- (aref next 0) (aref this 0) (aref this 1)))
- ;; Overlapping ranges: merge and warn.
- (t
- (let ((this-end (aref this 1)))
- (aset this 1 (max (aref this 1) (aref next 1)))
- (setcdr s (cddr s))
- (format-message "Ranges `%c-%c' and `%c-%c' overlap"
- (aref this 0) this-end
- (aref next 0) (aref next 1)))))))
- (xr--report warnings (max (aref this 2) (aref next 2))
- (xr--escape-string message nil)))))
- (setq s (cdr s)))
+ (if (>= (aref this 1) (aref next 0))
+ ;; Overlap.
+ (let ((message
+ (cond
+ ;; Duplicate character: drop it and warn.
+ ((and (eq (aref this 0) (aref this 1))
+ (eq (aref next 0) (aref next 1)))
+ (format-message
+ "Duplicated `%c' inside character alternative"
+ (aref this 0)))
+ ;; Duplicate range: drop it and warn.
+ ((and (eq (aref this 0) (aref next 0))
+ (eq (aref this 1) (aref next 1)))
+ (format-message
+ "Duplicated `%c-%c' inside character alternative"
+ (aref this 0) (aref this 1)))
+ ;; Character in range: drop it and warn.
+ ((eq (aref this 0) (aref this 1))
+ (setcar s next)
+ (format-message
+ "Character `%c' included in range `%c-%c'"
+ (aref this 0) (aref next 0) (aref next 1)))
+ ;; Same but other way around.
+ ((eq (aref next 0) (aref next 1))
+ (format-message
+ "Character `%c' included in range `%c-%c'"
+ (aref next 0) (aref this 0) (aref this 1)))
+ ;; Overlapping ranges: merge and warn.
+ (t
+ (let ((this-end (aref this 1)))
+ (aset this 1 (max (aref this 1) (aref next 1)))
+ (format-message "Ranges `%c-%c' and `%c-%c' overlap"
+ (aref this 0) this-end
+ (aref next 0) (aref next 1)))))))
+ (xr--report warnings (max (aref this 2) (aref next 2))
+ (xr--escape-string message nil))
+ (setcdr s (cddr s)))
+ ;; No overlap.
+ (setq s (cdr s)))))
;; Gather ranges and single characters separately.
;; We make no attempts at merging adjacent intervals/characters,
