geekinney/tp
1
0
Fork 0
Code Issues Pull Requests Actions 2 Packages Projects Releases Wiki Activity

Reject length-changing string replacements instead of corrupting

Browse Source 
tp--replace-match-text's string branch silently truncated longer
replacements and left residue on shorter ones ("<foo>" into a 3-char
match yielded "<fo"). Strings cannot change length in place, so the
honest contract is: same-length replacements mutate in place as before;
a different-length replacement signals a clear error directing the
caller to a buffer OBJECT. Buffer paths (delete+insert) are unchanged.
Updates the five tests that codified truncation/residue and adds a
same-length regression test; suite 439/439 green.

Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
This commit is contained in:
Kinneyzhang 2026-07-26 20:12:37 +08:00
parent ceb0dfb0bc
commit 9aca18979b
3 changed files with 60 additions and 48 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

8
CHANGELOG.md
View File

@ -125,10 +125,12 @@ Search and navigation (tp-search):
(`tp-test-backward`) was updated to the symmetric contract.
- Empty and zero-width patterns no longer loop forever in the
match/regexp apply engines.
- Length-changing replacements work in `tp-forward-do` /
- Length-changing replacements work in buffers in `tp-forward-do` /
`tp-backward-do` / `tp-search-map` (previously signaled
`args-out-of-range` via `store-substring`); buffers are edited via
markers, strings are rebuilt.
`args-out-of-range` via `store-substring`). On strings — which cannot
change length in place — a length-changing replacement signals a
clear error instead of silently truncating or leaving residue;
same-length string replacements are unchanged.
- `tp-search-map` with a non-current buffer OBJECT operates on that
buffer (previously read and mutated the current buffer) and no longer
corrupts buffers on length-changing replacements.

80
tp-search-tests.el
View File

@ -117,48 +117,58 @@ the end of the string."
(should (equal (substring-no-properties result) "axb"))
(should (eq (get-text-property 1 'face result) 'bold))))
;;; B39: longer replacements are truncated, not args-out-of-range
;;; B39: length-changing replacements error on strings, work in buffers
(ert-deftest tp-search-test-forward-do-longer-replacement-truncates ()
"A replacement longer than the match is truncated on strings.
The old code passed the full replacement to `store-substring', which
signals args-out-of-range when it extends past the string end."
(ert-deftest tp-search-test-forward-do-longer-replacement-errors ()
"A replacement longer than the match signals a clear error on strings.
Strings cannot change length in place; the old code silently truncated
(or signaled args-out-of-range past the string end). The string is
left unchanged."
(let ((str (copy-sequence "hello world")))
(tp-set 6 11 '(marker t) str)
(tp-forward-do (lambda (txt) (concat (upcase txt) "XYZ"))
'marker nil str)
(should (equal (substring-no-properties str) "hello WORLD"))))
(ert-deftest tp-search-test-forward-do-longer-replacement-no-clobber ()
"A longer in-bounds replacement must not clobber text after the match."
(let ((str (copy-sequence "hello world")))
(tp-set 0 5 '(marker t) str)
(tp-forward-do (lambda (txt) (concat txt txt)) 'marker nil str)
;; Old code silently wrote 10 chars, yielding "hellohellod".
(should-error (tp-forward-do (lambda (txt) (concat (upcase txt) "XYZ"))
'marker nil str))
(should (equal (substring-no-properties str) "hello world"))))
(ert-deftest tp-search-test-backward-do-longer-replacement-truncates ()
"tp-backward-do truncates longer replacements on strings."
(let ((str (copy-sequence "hello world")))
(tp-set 6 11 '(marker t) str)
(tp-backward-do (lambda (txt) (concat (upcase txt) "12345"))
'marker nil str)
(should (equal (substring-no-properties str) "hello WORLD"))))
(ert-deftest tp-search-test-search-map-longer-replacement-truncates ()
"tp-search-map truncates longer replacements on strings."
(let ((str (copy-sequence "hello world")))
(tp-set 6 11 '(marker t) str)
(tp-search-map (lambda (txt) (concat (upcase txt) "!!!"))
'marker nil str)
(should (equal (substring-no-properties str) "hello WORLD"))))
(ert-deftest tp-search-test-forward-do-shorter-replacement-partial ()
"A shorter replacement only replaces that portion (documented)."
(ert-deftest tp-search-test-forward-do-longer-in-bounds-errors ()
"A longer in-bounds replacement errors instead of clobbering.
Old code silently wrote 10 chars, yielding \"hellohellod\"."
(let ((str (copy-sequence "hello world")))
(tp-set 0 5 '(marker t) str)
(tp-forward-do (lambda (_txt) "AB") 'marker nil str)
(should (equal (substring-no-properties str) "ABllo world"))))
(should-error (tp-forward-do (lambda (txt) (concat txt txt))
'marker nil str))
(should (equal (substring-no-properties str) "hello world"))))
(ert-deftest tp-search-test-backward-do-longer-replacement-errors ()
"tp-backward-do rejects length-changing replacements on strings."
(let ((str (copy-sequence "hello world")))
(tp-set 6 11 '(marker t) str)
(should-error (tp-backward-do (lambda (txt) (concat (upcase txt) "12345"))
'marker nil str))
(should (equal (substring-no-properties str) "hello world"))))
(ert-deftest tp-search-test-search-map-longer-replacement-errors ()
"tp-search-map rejects length-changing replacements on strings."
(let ((str (copy-sequence "hello world")))
(tp-set 6 11 '(marker t) str)
(should-error (tp-search-map (lambda (txt) (concat (upcase txt) "!!!"))
'marker nil str))
(should (equal (substring-no-properties str) "hello world"))))
(ert-deftest tp-search-test-forward-do-shorter-replacement-errors ()
"A shorter replacement errors instead of leaving residue (\"ABllo\")."
(let ((str (copy-sequence "hello world")))
(tp-set 0 5 '(marker t) str)
(should-error (tp-forward-do (lambda (_txt) "AB") 'marker nil str))
(should (equal (substring-no-properties str) "hello world"))))
(ert-deftest tp-search-test-search-map-same-length-string-ok ()
"Same-length replacements still mutate the string in place."
(let ((str (copy-sequence "hello world hello")))
(tp-set 0 5 '(marker t) str)
(tp-set 12 17 '(marker t) str)
(should (= (tp-search-map #'upcase 'marker nil str) 2))
(should (equal (substring-no-properties str) "HELLO world HELLO"))))
(ert-deftest tp-search-test-forward-do-buffer-longer-replacement-grows ()
"Buffers may grow on longer replacements (delete-region + insert).

20
tp-search.el
View File

@ -448,16 +448,16 @@ Any non-string return value leaves OBJ untouched."
(t (funcall function text)))))
(when (stringp new-text)
(if (stringp obj)
;; For strings: copy text content and properties separately
(let ((len (min (length new-text) (- m-end m-start))))
;; Copy text content, truncated to the available room so a
;; longer replacement cannot overflow the string (which
;; would clobber text after the match or signal
;; args-out-of-range).
(store-substring obj m-start
(if (> (length new-text) len)
(substring new-text 0 len)
new-text))
;; For strings: copy text content and properties separately.
;; A string cannot change length in place, so a replacement
;; of a different length would silently corrupt the text
;; (truncation or residue); reject it clearly instead.
(let ((len (- m-end m-start)))
(unless (= (length new-text) len)
(error "tp: replacement %S is %d chars but the match is %d; \
strings cannot change length in place -- use a buffer OBJECT for \
length-changing replacements" new-text (length new-text) len))
(store-substring obj m-start new-text)
;; Copy properties from new-text to obj. Ranges with nil
;; properties are copied too, so FUNCTION can REMOVE
;; properties by returning a stripped string.