procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix rx wrong-code bug: ranges starting with ^

Browse source 
(rx (in (?^ . ?a))) was incorrectly translated to "[^-a]".
Change it so that we get "[_-a^]" instead.

* lisp/emacs-lisp/rx.el (rx--generate-alt): Split ranges starting with
`^` occurring first in a non-negated character alternative.
* test/lisp/emacs-lisp/rx-tests.el (rx-any): Add and adapt tests.

(cherry picked from commit 5f5d668ac7)
This commit is contained in:
Mattias Engdegård 2023-07-30 15:30:38 +02:00
parent ba60070b81
commit 2b8796eea1
2 changed files with 28 additions and 12 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
lisp/emacs-lisp/rx.el
View file

@ -445,13 +445,19 @@ classes."
(setcar dash-l ?.)) ; Reduce --x to .-x
(setq items (nconc items '((?- . ?-))))))
;; Deal with leading ^ and range ^-x.
(when (and (consp (car items))
(eq (caar items) ?^)
(cdr items))
;; Move ^ and ^-x to second place.
(setq items (cons (cadr items)
(cons (car items) (cddr items)))))
;; Deal with leading ^ and range ^-x in non-negated set.
(when (and (eq (car-safe (car items)) ?^)
(not negated))
(if (eq (cdar items) ?^)
;; single leading ^
(when (cdr items)
;; Move the ^ to second place.
(setq items (cons (cadr items)
(cons (car items) (cddr items)))))
;; Split ^-x to _-x^
(setq items (cons (cons ?_ (cdar items))
(cons '(?^ . ?^)
(cdr items))))))
(cond
;; Empty set: if negated, any char, otherwise match-nothing.

20
test/lisp/emacs-lisp/rx-tests.el
View file

@ -112,23 +112,33 @@
(should (equal (rx (any "]" "^") (any "]" "-") (any "-" "^")
(not (any "]" "^")) (not (any "]" "-"))
(not (any "-" "^")))
"[]^][]-][-^][^]^][^]-][^-^]"))
"[]^][]-][-^][^]^][^]-][^^-]"))
(should (equal (rx (any "]" "^" "-") (not (any "]" "^" "-")))
"[]^-][^]^-]"))
(should (equal (rx (any "^-f") (any "^-f" "-")
(any "^-f" "z") (any "^-f" "z" "-"))
"[_-f^][_-f^-][_-f^z][_-f^z-]"))
(should (equal (rx (not (any "^-f")) (not (any "^-f" "-"))
(not (any "^-f" "z")) (not (any "^-f" "z" "-")))
"[^^-f][^^-f-][^^-fz][^^-fz-]"))
(should (equal (rx (any "^-f" word) (any "^-f" "-" word))
"[_-f^[:word:]][_-f^[:word:]-]"))
(should (equal (rx (not (any "^-f" word)) (not (any "^-f" "-" word)))
"[^^-f[:word:]][^^-f[:word:]-]"))
(should (equal (rx (any "-" ascii) (any "^" ascii) (any "]" ascii))
"[[:ascii:]-][[:ascii:]^][][:ascii:]]"))
(should (equal (rx (not (any "-" ascii)) (not (any "^" ascii))
(not (any "]" ascii)))
"[^[:ascii:]-][^[:ascii:]^][^][:ascii:]]"))
"[^[:ascii:]-][^^[:ascii:]][^][:ascii:]]"))
(should (equal (rx (any "-]" ascii) (any "^]" ascii) (any "-^" ascii))
"[][:ascii:]-][]^[:ascii:]][[:ascii:]^-]"))
(should (equal (rx (not (any "-]" ascii)) (not (any "^]" ascii))
(not (any "-^" ascii)))
"[^][:ascii:]-][^]^[:ascii:]][^[:ascii:]^-]"))
"[^][:ascii:]-][^]^[:ascii:]][^^[:ascii:]-]"))
(should (equal (rx (any "-]^" ascii) (not (any "-]^" ascii)))
"[]^[:ascii:]-][^]^[:ascii:]-]"))
(should (equal (rx (any "^" lower upper) (not (any "^" lower upper)))
"[[:lower:]^[:upper:]][^[:lower:]^[:upper:]]"))
"[[:lower:]^[:upper:]][^^[:lower:][:upper:]]"))
(should (equal (rx (any "-" lower upper) (not (any "-" lower upper)))
"[[:lower:][:upper:]-][^[:lower:][:upper:]-]"))
(should (equal (rx (any "]" lower upper) (not (any "]" lower upper)))
@ -143,7 +153,7 @@
"[]-a-][^]-a-]"))
(should (equal (rx (any "--]") (not (any "--]"))
(any "-" "^-a") (not (any "-" "^-a")))
"[].-\\-][^].-\\-][-^-a][^-^-a]"))
"[].-\\-][^].-\\-][_-a^-][^^-a-]"))
(should (equal (rx (not (any "!a" "0-8" digit nonascii)))
"[^!0-8a[:digit:][:nonascii:]]"))
(should (equal (rx (any) (not (any)))