From 9aca18979b7a55ca0983668dbac4257aaee28166 Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Sun, 26 Jul 2026 20:12:37 +0800 Subject: [PATCH] Reject length-changing string replacements instead of corrupting tp--replace-match-text's string branch silently truncated longer replacements and left residue on shorter ones ("" into a 3-char match yielded " --- CHANGELOG.md | 8 +++-- tp-search-tests.el | 80 ++++++++++++++++++++++++++-------------------- tp-search.el | 20 ++++++------ 3 files changed, 60 insertions(+), 48 deletions(-) diff --git a/CHANGELOG.md b/CHANGELOG.md index e8fbfa7..3597e23 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -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. diff --git a/tp-search-tests.el b/tp-search-tests.el index ab041ba..611ef73 100644 --- a/tp-search-tests.el +++ b/tp-search-tests.el @@ -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). diff --git a/tp-search.el b/tp-search.el index 0e02a0b..5f28951 100644 --- a/tp-search.el +++ b/tp-search.el @@ -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.