[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] externals/xr 90cd77a251 11/18: Use ranges in warnings
|
From: |
ELPA Syncer |
|
Subject: |
[elpa] externals/xr 90cd77a251 11/18: Use ranges in warnings |
|
Date: |
Thu, 1 Aug 2024 13:00:01 -0400 (EDT) |
branch: externals/xr
commit 90cd77a25174b9a06d5429b992a803c271104177
Author: Mattias Engdegård <mattiase@acm.org>
Commit: Mattias Engdegård <mattiase@acm.org>
Use ranges in warnings
---
README | 7 +-
xr-test.el | 454 ++++++++++++++++++++++-----------------------
xr.el | 612 +++++++++++++++++++++++++++++++++----------------------------
3 files changed, 560 insertions(+), 513 deletions(-)
diff --git a/README b/README
index e233125bf2..a60441f72f 100644
--- a/README
+++ b/README
@@ -98,6 +98,7 @@ The xr package can be used interactively or by other code as
a library.
ranges are caused by a misplaced hyphen.
- Character 'B' included in range 'A-C'
+ - Range 'A-C' includes character 'B'
A range includes a character that also occurs individually. This
is often caused by a misplaced hyphen.
@@ -183,14 +184,14 @@ The xr package can be used interactively or by other code
as a library.
the repeated sequence, resulting in a*\(?:c[ab]+\)* in the example
above.
- - End-of-line anchor followed by non-newline
- - Non-newline followed by line-start anchor
+ - Non-newline follows end-of-line anchor
+ - Line-start anchor follows non-newline
A pattern that does not match a newline occurs right after an
end-of-line anchor ($) or before a line-start anchor (^).
This combination can never match.
- - End-of-text anchor followed by non-empty pattern
+ - Non-empty pattern follows end-of-text anchor
A pattern that only matches a non-empty string occurs right after
an end-of-text anchor (\'). This combination can never match.
diff --git a/xr-test.el b/xr-test.el
index 22874ec3be..dcb11f2f7a 100644
--- a/xr-test.el
+++ b/xr-test.el
@@ -32,11 +32,11 @@
(should (equal (xr ".+")
'(one-or-more nonl)))
(should (equal (xr-test--error (xr "$b\\"))
- '(xr-parse-error "Backslash at end of regexp" 2)))
+ '(xr-parse-error "Backslash at end of regexp" 2 2)))
(let ((text-quoting-style 'grave))
(should (equal (xr-lint "$b\\")
- '((0 . "Unescaped literal `$'")
- (2 . "error: Backslash at end of regexp"))))
+ '((0 0 "Unescaped literal `$'")
+ (2 2 "error: Backslash at end of regexp"))))
))
(ert-deftest xr-repeat ()
@@ -65,9 +65,9 @@
(should (equal (xr "a\\{1,\\}")
'(>= 1 "a")))
(should (equal (xr-test--error (xr "a\\{3,2\\}"))
- '(xr-parse-error "Invalid repetition interval" 3)))
+ '(xr-parse-error "Invalid repetition interval" 3 5)))
(should (equal (xr-test--error (xr "a\\{1,2,3\\}"))
- '(xr-parse-error "Expected \\}" 6)))
+ '(xr-parse-error "Missing \\}" 1 5)))
)
(ert-deftest xr-backref ()
@@ -76,17 +76,17 @@
(should (equal (xr "\\01")
"01"))
(should (equal (xr-test--error (xr "\\(?abc\\)"))
- '(xr-parse-error "Invalid \\(? syntax" 0)))
+ '(xr-parse-error "Invalid \\(? syntax" 0 2)))
(should (equal (xr-test--error (xr "\\(?2\\)"))
- '(xr-parse-error "Invalid \\(? syntax" 0)))
+ '(xr-parse-error "Invalid \\(? syntax" 0 2)))
(should (equal (xr-test--error (xr "\\(?0:xy\\)"))
- '(xr-parse-error "Invalid \\(? syntax" 0)))
+ '(xr-parse-error "Invalid \\(? syntax" 0 2)))
(should (equal (xr "\\(?29:xy\\)")
'(group-n 29 "xy")))
(should (equal (xr-test--error (xr "\\(c?"))
- '(xr-parse-error "Missing \\)" 0)))
+ '(xr-parse-error "Missing \\)" 0 3)))
(should (equal (xr-test--error (xr "xy\\)"))
- '(xr-parse-error "Unbalanced \\)" 2)))
+ '(xr-parse-error "Unbalanced \\)" 2 3)))
)
(ert-deftest xr-misc ()
@@ -95,7 +95,7 @@
word-boundary not-word-boundary bow eow
symbol-start symbol-end eol)))
(should (equal (xr-test--error (xr "\\_a"))
- '(xr-parse-error "Invalid \\_ sequence" 0)))
+ '(xr-parse-error "Invalid \\_ sequence" 0 2)))
)
(ert-deftest xr-syntax ()
@@ -114,14 +114,14 @@
'(seq (not (syntax whitespace))
(not (syntax comment-start)))))
(should (equal (xr-test--error (xr "\\s"))
- '(xr-parse-error "Incomplete \\s sequence" 0)))
+ '(xr-parse-error "Incomplete \\s sequence" 0 1)))
(should (equal (xr-test--error (xr "\\S"))
- '(xr-parse-error "Incomplete \\S sequence" 0)))
+ '(xr-parse-error "Incomplete \\S sequence" 0 1)))
(let ((text-quoting-style 'grave))
(should (equal (xr-test--error (xr "\\sq"))
- '(xr-parse-error "Unknown syntax code `q'" 2)))
+ '(xr-parse-error "Unknown syntax code `q'" 0 2)))
(should (equal (xr-test--error (xr "\\Sq"))
- '(xr-parse-error "Unknown syntax code `q'" 2)))
+ '(xr-parse-error "Unknown syntax code `q'" 0 2)))
))
(ert-deftest xr-category ()
@@ -160,9 +160,9 @@
(should (equal (xr "\\c%\\C+")
'(seq (category ?%) (not (category ?+)))))
(should (equal (xr-test--error (xr "\\c"))
- '(xr-parse-error "Incomplete \\c sequence" 0)))
+ '(xr-parse-error "Incomplete \\c sequence" 0 1)))
(should (equal (xr-test--error (xr "\\C"))
- '(xr-parse-error "Incomplete \\C sequence" 0)))
+ '(xr-parse-error "Incomplete \\C sequence" 0 1)))
)
(ert-deftest xr-lazy ()
@@ -217,13 +217,13 @@
'nonl))
(let ((text-quoting-style 'grave))
(should (equal (xr-test--error (xr "[[::]]"))
- '(xr-parse-error "No character class `[::]'" 1)))
+ '(xr-parse-error "No character class `[::]'" 1 4)))
(should (equal (xr-test--error (xr "[[:=:]]"))
- '(xr-parse-error "No character class `[:=:]'" 1)))
+ '(xr-parse-error "No character class `[:=:]'" 1 5)))
(should (equal (xr-test--error (xr "[[:letter:]]"))
- '(xr-parse-error "No character class `[:letter:]'" 1)))
+ '(xr-parse-error "No character class `[:letter:]'" 1 10)))
(should (equal (xr-test--error (xr "[a-f"))
- '(xr-parse-error "Unterminated character alternative" 0)))
+ '(xr-parse-error "Unterminated character alternative" 0 3)))
)
(should (equal (xr "[aaaaaa][bananabanana][aaaa-cccc][a-ca-ca-c]")
'(seq "a" (any "abn") (any "a-c") (any "a-c"))))
@@ -405,64 +405,64 @@
(should (equal (xr-lint "^a*\\[\\?\\$\\(b\\{3\\}\\|c\\)$")
nil))
(should (equal (xr-lint "a^b$c")
- '((1 . "Unescaped literal `^'")
- (3 . "Unescaped literal `$'"))))
+ '((1 1 "Unescaped literal `^'")
+ (3 3 "Unescaped literal `$'"))))
(should (equal (xr-lint "^**$")
- '((1 . "Unescaped literal `*'"))))
+ '((1 1 "Unescaped literal `*'"))))
(should (equal (xr-lint "a\\|\\`?b")
- '((5 . "Unescaped literal `?'"))))
+ '((5 5 "Unescaped literal `?'"))))
(should (equal (xr-lint "a\\|\\`\\{3,4\\}b")
- '((5 . "Escaped non-special character `{'")
- (10 . "Escaped non-special character `}'"))))
+ '((5 6 "Escaped non-special character `{'")
+ (10 11 "Escaped non-special character `}'"))))
(should (equal (xr-lint "\\{\\(+\\|?\\)\\[\\]\\}\\\t")
- '((0 . "Escaped non-special character `{'")
- (4 . "Unescaped literal `+'")
- (7 . "Unescaped literal `?'")
- (14 . "Escaped non-special character `}'")
- (16 . "Escaped non-special character `\\t'"))))
+ '((0 1 "Escaped non-special character `{'")
+ (4 4 "Unescaped literal `+'")
+ (7 7 "Unescaped literal `?'")
+ (14 15 "Escaped non-special character `}'")
+ (16 17 "Escaped non-special character `\\t'"))))
(should (equal (xr-lint "\\}\\w\\a\\b\\%")
- '((0 . "Escaped non-special character `}'")
- (4 . "Escaped non-special character `a'")
- (8 . "Escaped non-special character `%'"))))
+ '((0 1 "Escaped non-special character `}'")
+ (4 5 "Escaped non-special character `a'")
+ (8 9 "Escaped non-special character `%'"))))
(should (equal (xr-lint "a?+b+?\\(?:c*\\)*d\\{3\\}+e*?\\{2,5\\}")
- '((2 . "Repetition of option")
- (14 . "Repetition of repetition")
- (25 . "Repetition of repetition"))))
+ '((2 2 "Repetition of option")
+ (14 14 "Repetition of repetition")
+ (25 31 "Repetition of repetition"))))
(should (equal (xr-lint "\\(?:a+\\)?")
nil))
(should (equal (xr-lint "\\(a*\\)*\\(b+\\)*\\(c*\\)?\\(d+\\)?")
- '((6 . "Repetition of repetition")
- (13 . "Repetition of repetition")
- (20 . "Optional repetition"))))
+ '((6 6 "Repetition of repetition")
+ (13 13 "Repetition of repetition")
+ (20 20 "Optional repetition"))))
(should (equal (xr-lint "\\(a?\\)+\\(b?\\)?")
- '((6 . "Repetition of option")
- (13 . "Optional option"))))
+ '((6 6 "Repetition of option")
+ (13 13 "Optional option"))))
(should (equal (xr-lint "\\(e*\\)\\{3\\}")
- '((6 . "Repetition of repetition"))))
+ '((6 10 "Repetition of repetition"))))
(should (equal (xr-lint "\\(a?\\)\\{4,7\\}")
- '((6 . "Repetition of option"))))
+ '((6 12 "Repetition of option"))))
(should (equal (xr-lint "\\(?:a?b+c?d*\\)*")
- '((14 . "Repetition of effective repetition"))))
+ '((14 14 "Repetition of effective repetition"))))
(should (equal (xr-lint "\\(a?b+c?d*\\)*")
- '((12 . "Repetition of effective repetition"))))
+ '((12 12 "Repetition of effective repetition"))))
(should (equal (xr-lint "a*\\|b+\\|\\(?:a\\)*")
- '((8 . "Duplicated alternative branch"))))
+ '((8 15 "Duplicated alternative branch"))))
(should (equal (xr-lint "a\\{,\\}")
- '((1 . "Uncounted repetition"))))
+ '((1 5 "Uncounted repetition"))))
(should (equal (xr-lint "a\\{\\}")
- '((1 . "Implicit zero repetition"))))
+ '((1 4 "Implicit zero repetition"))))
(should (equal (xr-lint "\\'*\\<?\\(?:$\\)+")
- '((2 . "Repetition of zero-width assertion")
- (5 . "Optional zero-width assertion")
- (13 . "Repetition of zero-width assertion"))))
+ '((2 2 "Repetition of zero-width assertion")
+ (5 5 "Optional zero-width assertion")
+ (13 13 "Repetition of zero-width assertion"))))
(should (equal
(xr-lint "\\b\\{2\\}\\(a\\|\\|b\\)\\{,8\\}")
- '((2 . "Repetition of zero-width assertion")
- (17 . "Repetition of expression matching an empty string"))))
+ '((2 6 "Repetition of zero-width assertion")
+ (17 22 "Repetition of expression matching an empty string"))))
(should (equal (xr-lint "\\(?:\\`\\)*")
- '((8 . "Repetition of zero-width assertion"))))
+ '((8 8 "Repetition of zero-width assertion"))))
(should (equal (xr-lint "\\(?:\\`\\)\\{3,4\\}")
- '((8 . "Repetition of zero-width assertion"))))
+ '((8 14 "Repetition of zero-width assertion"))))
))
(ert-deftest xr-lint-char-alt ()
@@ -470,24 +470,24 @@
(should (equal (xr-lint "[^]\\a-d^-]")
nil))
(should (equal (xr-lint "a[\\\\[]b[d-g.d-g]c")
- '((3 . "Duplicated `\\' inside character alternative")
- (12 . "Duplicated `d-g' inside character alternative"))))
+ '((3 3 "Duplicated `\\' inside character alternative")
+ (12 14 "Duplicated `d-g' inside character alternative"))))
(should (equal (xr-lint "[]-Qa-fz-t]")
- '((1 . "Reversed range `]-Q' matches nothing")
- (7 . "Reversed range `z-t' matches nothing"))))
+ '((1 3 "Reversed range `]-Q' matches nothing")
+ (7 9 "Reversed range `z-t' matches nothing"))))
(should (equal (xr-lint "[z-a][^z-a]")
nil))
(should (equal (xr-lint "[^A-FFGI-LI-Mb-da-eg-ki-ns-t33-7]")
- '((5 . "Character `F' included in range `A-F'")
- (10 . "Ranges `I-L' and `I-M' overlap")
- (16 . "Ranges `a-e' and `b-d' overlap")
- (22 . "Ranges `g-k' and `i-n' overlap")
- (25 . "Two-character range `s-t'")
- (29 . "Character `3' included in range `3-7'"))))
+ '((5 5 "Character `F' included in range `A-F'")
+ (10 12 "Ranges `I-L' and `I-M' overlap")
+ (16 18 "Ranges `a-e' and `b-d' overlap")
+ (22 24 "Ranges `g-k' and `i-n' overlap")
+ (25 27 "Two-character range `s-t'")
+ (29 31 "Range `3-7' includes character `3'"))))
(should (equal (xr-lint "[a[:digit:]b[:punct:]c[:digit:]]")
- '((22 . "Duplicated character class `[:digit:]'"))))
+ '((22 30 "Duplicated character class `[:digit:]'"))))
(should (equal (xr-lint "[0-9[|]*/]")
- '((4 . "Suspect `[' in char alternative"))))
+ '((4 4 "Suspect `[' in char alternative"))))
(should (equal (xr-lint "[^][-].]")
nil))
(should (equal (xr-lint "\\[\\([^\\[]*\\)\\]$")
@@ -495,20 +495,20 @@
(should (equal (xr-lint "[0-1]")
nil))
(should (equal (xr-lint "[^]-][]-^]")
- '((6 . "Two-character range `]-^'"))))
+ '((6 8 "Two-character range `]-^'"))))
(should (equal
(xr-lint "[-A-Z][A-Z-][A-Z-a][^-A-Z][]-a][A-Z---.]")
- '((16 .
+ '((16 16
"Literal `-' not first or last in character alternative"))))
;; The range "[\x70-\x8f]" only includes 70..7f and 3fff80..3fff8f;
;; the gap 80..3fff7f is excluded.
(should (equal (xr-lint "[\x70-\x8f∃]") nil))
(should (equal (xr-lint "[\x70-\x8f\x7e-å]")
- '((4 . "Ranges `\x70-\\x7f' and `\x7e-å' overlap"))))
+ '((4 6 "Ranges `\x70-\\x7f' and `\x7e-å' overlap"))))
(should (equal (xr-lint "[\x70-\x8få-\x82]")
- '((4 . "Ranges `å-\\x82' and `\\x80-\\x8f' overlap"))))
+ '((4 6 "Ranges `å-\\x82' and `\\x80-\\x8f' overlap"))))
(should (equal (xr-lint "[A-z]")
- '((1 . "Range `A-z' between upper and lower case includes
symbols"))))
+ '((1 3 "Range `A-z' between upper and lower case includes
symbols"))))
))
(ert-deftest xr-lint-noisy ()
@@ -520,28 +520,28 @@
(equal
(xr-lint "[0-9+-/*][&-+=]" nil checks)
(if (eq checks 'all)
- '((4 . "Suspect character range `+-/': should `-' be literal?")
- (10 . "Suspect character range `&-+': should `-' be literal?"))
+ '((4 6 "Suspect character range `+-/': should `-' be literal?")
+ (10 12 "Suspect character range `&-+': should `-' be
literal?"))
nil)))
(should
(equal
(xr-lint "[ \\t][-.\\d][\\Sw][\\rnt]" nil checks)
(if (eq checks 'all)
- '((2 . "Possibly erroneous `\\t' in character alternative")
- (8 . "Possibly erroneous `\\d' in character alternative")
- (12 . "Possibly erroneous `\\S' in character alternative")))))
+ '((2 3 "Possibly erroneous `\\t' in character alternative")
+ (8 9 "Possibly erroneous `\\d' in character alternative")
+ (12 13 "Possibly erroneous `\\S' in character alternative")))))
(should (equal (xr-lint "\\(?:ta\\)\\(:?da\\)\\(:?\\)" nil checks)
(if (eq checks 'all)
- '((10 . "Possibly mistyped `:?' at start of group"))
+ '((10 11 "Possibly mistyped `:?' at start of
group"))
nil)))
(should
(equal
(xr-lint "%\\|[abc]\\|[[:digit:]]\\|\\s-\\|\\s_"
nil checks)
(if (eq checks 'all)
- '((3 . "Or-pattern more efficiently expressed as character
alternative")
- (10 . "Or-pattern more efficiently expressed as character
alternative")
- (23 . "Or-pattern more efficiently expressed as character
alternative"))
+ '((0 7 "Or-pattern more efficiently expressed as character
alternative")
+ (3 20 "Or-pattern more efficiently expressed as character
alternative")
+ (10 25 "Or-pattern more efficiently expressed as character
alternative"))
nil)))
))))
@@ -549,55 +549,55 @@
(let ((text-quoting-style 'grave))
(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"))))
+ '((10 10 "Repetition of expression matching an empty string")
+ (21 21 "Repetition of expression matching an empty string"))))
(should (equal
(xr-lint "\\(?:a*?b??\\)+?")
- '((12 . "Repetition of expression matching an empty string"))))
+ '((12 13 "Repetition of expression matching an empty string"))))
(should (equal (xr-lint "\\(?:a*b?\\)?")
- '((10 . "Optional expression matching an empty string"))))))
+ '((10 10 "Optional expression matching an empty
string"))))))
(ert-deftest xr-lint-branch-subsumption ()
(let ((text-quoting-style 'grave))
(should (equal (xr-lint "a.cde*f?g\\|g\\|abcdefg")
- '((14 . "Branch matches subset of a previous branch"))))
+ '((14 20 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "abcd\\|e\\|[aA].[^0-9z]d")
- '((9 . "Branch matches superset of a previous branch"))))
+ '((9 21 "Branch matches superset of a previous branch"))))
(should (equal (xr-lint "\\(?:\\(a\\)\\|.\\)\\(?:a\\|\\(.\\)\\)")
- '((21 . "Branch matches superset of a previous branch"))))
+ '((21 25 "Branch matches superset of a previous branch"))))
(should (equal (xr-lint ".\\|\n\\|\r")
- '((6 . "Branch matches subset of a previous branch"))))
+ '((6 6 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "[^mM]\\|[^a-zA-Z]")
- '((7 . "Branch matches subset of a previous branch"))))
+ '((7 15 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "[^mM]\\|[^A-LN-Z]")
nil))
(should (equal (xr-lint "[ab]\\|[^bcd]")
nil))
(should (equal (xr-lint "[ab]\\|[^cd]")
- '((6 . "Branch matches superset of a previous branch"))))
+ '((6 10 "Branch matches superset of a previous branch"))))
(should (equal (xr-lint ".\\|[a\n]")
nil))
(should (equal (xr-lint "ab?c+\\|a?b*c*")
- '((7 . "Branch matches superset of a previous branch"))))
+ '((7 12 "Branch matches superset of a previous branch"))))
(should (equal (xr-lint "\\(?:[aA]\\|b\\)\\|a")
- '((15 . "Branch matches subset of a previous branch"))))
+ '((15 15 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "\\(?:a\\|b\\)\\|[abc]")
- '((12 . "Branch matches superset of a previous branch"))))
+ '((12 16 "Branch matches superset of a previous branch"))))
(should (equal (xr-lint "\\(?:a\\|b\\)\\|\\(?:[abd]\\|[abc]\\)")
- '((12 . "Branch matches superset of a previous branch"))))
+ '((12 29 "Branch matches superset of a previous branch"))))
(should (equal (xr-lint "ab\\|abc?")
- '((4 . "Branch matches superset of a previous branch"))))
+ '((4 7 "Branch matches superset of a previous branch"))))
(should (equal (xr-lint "abc\\|abcd*e?")
- '((5 . "Branch matches superset of a previous branch"))))
+ '((5 11 "Branch matches superset of a previous branch"))))
(should (equal (xr-lint "[a[:digit:]]\\|[a\n]")
nil))
(should (equal (xr-lint "[a[:ascii:]]\\|[a\n]")
- '((14 . "Branch matches subset of a previous branch"))))
+ '((14 17 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "[[:alnum:]]\\|[[:alpha:]]")
- '((13 . "Branch matches subset of a previous branch"))))
+ '((13 23 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "[[:alnum:]%]\\|[[:alpha:]%]")
- '((14 . "Branch matches subset of a previous branch"))))
+ '((14 25 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "[[:xdigit:]%]\\|[[:alpha:]%]")
nil))
(should (equal (xr-lint "[[:alnum:]]\\|[^[:alpha:]]")
@@ -605,11 +605,11 @@
(should (equal (xr-lint "[^[:alnum:]]\\|[[:alpha:]]")
nil))
(should (equal (xr-lint "[[:digit:]]\\|[^[:punct:]]")
- '((13 . "Branch matches superset of a previous branch"))))
+ '((13 24 "Branch matches superset of a previous branch"))))
(should (equal (xr-lint "[^[:digit:]]\\|[[:punct:]]")
- '((14 . "Branch matches subset of a previous branch"))))
+ '((14 24 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "[^[:digit:]]\\|[^[:xdigit:]]")
- '((14 . "Branch matches subset of a previous branch"))))
+ '((14 26 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "[^[:print:]]\\|[[:ascii:]]")
nil))
(should (equal (xr-lint "[[:print:]]\\|[^[:ascii:]]")
@@ -617,111 +617,111 @@
(should (equal (xr-lint "[^[:print:]]\\|[^[:ascii:]]")
nil))
(should (equal (xr-lint "[[:digit:][:cntrl:]]\\|[[:ascii:]]")
- '((22 . "Branch matches superset of a previous branch"))))
+ '((22 32 "Branch matches superset of a previous branch"))))
(should (equal (xr-lint "[[:alpha:]]\\|A")
- '((13 . "Branch matches subset of a previous branch"))))
+ '((13 13 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "[[:alpha:]]\\|[A-E]")
- '((13 . "Branch matches subset of a previous branch"))))
+ '((13 17 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "[[:alpha:]3-7]\\|[A-E46]")
- '((16 . "Branch matches subset of a previous branch"))))
+ '((16 22 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "[^[:alpha:]]\\|[123]")
- '((14 . "Branch matches subset of a previous branch"))))
+ '((14 18 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "[!-@]\\|[[:digit:]]")
- '((7 . "Branch matches subset of a previous branch"))))
+ '((7 17 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "[^a-z]\\|[[:digit:]]")
- '((8 . "Branch matches subset of a previous branch"))))
+ '((8 18 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "[^[:punct:]]\\|[a-z]")
- '((14 . "Branch matches subset of a previous branch"))))
+ '((14 18 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "[[:space:]]\\|[ \t\f]")
- '((13 . "Branch matches subset of a previous branch"))))
+ '((13 17 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "[[:word:]]\\|[a-gH-P2357]")
- '((12 . "Branch matches subset of a previous branch"))))
+ '((12 23 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "[^[:space:]]\\|[a-gH-P2357]")
- '((14 . "Branch matches subset of a previous branch"))))
+ '((14 25 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "[^z-a]\\|[^0-9[:space:]]")
- '((8 . "Branch matches subset of a previous branch"))))
+ '((8 22 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "\\(?:.\\|\n\\)\\|a")
- '((12 . "Branch matches subset of a previous branch"))))
+ '((12 12 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "\\s-\\| ")
- '((5 . "Branch matches subset of a previous branch"))))
+ '((5 5 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "\\S-\\|x")
- '((5 . "Branch matches subset of a previous branch"))))
+ '((5 5 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "\\cl\\|å")
- '((5 . "Branch matches subset of a previous branch"))))
+ '((5 5 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "\\Ca\\|ü")
- '((5 . "Branch matches subset of a previous branch"))))
+ '((5 5 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "\\w\\|[^z-a]")
- '((4 . "Branch matches superset of a previous branch"))))
+ '((4 9 "Branch matches superset of a previous branch"))))
(should (equal (xr-lint "\\W\\|[^z-a]")
- '((4 . "Branch matches superset of a previous branch"))))
+ '((4 9 "Branch matches superset of a previous branch"))))
(should (equal (xr-lint "\\w\\|a")
- '((4 . "Branch matches subset of a previous branch"))))
+ '((4 4 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "\\W\\|\f")
- '((4 . "Branch matches subset of a previous branch"))))
+ '((4 4 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "[[:punct:]]\\|!")
- '((13 . "Branch matches subset of a previous branch"))))
+ '((13 13 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "[[:ascii:]]\\|[^α-ω]")
- '((13 . "Branch matches superset of a previous branch"))))
+ '((13 18 "Branch matches superset of a previous branch"))))
(should (equal (xr-lint "[^a-f]\\|[h-z]")
- '((8 . "Branch matches subset of a previous branch"))))
+ '((8 12 "Branch matches subset of a previous branch"))))
(should (equal (xr-lint "[0-9]\\|\\S(")
- '((7 . "Branch matches superset of a previous branch"))))
+ '((7 9 "Branch matches superset of a previous branch"))))
(should (equal (xr-lint "a+\\|[ab]+")
- '((4 . "Branch matches superset of a previous branch"))))
+ '((4 8 "Branch matches superset of a previous branch"))))
(should (equal (xr-lint "[ab]?\\|a?")
- '((7 . "Branch matches subset of a previous branch"))))
+ '((7 8 "Branch matches subset of a previous branch"))))
))
(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"))))
+ '((15 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"))))
+ '((5 6 "Repetition subsumed by preceding repetition")
+ (10 14 "Repetition subsumes preceding repetition")
+ (21 22 "Repetition subsumed by preceding repetition")
+ (26 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"))))
+ '((5 6 "Repetition subsumed by preceding repetition")
+ (10 14 "Repetition subsumes preceding repetition")
+ (21 22 "Repetition subsumed by preceding repetition")
+ (26 30 "Repetition subsumes preceding repetition"))))
(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"))))
+ '((2 3 "Repetition subsumed by preceding repetition")
+ (7 8 "Repetition subsumes preceding repetition")
+ (12 13 "Repetition subsumed by preceding repetition")
+ (17 18 "Repetition subsumes preceding repetition")
+ (22 23 "Repetition subsumed by preceding repetition")
+ (27 28 "Repetition subsumes preceding repetition")
+ (32 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"))))
+ '((5 7 "Repetition subsumed by preceding repetition")
+ (12 16 "Repetition subsumes preceding repetition")
+ (23 25 "Repetition subsumed by preceding repetition")
+ (30 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"))))
+ '((5 7 "Repetition subsumed by preceding repetition")
+ (12 16 "Repetition subsumes preceding repetition")
+ (23 25 "Repetition subsumed by preceding repetition")
+ (30 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"))))
+ '((2 4 "Repetition subsumed by preceding repetition")
+ (9 10 "Repetition subsumes preceding repetition")
+ (14 16 "Repetition subsumed by preceding repetition")
+ (21 22 "Repetition subsumes preceding repetition")
+ (26 28 "Repetition subsumed by preceding repetition")
+ (33 34 "Repetition subsumes preceding repetition")
+ (38 40 "Repetition subsumed by preceding repetition")
+ (45 46 "Repetition subsumes preceding repetition"))))
(should (equal (xr-lint "[ab]+?a?,a?[ab]+?,[ab]+?a*,a*[ab]+?")
nil))
@@ -730,77 +730,80 @@
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"))))
+ '((39 40 "Repetition subsumes preceding repetition")
+ (44 46 "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"))))
+ '((6 8 "Repetition subsumed by preceding repetition")
+ (13 18 "Repetition subsumes preceding repetition")
+ (26 28 "Repetition subsumed by preceding repetition")
+ (33 38"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"))))
+ '((6 8 "Repetition subsumed by preceding repetition")
+ (13 18 "Repetition subsumes preceding repetition")
+ (26 28 "Repetition subsumed by preceding repetition")
+ (33 38 "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")
- (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"))))
+ '((3 5 "Repetition subsumed by preceding repetition")
+ (10 12 "Repetition subsumes preceding repetition")
+ (17 19 "Repetition subsumed by preceding repetition")
+ (24 26 "Repetition subsumes preceding repetition")
+ (31 33 "Repetition subsumed by preceding repetition")
+ (38 40 "Repetition subsumes preceding repetition")
+ (45 47 "Repetition subsumed by preceding repetition"))))
))
(ert-deftest xr-lint-wrapped-subsumption ()
(let ((text-quoting-style 'grave))
(should (equal
(xr-lint "\\(?:a*x[ab]+\\)*")
- '((14 . "Last item in repetition subsumes first item
(wrapped)"))))
+ '((14 14
+ "Last item in repetition subsumes first item (wrapped)"))))
(should (equal
(xr-lint "\\([ab]*xya?\\)+")
- '((13 . "First item in repetition subsumes last item
(wrapped)"))))
+ '((13 13
+ "First item in repetition subsumes last item (wrapped)"))))
(should (equal
(xr-lint "\\(?3:a*xa*\\)\\{7\\}")
- '((14 . "Last item in repetition subsumes first item
(wrapped)"))))
+ '((12 16
+ "Last item in repetition subsumes first item (wrapped)"))))
))
(ert-deftest xr-lint-bad-anchor ()
(let ((text-quoting-style 'grave))
(should (equal (xr-lint "a\\(?:^\\)")
- '((1 . "Non-newline followed by line-start anchor"))))
+ '((1 7 "Line-start anchor follows non-newline"))))
(should (equal (xr-lint "a?\\(?:^\\)")
- '((2 . "Non-newline followed by line-start anchor"))))
+ '((2 8 "Line-start anchor follows non-newline"))))
(should (equal (xr-lint "a\\(?:^\\|b\\)")
- '((1 . "Non-newline followed by line-start anchor"))))
+ '((1 10 "Line-start anchor follows non-newline"))))
(should (equal (xr-lint "a?\\(?:^\\|b\\)")
nil))
(should (equal (xr-lint "\\(?:$\\)a")
- '((7 . "End-of-line anchor followed by non-newline"))))
+ '((7 7 "Non-newline follows end-of-line anchor"))))
(should (equal (xr-lint "\\(?:$\\)\\(\n\\|a\\)")
- '((7 . "End-of-line anchor followed by non-newline"))))
+ '((7 14 "Non-newline follows end-of-line anchor"))))
(should (equal (xr-lint "\\(?:$\\|b\\)a")
- '((10 . "End-of-line anchor followed by non-newline"))))
+ '((10 10 "Non-newline follows end-of-line anchor"))))
(should (equal (xr-lint "\\(?:$\\|b\\)\\(\n\\|a\\)")
nil))
(should (equal (xr-lint "\\(?3:$\\)[ab]\\(?2:^\\)")
- '((8 . "End-of-line anchor followed by non-newline")
- (12 . "Non-newline followed by line-start anchor"))))
+ '((8 11 "Non-newline follows end-of-line anchor")
+ (12 19 "Line-start anchor follows non-newline"))))
(should (equal (xr-lint ".\\(?:^$\\).")
- '((1 . "Non-newline followed by line-start anchor")
- (9 . "End-of-line anchor followed by non-newline"))))
+ '((1 8 "Line-start anchor follows non-newline")
+ (9 9 "Non-newline follows end-of-line anchor"))))
(should (equal (xr-lint "\\'b")
- '((2 . "End-of-text anchor followed by non-empty
pattern"))))
+ '((2 2 "Non-empty pattern follows end-of-text anchor"))))
(should (equal (xr-lint "\\'b?")
- '((3 . "End-of-text anchor followed by non-empty
pattern"))))
+ '((2 3 "Non-empty pattern follows end-of-text anchor"))))
(should (equal (xr-lint "\\(?:a\\|\\'\\)b")
- '((11 .
- "End-of-text anchor followed by non-empty pattern"))))
+ '((11 11
+ "Non-empty pattern follows end-of-text anchor"))))
(should (equal (xr-lint "\\'\\(a\\|b?\\)")
- '((2 . "End-of-text anchor followed by non-empty
pattern"))))
+ '((2 10 "Non-empty pattern follows end-of-text anchor"))))
(should (equal (xr-lint "\\(?:a\\|\\'\\)b?")
nil))
))
@@ -808,11 +811,11 @@
(ert-deftest xr-lint-file ()
(let ((text-quoting-style 'grave))
(should (equal (xr-lint "a.b\\.c.*d.?e.+f." 'file)
- '((1 . "Possibly unescaped `.' in file-matching regexp")
- (15 . "Possibly unescaped `.' in file-matching regexp"))))
+ '((1 1 "Possibly unescaped `.' in file-matching regexp")
+ (15 15 "Possibly unescaped `.' in file-matching
regexp"))))
(should (equal (xr-lint "^abc$" 'file)
- '((0 . "Use \\` instead of ^ in file-matching regexp")
- (4 . "Use \\' instead of $ in file-matching regexp"))))))
+ '((0 0 "Use \\` instead of ^ in file-matching regexp")
+ (4 4 "Use \\' instead of $ in file-matching regexp"))))))
(ert-deftest xr-skip-set ()
(should (equal (xr-skip-set "0-9a-fA-F+*")
@@ -843,9 +846,10 @@
'(not (in "a-z" "+"))))
(let ((text-quoting-style 'grave))
(should (equal (xr-test--error (xr-skip-set "[::]"))
- '(xr-parse-error "No character class `'" 0)))
+ '(xr-parse-error "No character class `[::]'" 0 3)))
(should (equal (xr-test--error (xr-skip-set "[:whitespace:]"))
- '(xr-parse-error "No character class `whitespace'" 0)))
+ '(xr-parse-error
+ "No character class `[:whitespace:]'" 0 13)))
)
(should (equal (xr-skip-set ".")
"\\."))
@@ -860,31 +864,31 @@
(ert-deftest xr-skip-set-lint ()
(let ((text-quoting-style 'grave))
(should (equal (xr-skip-set-lint "A[:ascii:]B[:space:][:ascii:]")
- '((20 . "Duplicated character class `[:ascii:]'"))))
+ '((20 28 "Duplicated character class `[:ascii:]'"))))
(should (equal (xr-skip-set-lint "a\\bF-AM-M\\")
- '((1 . "Unnecessarily escaped `b'")
- (3 . "Reversed range `F-A'")
- (6 . "Single-element range `M-M'")
- (9 . "Stray `\\' at end of string"))))
+ '((1 2 "Unnecessarily escaped `b'")
+ (3 5 "Reversed range `F-A'")
+ (6 8 "Single-element range `M-M'")
+ (9 9 "Stray `\\' at end of string"))))
(should (equal (xr-skip-set-lint "A-Fa-z3D-KM-N!3-7\\!b")
- '((7 . "Ranges `A-F' and `D-K' overlap")
- (10 . "Two-element range `M-N'")
- (14 . "Character `3' included in range `3-7'")
- (17 . "Duplicated character `!'")
- (17 . "Unnecessarily escaped `!'")
- (19 . "Character `b' included in range `a-z'"))))
+ '((7 9 "Ranges `A-F' and `D-K' overlap")
+ (10 12 "Two-element range `M-N'")
+ (14 16 "Range `3-7' includes character `3'")
+ (17 17 "Duplicated character `!'")
+ (17 18 "Unnecessarily escaped `!'")
+ (19 19 "Character `b' included in range `a-z'"))))
(should (equal (xr-skip-set-lint "!-\\$")
- '((2 . "Unnecessarily escaped `$'"))))
+ '((2 3 "Unnecessarily escaped `$'"))))
(should (equal (xr-skip-set-lint "[^a-z]")
- '((0 . "Suspect skip set framed in `[...]'"))))
+ '((0 5 "Suspect skip set framed in `[...]'"))))
(should (equal (xr-skip-set-lint "[0-9]+")
- '((0 . "Suspect skip set framed in `[...]'"))))
+ '((0 4. "Suspect skip set framed in `[...]'"))))
(should (equal (xr-skip-set-lint "[[:space:]].")
- '((0 . "Suspect character class framed in `[...]'"))))
+ '((0 10 "Suspect character class framed in `[...]'"))))
(should (equal (xr-skip-set-lint "")
- '((0 . "Empty set matches nothing"))))
+ '((0 nil "Empty set matches nothing"))))
(should (equal (xr-skip-set-lint "^")
- '((0 . "Negated empty set matches anything"))))
+ '((0 nil "Negated empty set matches anything"))))
(should (equal (xr-skip-set-lint "A-Z-")
nil))
(should (equal (xr-skip-set-lint "-A-Z")
@@ -892,12 +896,12 @@
(should (equal (xr-skip-set-lint "^-A-Z")
nil))
(should (equal (xr-skip-set-lint "A-Z-z")
- '((3 . "Literal `-' not first or last"))))
+ '((3 3 "Literal `-' not first or last"))))
(should (equal (xr-skip-set-lint "\x70-\x8f∃") nil))
(should (equal (xr-skip-set-lint "\x70-\x8f\x7e-å")
- '((3 . "Ranges `\x70-\\x7f' and `\x7e-å' overlap"))))
+ '((3 5 "Ranges `\x70-\\x7f' and `\x7e-å' overlap"))))
(should (equal (xr-skip-set-lint "\x70-\x8få-\x82")
- '((3 . "Ranges `å-\\x82' and `\\x80-\\x8f' overlap"))))
+ '((3 5 "Ranges `å-\\x82' and `\\x80-\\x8f' overlap"))))
))
;;; Unit tests for internal functions
diff --git a/xr.el b/xr.el
index 26d76a22cd..760c5dfc0b 100644
--- a/xr.el
+++ b/xr.el
@@ -32,26 +32,24 @@
(require 'rx)
(require 'cl-lib)
-(defun xr--report-2 (warnings beg end message)
+(defun xr--warn (warnings beg end message)
"Add the report MESSAGE at BEG..END to WARNINGS.
BEG and END are inclusive char indices. END is nil if only start is known."
(when warnings
(push (list beg end message) (car warnings))))
-(defun xr--report (warnings position message)
- (xr--report-2 warnings position nil message))
+(defun xr--add-error (warnings beg end message)
+ ;; FIXME: add a severity field (error/warning/info) instead
+ (xr--warn warnings beg end (concat "error: " message)))
(define-error 'xr-parse-error "xr parsing error")
-(defun xr--error-2 (beg end message &rest args)
+(defun xr--error (beg end message &rest args)
"Format MESSAGE with ARGS at BEG..END as an error and abort the parse.
END is nil if unknown."
(signal 'xr-parse-error
(list (apply #'format-message message args) beg end)))
-(defun xr--error (position message &rest args)
- (apply #'xr--error-2 position nil message args))
-
;; House versions of `cl-some' and `cl-every', but faster.
(defmacro xr--some (pred list)
@@ -113,12 +111,12 @@ END is nil if unknown."
'( ascii alnum alpha blank cntrl digit graph
lower multibyte nonascii print punct space
unibyte upper word xdigit))
- (xr--error idx
+ (xr--error idx (1+ i)
"No character class `[:%s:]'"
(symbol-name sym)))
(if (memq sym classes)
- (xr--report
- warnings idx
+ (xr--warn
+ warnings idx (1+ i)
(format-message
"Duplicated character class `[:%s:]'" sym))
(push sym classes))
@@ -141,8 +139,8 @@ END is nil if unknown."
;; It's unlikely that anyone writes z-a by mistake; don't complain.
((and (eq start ?z) (eq end ?a)))
(t
- (xr--report
- warnings idx
+ (xr--warn
+ warnings idx (+ idx 2)
(xr--escape-string
(format-message "Reversed range `%c-%c' matches nothing"
start end)))))
@@ -150,15 +148,15 @@ END is nil if unknown."
;; Suppress warnings about ranges between adjacent digits,
;; like [0-1], as they are common and harmless.
((and (= end (1+ start)) (not (<= ?0 start end ?9)))
- (xr--report warnings idx
- (xr--escape-string
- (format-message "Two-character range `%c-%c'"
- start end))))
+ (xr--warn warnings idx (+ idx 2)
+ (xr--escape-string
+ (format-message "Two-character range `%c-%c'"
+ start end))))
;; This warning is not necessarily free of false positives,
;; although they are unlikely. Maybe it should be off by default?
((and (<= ?A start ?Z) (<= ?a end ?z))
- (xr--report
- warnings idx
+ (xr--warn
+ warnings idx (+ idx 2)
(format-message
"Range `%c-%c' between upper and lower case includes symbols"
start end)))
@@ -166,8 +164,8 @@ END is nil if unknown."
;; mistake because matching both + and - is common.
((and (eq checks 'all)
(or (eq start ?+) (eq end ?+)))
- (xr--report
- warnings idx
+ (xr--warn
+ warnings idx (+ idx 2)
(xr--escape-string
(format-message
"Suspect character range `%c-%c': should `-' be literal?"
@@ -199,13 +197,13 @@ END is nil if unknown."
;; Only if the alternative didn't start with ]
(not (and intervals
(eq (aref (car (last intervals)) 0) ?\]))))
- (xr--report warnings idx
- (format-message "Suspect `[' in char alternative")))
+ (xr--warn warnings idx idx
+ (format-message "Suspect `[' in char alternative")))
(when (and (eq ch ?-)
(< start-pos idx (1- len))
(not (eq (aref string (1+ idx)) ?\])))
- (xr--report
- warnings idx
+ (xr--warn
+ warnings idx idx
(format-message
"Literal `-' not first or last in character alternative")))
(when (eq checks 'all)
@@ -220,15 +218,15 @@ END is nil if unknown."
(< (1+ idx) len)
(memq (aref string (1+ idx))
'(?t ?n ?r ?f ?x ?e ?b)))))
- (xr--report
- warnings (- idx 1)
+ (xr--warn
+ warnings (- idx 1) idx
(format-message
"Possibly erroneous `\\%c' in character alternative" ch)))))
(push (vector ch ch idx) intervals)
(setq idx (1+ idx)))))
(unless (< idx len)
- (xr--error (- start-pos (if negated 2 1))
+ (xr--error (- start-pos (if negated 2 1)) (- len 1)
"Unterminated character alternative"))
(setq xr--idx (1+ idx)) ; eat the ] and write back
@@ -239,44 +237,61 @@ END is nil if unknown."
(lambda (a b) (< (aref a 0) (aref b 0)))))
(s sorted))
(while (cdr s)
- (let ((this (car s))
- (next (cadr s)))
+ (let* ((this (car s))
+ (next (cadr 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))
+ (let* ((a (if (< (aref this 2) (aref next 2)) this next))
+ (b (if (< (aref this 2) (aref next 2)) next this)))
+ (cond
+ ;; Duplicate character: drop it and warn.
+ ((and (eq (aref a 0) (aref a 1))
+ (eq (aref b 0) (aref b 1)))
+ (xr--warn
+ warnings (aref b 2) (aref b 2)
+ (xr--escape-string
+ (format-message
+ "Duplicated `%c' inside character alternative"
+ (aref this 0)))))
+ ;; Duplicate range: drop it and warn.
+ ((and (eq (aref a 0) (aref b 0))
+ (eq (aref a 1) (aref b 1)))
+ (xr--warn
+ warnings (aref b 2) (+ (aref b 2) 2)
+ (xr--escape-string
+ (format-message
+ "Duplicated `%c-%c' inside character alternative"
+ (aref b 0) (aref b 1)))))
+ ;; Character in range: drop it and warn.
+ ((eq (aref a 0) (aref a 1))
+ (when (eq a this)
+ (setcar s next))
+ (xr--warn
+ warnings (aref b 2) (+ (aref b 2) 2)
+ (xr--escape-string
+ (format-message
+ "Range `%c-%c' includes character `%c'"
+ (aref b 0) (aref b 1) (aref a 0)))))
+ ;; Same but other way around.
+ ((eq (aref b 0) (aref b 1))
+ (when (eq b this)
+ (setcar s next))
+ (xr--warn
+ warnings (aref b 2) (aref b 2)
+ (xr--escape-string
+ (format-message
+ "Character `%c' included in range `%c-%c'"
+ (aref b 0) (aref a 0) (aref a 1)))))
+ ;; Overlapping ranges: merge and warn.
+ (t
+ (let ((this-end (aref this 1)))
+ (aset this 1 (max (aref this 1) (aref next 1)))
+ (xr--warn
+ warnings (aref b 2) (+ (aref b 2) 2)
+ (xr--escape-string
+ (format-message "Ranges `%c-%c' and `%c-%c' overlap"
+ (aref this 0) this-end
+ (aref next 0) (aref next 1)))))))
(setcdr s (cddr s)))
;; No overlap.
(setq s (cdr s)))))
@@ -538,7 +553,7 @@ Return `a-subsumes-b', `b-subsumes-a' or nil."
(xr--superset-p b-expr a-expr))
'b-subsumes-a))))))))
-(defun xr--check-wrap-around-repetition (operand pos warnings)
+(defun xr--check-wrap-around-repetition (operand beg end warnings)
"Whether OPERAND has a wrap-around repetition subsumption case,
like (* (* X) ... (* X))."
(when (and (consp operand)
@@ -552,14 +567,15 @@ like (* (* X) ... (* X))."
(last (car (last operands)))
(subsumption (xr--adjacent-subsumption last first)))
(when subsumption
- (xr--report
- warnings pos
+ (xr--warn
+ warnings beg end
(if (eq subsumption 'b-subsumes-a)
"First item in repetition subsumes last item (wrapped)"
"Last item in repetition subsumes first item (wrapped)"))))))))
(defun xr--parse-seq (warnings purpose checks)
- (let ((sequence nil) ; reversed
+ (let ((locations nil) ; starting idx for each item in sequence
+ (sequence nil) ; parsed items, reversed
(string xr--string)
(len xr--len)
(idx xr--idx)
@@ -567,6 +583,7 @@ like (* (* X) ... (* X))."
(while (and (< idx len) (not at-end))
(let ((item-start idx)
(next-char (aref string idx)))
+ (push item-start locations)
(cond
;; ^ - only special at beginning of sequence
((eq next-char ?^)
@@ -574,11 +591,11 @@ like (* (* X) ... (* X))."
(if (null sequence)
(progn
(when (eq purpose 'file)
- (xr--report warnings item-start
- "Use \\` instead of ^ in file-matching regexp"))
+ (xr--warn warnings item-start item-start
+ "Use \\` instead of ^ in file-matching
regexp"))
(push 'bol sequence))
- (xr--report warnings item-start
- (format-message "Unescaped literal `^'"))
+ (xr--warn warnings item-start item-start
+ (format-message "Unescaped literal `^'"))
(push "^" sequence)))
;; $ - only special at end of sequence
@@ -590,12 +607,12 @@ like (* (* X) ... (* X))."
(memq (aref string (1+ idx)) '(?| ?\)))))
(progn
(when (eq purpose 'file)
- (xr--report warnings item-start
- "Use \\' instead of $ in file-matching regexp"))
+ (xr--warn warnings item-start item-start
+ "Use \\' instead of $ in file-matching
regexp"))
(push 'eol sequence))
- (xr--report warnings item-start
- (format-message "Unescaped literal `$'"))
+ (xr--warn warnings item-start item-start
+ (format-message "Unescaped literal `$'"))
(push "$" sequence)))
;; not-newline
@@ -605,9 +622,9 @@ like (* (* X) ... (* X))."
(when (and (eq purpose 'file)
(not (and (< idx len)
(memq (aref string idx) '(?? ?* ?+)))))
- (xr--report warnings item-start
- (format-message
- "Possibly unescaped `.' in file-matching regexp")))
+ (xr--warn warnings item-start item-start
+ (format-message
+ "Possibly unescaped `.' in file-matching regexp")))
(push 'nonl sequence))
;; character alternative
@@ -626,10 +643,11 @@ like (* (* X) ... (* X))."
(if (and sequence
(not (and (memq (car sequence) '(bol bos))
(memq (aref string (1- idx)) '(?^ ?`)))))
- (let ((operator-char next-char)
- (lazy (and (< (1+ item-start) len)
- (eq (aref string (1+ item-start)) ??)))
- (operand (car sequence)))
+ (let* ((operator-char next-char)
+ (lazy (and (< (1+ item-start) len)
+ (eq (aref string (1+ item-start)) ??)))
+ (end-idx (if lazy (1+ item-start) item-start))
+ (operand (car sequence)))
(when warnings
;; Check both (OP (OP X)) and (OP (group (OP X))).
(let ((inner-op
@@ -650,30 +668,29 @@ like (* (* X) ... (* X))."
(memq inner-op '(one-or-more +?)))))
(let ((outer-opt (eq operator-char ??))
(inner-opt (memq inner-op '(opt ??))))
- (xr--report warnings item-start
- (if outer-opt
+ (xr--warn warnings idx end-idx
+ (if outer-opt
+ (if inner-opt
+ "Optional option"
+ "Optional repetition")
(if inner-opt
- "Optional option"
- "Optional repetition")
- (if inner-opt
- "Repetition of option"
- "Repetition of repetition")))))
+ "Repetition of option"
+ "Repetition of repetition")))))
((memq operand xr--zero-width-assertions)
- (xr--report warnings item-start
- (if (eq operator-char ??)
- "Optional zero-width assertion"
- "Repetition of zero-width assertion")))
+ (xr--warn warnings idx end-idx
+ (if (eq operator-char ??)
+ "Optional zero-width assertion"
+ "Repetition of zero-width assertion")))
((and (xr--matches-empty-p operand)
;; Rejecting repetition of the empty string
;; suppresses some false positives.
(not (equal operand "")))
- (xr--report
- warnings item-start
- (concat
- (if (eq operator-char ??)
- "Optional expression"
- "Repetition of expression")
- " matching an empty string")))
+ (xr--warn warnings idx end-idx
+ (concat
+ (if (eq operator-char ??)
+ "Optional expression"
+ "Repetition of expression")
+ " matching an empty string")))
((and (memq operator-char '(?* ?+))
(consp operand)
(memq (car operand) '(seq group))
@@ -688,25 +705,26 @@ like (* (* X) ... (* X))."
(memq (caar nonzero-items)
'( opt zero-or-more one-or-more
+? *? ?? >=)))))
- (xr--report warnings item-start
- "Repetition of effective repetition"))))
+ (xr--warn warnings idx end-idx
+ "Repetition of effective repetition"))))
;; (* (* X) ... (* X)) etc: wrap-around subsumption
(unless (eq operator-char ??)
(xr--check-wrap-around-repetition
- operand item-start warnings)))
- (setq idx (+ idx (if lazy 2 1)))
+ operand idx end-idx warnings)))
+ (setq idx (1+ end-idx))
(setq sequence (cons (xr--postfix operator-char lazy operand)
- (cdr sequence))))
+ (cdr sequence)))
+ (pop locations))
(setq idx (1+ idx))
- (xr--report warnings item-start
- (format-message "Unescaped literal `%c'" next-char))
+ (xr--warn warnings item-start item-start
+ (format-message "Unescaped literal `%c'" next-char))
(push (char-to-string next-char) sequence)))
;; Anything starting with backslash
((eq next-char ?\\)
(setq idx (1+ idx))
(unless (< idx len)
- (xr--error (1- len) "Backslash at end of regexp"))
+ (xr--error (1- len) (1- len) "Backslash at end of regexp"))
(setq next-char (aref string idx))
(cond
;; end of sequence: \) or \|
@@ -723,7 +741,8 @@ like (* (* X) ... (* X))."
(progn
(setq idx (1+ idx))
(unless (< idx len)
- (xr--error (- idx 3) "Invalid \\(? syntax"))
+ (xr--error (- idx 3) (1- idx)
+ "Invalid \\(? syntax"))
(let ((c (aref string idx)))
(cond
((eq c ?:)
@@ -741,15 +760,16 @@ like (* (* X) ... (* X))."
(string-to-number
(substring string idx i))
(setq idx (1+ i)))))))
- (t (xr--error (- idx 3) "Invalid \\(? syntax")))))
+ (t (xr--error (- idx 3) (1- idx)
+ "Invalid \\(? syntax")))))
(when (and (eq checks 'all)
(< (1+ idx) len)
(eq (aref string idx) ?:)
(eq (aref string (1+ idx)) ??)
;; suppress if the group ends after the :?
(not (xr--substring-p string (+ idx 2)
"\\)")))
- (xr--report
- warnings idx
+ (xr--warn
+ warnings idx (1+ idx)
(format-message
"Possibly mistyped `:?' at start of group")))
'unnumbered))
@@ -766,7 +786,8 @@ like (* (* X) ... (* X))."
(unless (and (< (1+ idx) len)
(eq (aref string idx) ?\\)
(eq (aref string (1+ idx)) ?\)))
- (xr--error (- group-start 2) "Missing \\)"))
+ (xr--error (- group-start 2) (1- (min len idx))
+ "Missing \\)"))
(setq idx (+ 2 idx))
(let ((item (cond ((eq submatch 'unnumbered)
(cons 'group operand))
@@ -777,13 +798,61 @@ like (* (* X) ... (* X))."
;; \{..\} - not special at beginning of sequence or after ^ or \`
((eq next-char ?\{)
- (if (and sequence
- (not (and (memq (car sequence) '(bol bos))
- (memq (aref string (1- item-start)) '(?^ ?`)))))
- (progn
- (setq idx (1+ idx))
- (let ((operand (car sequence)))
+ (if (or (not sequence)
+ (and (memq (car sequence) '(bol bos))
+ (memq (aref string (1- item-start)) '(?^ ?`))))
+ ;; Literal {
+ (xr--warn warnings item-start (1+ item-start)
+ (format-message
+ "Escaped non-special character `{'"))
+
+ (setq idx (1+ idx))
+ (let ((operand (car sequence)))
+ ;; parse bounds
+ (let* ((start idx)
+ (i start))
+ (while (and (< i len)
+ (<= ?0 (aref string i) ?9))
+ (setq i (1+ i)))
+ (let ((lower (and (> i start)
+ (string-to-number
+ (substring string start i))))
+ (comma nil)
+ (upper nil))
+ (when (and (< i len)
+ (eq (aref string i) ?,))
+ (setq comma t)
+ (setq i (1+ i))
+ (let ((start-u i))
+ (while (and (< i len)
+ (<= ?0 (aref string i) ?9))
+ (setq i (1+ i)))
+ (setq upper
+ (and (> i start-u)
+ (string-to-number
+ (substring string start-u i))))))
+ (setq idx i)
+ (unless (xr--substring-p string idx "\\}")
+ (xr--error (- start 2) (1- idx) "Missing \\}"))
+ (unless (or lower upper)
+ (xr--warn warnings (- start 2) (+ idx 1)
+ (if comma
+ "Uncounted repetition"
+ "Implicit zero repetition")))
+ (setq idx (+ i 2))
+ (setq lower (or lower 0))
+
+ (unless comma
+ (setq upper lower))
+ (when (and upper (> lower upper))
+ (xr--error start (1- i)
+ "Invalid repetition interval"))
+
(when warnings
+ (when (or (not upper) (>= upper 2))
+ (xr--check-wrap-around-repetition
+ operand item-start (1- idx) warnings))
+
(cond
((and (consp operand)
(or
@@ -803,71 +872,24 @@ like (* (* X) ... (* X))."
(and (eq (car operand) 'group)
(memq (caadr operand)
'(opt ??))))))
- (xr--report warnings item-start
- (if inner-opt
- "Repetition of option"
- "Repetition of repetition"))))
+ (xr--warn warnings item-start (1- idx)
+ (if inner-opt
+ "Repetition of option"
+ "Repetition of repetition"))))
((memq operand xr--zero-width-assertions)
- (xr--report warnings item-start
- "Repetition of zero-width assertion"))
+ (xr--warn warnings item-start (1- idx)
+ "Repetition of zero-width assertion"))
((and (xr--matches-empty-p operand)
;; Rejecting repetition of the empty string
;; suppresses some false positives.
(not (equal operand "")))
- (xr--report
- warnings item-start
+ (xr--warn
+ warnings item-start (1- idx)
"Repetition of expression matching an empty
string"))))
- ;; parse bounds
- (let* ((start idx)
- (i start))
- (while (and (< i len)
- (<= ?0 (aref string i) ?9))
- (setq i (1+ i)))
- (let ((lower (and (> i start)
- (string-to-number
- (substring string start i))))
- (comma nil)
- (upper nil))
- (when (and (< i len)
- (eq (aref string i) ?,))
- (setq comma t)
- (setq i (1+ i))
- (let ((start-u i))
- (while (and (< i len)
- (<= ?0 (aref string i) ?9))
- (setq i (1+ i)))
- (setq upper
- (and (> i start-u)
- (string-to-number
- (substring string start-u i))))))
- (setq idx i)
- (unless (xr--substring-p string idx "\\}")
- (xr--error idx "Expected \\}"))
- (unless (or lower upper)
- (xr--report warnings (- start 2)
- (if comma
- "Uncounted repetition"
- "Implicit zero repetition")))
- (when (and warnings
- (if comma
- (or (not upper) (>= upper 2))
- (and lower (>= lower 2))))
- (xr--check-wrap-around-repetition
- operand start warnings))
- (setq idx (+ i 2))
- (setq lower (or lower 0))
-
- (unless comma
- (setq upper lower))
- (when (and upper (> lower upper))
- (xr--error start "Invalid repetition interval"))
- (setq sequence (cons (xr--repeat lower upper operand)
- (cdr sequence)))))))
-
- ;; Literal {
- (xr--report warnings item-start
- (format-message
- "Escaped non-special character `{'"))))
+
+ (setq sequence (cons (xr--repeat lower upper operand)
+ (cdr sequence)))
+ (pop locations))))))
;; back-reference
((memq next-char (eval-when-compile (number-sequence ?1 ?9)))
@@ -900,7 +922,8 @@ like (* (* X) ... (* X))."
(sym (cond ((eq c ?<) 'symbol-start)
((eq c ?>) 'symbol-end)
(t
- (xr--error (- idx 2) "Invalid \\_ sequence")))))
+ (xr--error (- idx 2) idx
+ "Invalid \\_ sequence")))))
(setq idx (1+ idx))
(push sym sequence)))
@@ -908,13 +931,14 @@ like (* (* X) ... (* X))."
((memq next-char '(?s ?S))
(setq idx (1+ idx))
(unless (< idx len)
- (xr--error (- idx 2) "Incomplete \\%c sequence" next-char))
+ (xr--error (- idx 2) (1- len)
+ "Incomplete \\%c sequence" next-char))
(let* ((negated (eq next-char ?S))
(syntax-code (aref string idx)))
(setq idx (1+ idx))
(let ((sym (assq syntax-code xr--char-syntax-alist)))
(unless sym
- (xr--error (- idx 1)
+ (xr--error (- idx 3) (- idx 1)
"Unknown syntax code `%s'"
(xr--escape-string
(char-to-string syntax-code))))
@@ -926,7 +950,8 @@ like (* (* X) ... (* X))."
((memq next-char '(?c ?C))
(setq idx (1+ idx))
(unless (< idx len)
- (xr--error (- idx 2) "Incomplete \\%c sequence" next-char))
+ (xr--error (- idx 2) (1- len)
+ "Incomplete \\%c sequence" next-char))
(let ((negated (eq next-char ?C))
(category-code (aref string idx)))
(setq idx (1+ idx))
@@ -941,10 +966,10 @@ like (* (* X) ... (* X))."
(unless (memq next-char '(?\\ ?* ?+ ?? ?. ?^ ?$ ?\[ ?\]))
;; Note that we do not warn about \], since the symmetry with \[
;; makes it unlikely to be a serious error.
- (xr--report warnings item-start
- (format-message "Escaped non-special character `%s'"
- (xr--escape-string
- (char-to-string next-char))))))))
+ (xr--warn warnings item-start (1+ item-start)
+ (format-message "Escaped non-special character
`%s'"
+ (xr--escape-string
+ (char-to-string next-char))))))))
;; nonspecial character
(t
@@ -961,10 +986,10 @@ like (* (* X) ... (* X))."
(prev-item (cadr sequence))
(subsumption (xr--adjacent-subsumption prev-item item)))
(when subsumption
- (xr--report warnings item-start
- (if (eq subsumption 'a-subsumes-b)
- "Repetition subsumed by preceding repetition"
- "Repetition subsumes preceding repetition")))
+ (xr--warn warnings (car locations) (1- idx)
+ (if (eq subsumption 'a-subsumes-b)
+ "Repetition subsumed by preceding repetition"
+ "Repetition subsumes preceding repetition")))
;; Check for anchors conflicting with previous/next character.
;; To avoid false positives, we require that at least one
@@ -975,27 +1000,27 @@ like (* (* X) ... (* X))."
(when (and this-nonl
(or (eq prev-eol 'always)
(eq this-nonl 'always)))
- (xr--report
- warnings item-start
- "End-of-line anchor followed by non-newline")))))
+ (xr--warn
+ warnings (car locations) (1- idx)
+ "Non-newline follows end-of-line anchor")))))
(let ((this-bol (xr--starts-with-sym 'bol item)))
(when this-bol
(let ((prev-nonl (xr--ends-with-nonl prev-item)))
(when (and prev-nonl
(or (eq prev-nonl 'always)
(eq this-bol 'always)))
- (xr--report
- warnings item-start
- "Non-newline followed by line-start anchor")))))
+ (xr--warn
+ warnings (car locations) (1- idx)
+ "Line-start anchor follows non-newline")))))
(let ((prev-eos (xr--ends-with-sym 'eos prev-item)))
(when prev-eos
(let ((this-nonempty (xr--matches-nonempty item)))
(when (and this-nonempty
(or (eq prev-eos 'always)
(eq this-nonempty 'always)))
- (xr--report
- warnings item-start
- "End-of-text anchor followed by non-empty pattern")))))
+ (xr--warn
+ warnings (car locations) (1- idx)
+ "Non-empty pattern follows end-of-text anchor")))))
;; FIXME: We don't complain about non-empty followed by
;; bos because it may be the start of unmatchable.
@@ -1618,32 +1643,35 @@ A-SETS and B-SETS are arguments to `any'."
(`(or . ,ys) (xr--every #'xr--char-alt-equivalent-p ys))))
(defun xr--parse-alt (warnings purpose checks)
- (let ((alternatives nil)) ; reversed
+ (let ((locations (list xr--idx))
+ (alternatives nil)) ; reversed
(push (xr--parse-seq warnings purpose checks) alternatives)
(while (not (or (>= xr--idx xr--len)
(and (eq (aref xr--string xr--idx) ?\\)
(< (1+ xr--idx) xr--len)
(eq (aref xr--string (1+ xr--idx)) ?\)))))
(setq xr--idx (+ xr--idx 2)) ; skip \|
+ (push xr--idx locations)
(let ((pos xr--idx)
(seq (xr--parse-seq warnings purpose checks)))
(when warnings
(cond
((member seq alternatives)
- (xr--report warnings pos "Duplicated alternative branch"))
+ (xr--warn warnings pos (1- xr--idx)
+ "Duplicated alternative branch"))
((xr--some (lambda (branch) (xr--superset-p seq branch))
alternatives)
- (xr--report warnings pos
- "Branch matches superset of a previous branch"))
+ (xr--warn warnings pos (1- xr--idx)
+ "Branch matches superset of a previous branch"))
((xr--some (lambda (branch) (xr--superset-p branch seq))
alternatives)
- (xr--report warnings pos
+ (xr--warn warnings pos (1- xr--idx)
"Branch matches subset of a previous branch"))
((and (eq checks 'all)
(xr--char-alt-equivalent-p (car alternatives))
(xr--char-alt-equivalent-p seq))
- (xr--report
- warnings pos
+ (xr--warn
+ warnings (nth 1 locations) (1- xr--idx)
"Or-pattern more efficiently expressed as character alternative"))
))
(push seq alternatives)))
@@ -1661,7 +1689,7 @@ A-SETS and B-SETS are arguments to `any'."
(xr--idx 0)
(rx (xr--parse-alt warnings purpose checks)))
(when (xr--substring-p s xr--idx "\\)")
- (xr--error xr--idx "Unbalanced \\)"))
+ (xr--error xr--idx (1+ xr--idx) "Unbalanced \\)"))
rx))
;; Grammar for skip-set strings:
@@ -1680,15 +1708,15 @@ A-SETS and B-SETS are arguments to `any'."
(defun xr--parse-skip-set (string warnings)
;; An ad-hoc check, but one that catches lots of mistakes.
- (when (and (string-match-p (rx bos "[" (one-or-more anything) "]"
- (opt (any "+" "*" "?")
- (opt "?"))
- eos)
- string)
+ (when (and (string-match (rx bos (group "[" (one-or-more anything) "]")
+ (opt (any "+" "*" "?")
+ (opt "?"))
+ eos)
+ string)
(not (string-match-p
(rx bos "[:" (one-or-more anything) ":]" eos)
string)))
- (xr--report warnings 0
+ (xr--warn warnings 0 (1- (match-end 1))
(format-message "Suspect skip set framed in `[...]'")))
(let* ((intervals nil)
@@ -1717,21 +1745,23 @@ A-SETS and B-SETS are arguments to `any'."
'( ascii alnum alpha blank cntrl digit graph
lower multibyte nonascii print punct space
unibyte upper word xdigit))
- (xr--error idx
- "No character class `%s'" (symbol-name sym)))
+ (xr--error idx (1+ i)
+ "No character class `[:%s:]'"
+ (symbol-name sym)))
;; Another useful ad-hoc check.
(when (and (> idx 0)
(eq (aref string (1- idx)) ?\[)
(< (+ i 2) len)
(eq (aref string (+ i 2)) ?\]))
- (xr--report
- warnings (1- idx)
+ (xr--warn
+ warnings (1- idx) (+ i 2)
(format-message
"Suspect character class framed in `[...]'")))
(when (memq sym classes)
- (xr--report warnings idx
- (format-message
- "Duplicated character class `[:%s:]'" sym)))
+ (xr--warn warnings idx (1+ i)
+ (format-message
+ "Duplicated character class `[:%s:]'"
+ sym)))
(push sym classes)
(setq idx (+ 2 i))
t)))))
@@ -1739,8 +1769,8 @@ A-SETS and B-SETS are arguments to `any'."
((and (eq ch ?\\) (not escaped))
(setq idx (1+ idx))
(if (= idx len)
- (xr--report warnings (1- idx)
- (format-message "Stray `\\' at end of string"))
+ (xr--warn warnings (1- idx) (1- idx)
+ (format-message "Stray `\\' at end of string"))
(setq escaped t)))
(t
@@ -1748,10 +1778,10 @@ A-SETS and B-SETS are arguments to `any'."
(start ch)
(end nil))
(when (and escaped (not (memq start '(?^ ?- ?\\))))
- (xr--report warnings pos
- (xr--escape-string
- (format-message
- "Unnecessarily escaped `%c'" start))))
+ (xr--warn warnings pos (1+ pos)
+ (xr--escape-string
+ (format-message
+ "Unnecessarily escaped `%c'" start))))
(setq idx (1+ idx))
(when (and (< (1+ idx) len) (eq (aref string idx) ?-))
@@ -1762,33 +1792,33 @@ A-SETS and B-SETS are arguments to `any'."
(setq end (aref string idx))
(setq idx (1+ idx))
(when (not (memq end '(?^ ?- ?\\)))
- (xr--report warnings (- idx 2)
- (xr--escape-string
- (format-message
- "Unnecessarily escaped `%c'" end))))))
+ (xr--warn warnings (- idx 2) (- idx 1)
+ (xr--escape-string
+ (format-message
+ "Unnecessarily escaped `%c'" end))))))
(when (and (eq start ?-)
(not end)
(not escaped)
(< start-pos pos (1- len)))
- (xr--report warnings pos
- (format-message "Literal `-' not first or last")))
+ (xr--warn warnings pos pos
+ (format-message "Literal `-' not first or last")))
(if (and end (> start end))
- (xr--report warnings pos
- (xr--escape-string
- (format-message
- "Reversed range `%c-%c'" start end)))
+ (xr--warn warnings pos (1- idx)
+ (xr--escape-string
+ (format-message
+ "Reversed range `%c-%c'" start end)))
(cond
((eq start end)
- (xr--report warnings pos
- (xr--escape-string
- (format-message "Single-element range `%c-%c'"
- start end))))
+ (xr--warn warnings pos (1- idx)
+ (xr--escape-string
+ (format-message "Single-element range `%c-%c'"
+ start end))))
((eq (1+ start) end)
- (xr--report warnings pos
- (xr--escape-string
- (format-message "Two-element range `%c-%c'"
- start end)))))
+ (xr--warn warnings pos (1- idx)
+ (xr--escape-string
+ (format-message "Two-element range `%c-%c'"
+ start end)))))
(cond
((not end)
(push (vector start start pos) intervals))
@@ -1803,10 +1833,10 @@ A-SETS and B-SETS are arguments to `any'."
(setq escaped nil))))))
(when (and (null intervals) (null classes))
- (xr--report warnings 0
- (if negated
- "Negated empty set matches anything"
- "Empty set matches nothing")))
+ (xr--warn warnings 0 nil
+ (if negated
+ "Negated empty set matches anything"
+ "Empty set matches nothing")))
(let* ((sorted (sort (nreverse intervals)
(lambda (a b) (< (aref a 0) (aref b 0)))))
@@ -1816,40 +1846,52 @@ A-SETS and B-SETS are arguments to `any'."
(next (cadr 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 character `%c'"
- (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 range `%c-%c'"
- (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))
+ (let* ((a (if (< (aref this 2) (aref next 2)) this next))
+ (b (if (< (aref this 2) (aref next 2)) next this)))
+ (cond
+ ;; Duplicate character: drop it and warn.
+ ((and (eq (aref a 0) (aref a 1))
+ (eq (aref b 0) (aref b 1)))
+ (xr--warn warnings (aref b 2) (aref b 2)
+ (xr--escape-string
+ (format-message
+ "Duplicated character `%c'" (aref this 0)))))
+ ;; Duplicate range: drop it and warn.
+ ((and (eq (aref a 0) (aref b 0))
+ (eq (aref a 1) (aref b 1)))
+ (xr--warn warnings (aref b 2) (+ (aref b 2) 2)
+ (xr--escape-string
+ (format-message
+ "Duplicated range `%c-%c'"
+ (aref b 0) (aref b 1)))))
+ ;; Character in range: drop it and warn.
+ ((eq (aref a 0) (aref a 1))
+ (when (eq a this)
+ (setcar s next))
+ (xr--warn warnings (aref b 2) (+ (aref b 2) 2)
+ (xr--escape-string
+ (format-message
+ "Range `%c-%c' includes character `%c'"
+ (aref b 0) (aref b 1) (aref a 0)))))
+ ;; Same but other way around.
+ ((eq (aref b 0) (aref b 1))
+ (when (eq b this)
+ (setcar s next))
+ (xr--warn warnings (aref b 2) (aref b 2)
+ (xr--escape-string
+ (format-message
+ "Character `%c' included in range `%c-%c'"
+ (aref b 0) (aref a 0) (aref a 1)))))
+ ;; Overlapping ranges: merge and warn.
+ (t
+ (let ((this-end (aref this 1)))
+ (aset this 1 (max (aref this 1) (aref next 1)))
+ (xr--warn warnings (aref b 2) (+ (aref b 2) 2)
+ (xr--escape-string
+ (format-message
+ "Ranges `%c-%c' and `%c-%c' overlap"
+ (aref this 0) this-end
+ (aref next 0) (aref next 1)))))))
(setcdr s (cddr s)))
;; No overlap.
(setq s (cdr s)))))
@@ -1951,9 +1993,9 @@ The alists are mapping from the default choice.")
(xr-parse-error
;; Add the error to the diagnostics.
(let ((msg (nth 1 err))
- (pos (nth 2 err)))
- ;; FIXME: add a severity field (error/warning/info) instead
- (xr--report ,warnings pos (concat "error: " msg))))))
+ (beg (nth 2 err))
+ (end (nth 3 err)))
+ (xr--add-error ,warnings beg end msg)))))
;;;###autoload
(defun xr (re-string &optional dialect)
- [elpa] externals/xr updated (71c748ed7c -> c5da86864b), ELPA Syncer, 2024/08/01
- [elpa] externals/xr 6f42ebafef 02/18: Copyright year update, ELPA Syncer, 2024/08/01
- [elpa] externals/xr d81c7e05a0 07/18: Parse the regexp string directly instead of creating a temp buffer, ELPA Syncer, 2024/08/01
- [elpa] externals/xr a3d8350cf7 09/18: Include parse errors in the diagnostics when linting, ELPA Syncer, 2024/08/01
- [elpa] externals/xr b07de9bc2c 05/18: Faster joining of chars to strings, ELPA Syncer, 2024/08/01
- [elpa] externals/xr 90cd77a251 11/18: Use ranges in warnings,
ELPA Syncer <=
- [elpa] externals/xr f81b5de888 12/18: Extract diagnostics sorting to a function, ELPA Syncer, 2024/08/01
- [elpa] externals/xr 345b626abf 17/18: NEWS entry for upcoming version 2.0, ELPA Syncer, 2024/08/01
- [elpa] externals/xr ab11e4229d 03/18: Move version history to separate NEWS file, ELPA Syncer, 2024/08/01
- [elpa] externals/xr cbb39a2f52 06/18: Performance hack: speed up xr--superset-p for strings, ELPA Syncer, 2024/08/01
- [elpa] externals/xr 548990e952 04/18: Simplify: make second arg to xr--escape-string optional, ELPA Syncer, 2024/08/01
- [elpa] externals/xr ee9870ea83 08/18: Signal new `xr-parse-error` for parsing errors, ELPA Syncer, 2024/08/01
- [elpa] externals/xr a003438b44 01/18: Check xr-lint `purpose` argument for validity., ELPA Syncer, 2024/08/01
- [elpa] externals/xr 14b639fc1e 10/18: Diagnostics now carry a range, not a single string offset, ELPA Syncer, 2024/08/01
- [elpa] externals/xr 6a708ef75a 14/18: Group diagnostics that belong together, ELPA Syncer, 2024/08/01
- [elpa] externals/xr e2455fd4bd 15/18: Add info-level messages for many warnings, ELPA Syncer, 2024/08/01