Various split-string improvements
* lisp/subr.el (split-string):
Fix quadratic behaviour in (split-string "x❌x..." ":" nil " +").
General code reorganisation for speed and reduced allocation.
Fix a regexp bug; eg, (split-string "A;B" "," nil ";\\|:")
* test/lisp/subr-tests.el (subr-test-split-string):
More extensive test coverage.
This commit is contained in:
Mattias Engdegård
parent
aaa6d6e13b
commit
2592690abe
2 changed files with 129 additions and 57 deletions
116
lisp/subr.el
116
lisp/subr.el
|
|
@ -5900,62 +5900,66 @@ whitespace, use `(split-string STRING split-string-default-separators)'.
|
|||
|
||||
Modifies the match data; use `save-match-data' if necessary."
|
||||
(declare (important-return-value t))
|
||||
(let* ((keep-nulls (not (if separators omit-nulls t)))
|
||||
(rexp (or separators split-string-default-separators))
|
||||
(start 0)
|
||||
this-start this-end
|
||||
notfirst
|
||||
match-beg
|
||||
(list nil)
|
||||
(strlen (length string))
|
||||
(push-one
|
||||
;; Push the substring in range THIS-START to THIS-END
|
||||
;; onto LIST, trimming it and perhaps discarding it.
|
||||
(lambda ()
|
||||
(when trim
|
||||
;; Discard the trim from start of this substring.
|
||||
(let ((tem (string-match trim string this-start)))
|
||||
(and (eq tem this-start)
|
||||
(<= (match-end 0) this-end)
|
||||
(setq this-start (match-end 0)))))
|
||||
|
||||
(when (or keep-nulls (< this-start this-end))
|
||||
(let ((this (substring string this-start this-end)))
|
||||
|
||||
;; Discard the trim from end of this substring.
|
||||
(when trim
|
||||
(let ((tem (string-match (concat trim "\\'") this 0)))
|
||||
(and tem (< tem (length this))
|
||||
(setq this (substring this 0 tem)))))
|
||||
|
||||
;; Trimming could make it empty; check again.
|
||||
(when (or keep-nulls (plusp (length this)))
|
||||
(push this list)))))))
|
||||
|
||||
(while (and (string-match rexp string
|
||||
(if (and notfirst
|
||||
(= start match-beg) ; empty match
|
||||
(< start strlen))
|
||||
(1+ start) start))
|
||||
(< start strlen))
|
||||
(setq notfirst t
|
||||
match-beg (match-beginning 0))
|
||||
;; If the separator is right at the beginning, produce an empty
|
||||
;; substring in the result list.
|
||||
(if (= start match-beg)
|
||||
(setq this-start (match-end 0)
|
||||
this-end this-start)
|
||||
;; Otherwise produce a substring from start to the separator.
|
||||
(setq this-start start this-end match-beg))
|
||||
(setq start (match-end 0))
|
||||
|
||||
(funcall push-one))
|
||||
|
||||
;; Handle the substring at the end of STRING.
|
||||
(setq this-start start this-end strlen)
|
||||
(funcall push-one)
|
||||
|
||||
(nreverse list)))
|
||||
(let* ((keep-empty (and separators (not omit-nulls)))
|
||||
(len (length string))
|
||||
(trim-left-re (and trim (concat "\\`\\(?:" trim "\\)")))
|
||||
(trim-right-re (and trim (concat "\\(?:" trim "\\)\\'")))
|
||||
(sep-re (or separators split-string-default-separators))
|
||||
(acc nil)
|
||||
(next 0)
|
||||
(start 0))
|
||||
(while
|
||||
;; TODO: The semantics for empty matches are just a copy of
|
||||
;; the original code and make no sense at all. It's just a
|
||||
;; consequence of the original implementation, no thought behind it.
|
||||
;; We should probably error on empty matches, except when
|
||||
;; sep is "" (which is in use by some code) but in that case
|
||||
;; we could provide a faster implementation.
|
||||
(let ((sep (string-match sep-re string next)))
|
||||
(and sep
|
||||
(let ((sep-end (match-end 0)))
|
||||
(when (or keep-empty (< start sep))
|
||||
;; TODO: Ideally we'd be able to trim in the
|
||||
;; original string and only make a substring after
|
||||
;; doing so, but there is no way to bound a regexp
|
||||
;; search before a certain offset, nor to anchor it
|
||||
;; at the search boundaries.
|
||||
(let ((item (substring string start sep)))
|
||||
(if trim
|
||||
(let* ((item-beg
|
||||
(if (string-match trim-left-re item 0)
|
||||
(match-end 0)
|
||||
0))
|
||||
(item-len (length item))
|
||||
(item-end
|
||||
(or (string-match-p trim-right-re
|
||||
item item-beg)
|
||||
item-len)))
|
||||
(when (or (> item-beg 0) (< item-end item-len))
|
||||
(setq item (substring item item-beg item-end)))
|
||||
(when (or keep-empty (< item-beg item-end))
|
||||
(push item acc)))
|
||||
(push item acc))))
|
||||
;; This ensures progress in case the match was empty.
|
||||
(setq next (max (1+ next) sep-end))
|
||||
(setq start sep-end)
|
||||
(< start len)))))
|
||||
;; field after last separator, if any
|
||||
(let ((item (if (= start 0)
|
||||
string ; optimisation when there is no separator
|
||||
(substring string start))))
|
||||
(when trim
|
||||
(let* ((item-beg (if (string-match trim-left-re item 0)
|
||||
(match-end 0)
|
||||
0))
|
||||
(item-len (length item))
|
||||
(item-end (or (string-match-p trim-right-re item item-beg)
|
||||
item-len)))
|
||||
(when (or (> item-beg 0) (< item-end item-len))
|
||||
(setq item (substring item item-beg item-end)))))
|
||||
(when (or keep-empty (not (equal item "")))
|
||||
(push item acc)))
|
||||
(nreverse acc)))
|
||||
|
||||
(defalias 'string-split #'split-string)
|
||||
|
||||
|
|
|
|||
|
|
@ -1539,7 +1539,75 @@ final or penultimate step during initialization."))
|
|||
(should (equal (split-string text seps t trim)
|
||||
'("lexical-binding: t;")))
|
||||
(should (equal (split-string text "[ \t\n\r-]*-\\*-[ \t\n\r-]*")
|
||||
'("" "lexical-binding: t;" "")))))
|
||||
'("" "lexical-binding: t;" ""))))
|
||||
|
||||
;; splitting the empty string
|
||||
(should (equal (split-string "" ",") '("")))
|
||||
(should (equal (split-string "" "," t) '()))
|
||||
(should (equal (split-string "," ",") '("" "")))
|
||||
(should (equal (split-string "," "," t) '()))
|
||||
(should (equal (split-string ",," ",") '("" "" "")))
|
||||
(should (equal (split-string ",," "," t) '()))
|
||||
(should (equal (split-string ",," ",+") '("" "")))
|
||||
(should (equal (split-string ",," ",+" t) '()))
|
||||
|
||||
;; simple
|
||||
(should (equal (split-string "A" ",") '("A")))
|
||||
(should (equal (split-string "A," ",") '("A" "")))
|
||||
(should (equal (split-string "A," "," t) '("A")))
|
||||
(should (equal (split-string "A,B" ",") '("A" "B")))
|
||||
|
||||
(should (equal (split-string ",A,B,,CD" ",") '("" "A" "B" "" "CD")))
|
||||
(should (equal (split-string ",A,B,,CD" "," t) '("A" "B" "CD")))
|
||||
(should (equal (split-string ",A,B,,CD" ",+") '("" "A" "B" "CD")))
|
||||
(should (equal (split-string ",A,B,,CD" ",+" t) '("A" "B" "CD")))
|
||||
|
||||
;; TRIM
|
||||
(should (equal (split-string "---,---A---,---B---,---,---C---D---"
|
||||
",+" nil "-")
|
||||
'("-" "--A--" "--B--" "-" "--C---D--")))
|
||||
(should (equal (split-string "---,---A---,---B---,---,---C---D---"
|
||||
",+" nil "-+")
|
||||
'("" "A" "B" "" "C---D")))
|
||||
(should (equal (split-string "---,---A---,---B---,---,---C---D---"
|
||||
",+" t "-+")
|
||||
'("A" "B" "C---D")))
|
||||
(should (equal (split-string "---,---A---,---B---,---,---C---D---,"
|
||||
",+" nil "-")
|
||||
'("-" "--A--" "--B--" "-" "--C---D--" "")))
|
||||
(should (equal (split-string "---,---A---,---B---,---,---C---D---,"
|
||||
",+" nil "-+")
|
||||
'("" "A" "B" "" "C---D" "")))
|
||||
(should (equal (split-string "---,---A---,---B---,---,---C---D---,"
|
||||
",+" t "-+")
|
||||
'("A" "B" "C---D")))
|
||||
|
||||
;; default SEPARATORS forces OMIT-NULLS to `t'
|
||||
(should (equal (split-string " \nAB\tCDE\f\r\fF \f\v")
|
||||
'("AB" "CDE" "F")))
|
||||
|
||||
;; complex TRIM
|
||||
(should (equal (split-string "A--,--B,//C,D//,E//F,G--H,//I--//J--,//--//--"
|
||||
"," nil "--\\|//")
|
||||
'("A" "B" "C" "D" "E//F" "G--H" "I--//J" "--//")))
|
||||
|
||||
;; TRIM that also matches part of SEPARATORS
|
||||
(should (equal (split-string "-/-A-B-/-C--/--D--" "-/-" nil nil)
|
||||
'("" "A-B" "C-" "-D--")))
|
||||
(should (equal (split-string "-/-A-B-/-C--/--D--" "-/-" nil "-")
|
||||
'("" "A-B" "C" "D-")))
|
||||
(should (equal (split-string "-/-A-B-/-C--/--D--" "-/-" nil "-+")
|
||||
'("" "A-B" "C" "D")))
|
||||
|
||||
;; When SEPARATORS is the empty string, split on characters and add
|
||||
;; empty strings first and last because that's how the original
|
||||
;; implementation worked. Some code actually uses this on purpose (!) so
|
||||
;; we probably need to retain that behaviour for a while.
|
||||
(should (equal (split-string "ABC" "")
|
||||
'("" "A" "B" "C" "")))
|
||||
(should (equal (split-string "ABC" "" t)
|
||||
'("A" "B" "C")))
|
||||
)
|
||||
|
||||
(defun subr--identity (x) x)
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue