ceb0dfb0bc
35 fixes across tp-layer.el, tp-stack.el, tp-search.el, tp-reactive.el and tp-render.el, each empirically reproduced before and after: layer-definition resolution/cycles/copying/cleanup, clipped region-local stack mutators, symmetric backward search matching, length-changing replacements, and reactive re-render correctness (replace-not-accumulate, buffer-local isolation, batching union, per-interval props). Adds four per-module regression suites (100 new tests); combined suite is 438/438 green. tp-test-backward updated to the now-symmetric backward matching contract it previously codified inverted. The string-vs-buffer shortfall divergence in tp-forward-do/tp-backward-do is documented in CHANGELOG as a known divergence rather than changed. Adds CHANGELOG.md. Co-Authored-By: Claude Fable 5 <noreply@anthropic.com>
333 lines
14 KiB
EmacsLisp
333 lines
14 KiB
EmacsLisp
;;; tp-search-tests.el --- ERT regression tests for tp-search.el -*- lexical-binding: t -*-
|
|
|
|
;;; Commentary:
|
|
|
|
;; Regression tests for confirmed bugs fixed in the search module
|
|
;; (tp-search.el). Each section is tagged with the canonical bug id
|
|
;; it guards against.
|
|
|
|
;;; Code:
|
|
|
|
(require 'ert)
|
|
(require 'tp)
|
|
|
|
;;; B37: backward searches must use `equal' matching like tp-forward
|
|
|
|
(ert-deftest tp-search-test-backward-value-matches-forward ()
|
|
"tp-backward with a non-nil VALUE finds the same region tp-forward finds.
|
|
The old code passed no predicate to `text-property-search-backward',
|
|
whose default matches values NOT `equal' to VALUE (inverted)."
|
|
(with-temp-buffer
|
|
(insert "aaa bbb aaa ")
|
|
(put-text-property 1 4 'k 'x)
|
|
(put-text-property 5 8 'k 'y)
|
|
(put-text-property 9 12 'k 'x)
|
|
(goto-char (point-min))
|
|
(let ((fwd (tp-forward 'k 'y)))
|
|
(should fwd)
|
|
(should (equal (list (prop-match-beginning fwd)
|
|
(prop-match-end fwd)
|
|
(prop-match-value fwd))
|
|
'(5 8 y))))
|
|
(goto-char (point-max))
|
|
(let ((bwd (tp-backward 'k 'y)))
|
|
(should bwd)
|
|
(should (equal (list (prop-match-beginning bwd)
|
|
(prop-match-end bwd)
|
|
(prop-match-value bwd))
|
|
'(5 8 y))))))
|
|
|
|
(ert-deftest tp-search-test-backward-value-adjacent-regions ()
|
|
"tp-backward finds a matching region among adjacent (gap-free) runs."
|
|
(with-temp-buffer
|
|
(insert "aaabbbccc")
|
|
(put-text-property 1 4 'k 'x)
|
|
(put-text-property 4 7 'k 'y)
|
|
(put-text-property 7 10 'k 'x)
|
|
(goto-char (point-max))
|
|
(let ((m (tp-backward 'k 'y)))
|
|
(should m)
|
|
(should (= (prop-match-beginning m) 4))
|
|
(should (= (prop-match-end m) 7))
|
|
(should (eq (prop-match-value m) 'y)))))
|
|
|
|
(ert-deftest tp-search-test-backward-value-n-walks-regions ()
|
|
"tp-backward with N=2 walks two matching regions backward."
|
|
(with-temp-buffer
|
|
(insert "aaa bbb aaa ")
|
|
(put-text-property 1 4 'k 'x)
|
|
(put-text-property 5 8 'k 'x)
|
|
(put-text-property 9 12 'k 'x)
|
|
(goto-char (point-max))
|
|
(let ((m (tp-backward 'k 'x nil 2)))
|
|
(should m)
|
|
(should (= (prop-match-beginning m) 5)))))
|
|
|
|
(ert-deftest tp-search-test-backward-value-no-match-returns-nil ()
|
|
"tp-backward returns nil when no region has an `equal' value."
|
|
(with-temp-buffer
|
|
(insert "aaa bbb")
|
|
(put-text-property 1 4 'k 'x)
|
|
(goto-char (point-max))
|
|
(should (null (tp-backward 'k 'missing)))))
|
|
|
|
(ert-deftest tp-search-test-backward-do-value-buffer ()
|
|
"tp-backward-do with a non-nil VALUE rewrites the matching region."
|
|
(with-temp-buffer
|
|
(insert "aaa bbb aaa ")
|
|
(put-text-property 1 4 'k 'x)
|
|
(put-text-property 5 8 'k 'y)
|
|
(put-text-property 9 12 'k 'x)
|
|
(let ((count (tp-backward-do #'upcase 'k 'y)))
|
|
(should (= count 1))
|
|
(should (equal (buffer-substring-no-properties 1 13)
|
|
"aaa BBB aaa ")))))
|
|
|
|
;;; B38: zero-width patterns must not loop forever in buffer branches
|
|
|
|
(ert-deftest tp-search-test-match-empty-pattern-buffer-terminates ()
|
|
"tp-match-set with an empty literal pattern terminates on buffers."
|
|
(with-temp-buffer
|
|
(insert "abc")
|
|
(let ((regions (tp-match-set "" '(face bold))))
|
|
;; Zero-width matches are recorded at each position, like the
|
|
;; string branch records them.
|
|
(should (equal regions '((1 . 1) (2 . 2) (3 . 3) (4 . 4)))))))
|
|
|
|
(ert-deftest tp-search-test-regexp-zero-width-buffer-terminates ()
|
|
"tp-regexp-set with a regexp matching empty terminates on buffers."
|
|
(with-temp-buffer
|
|
(insert "axbxc")
|
|
(let ((regions (tp-regexp-set "x*" '(face bold))))
|
|
(should regions)
|
|
;; The actual x's still got their property.
|
|
(should (eq (get-text-property 2 'face) 'bold))
|
|
(should (eq (get-text-property 4 'face) 'bold)))))
|
|
|
|
(ert-deftest tp-search-test-match-empty-pattern-string-clean ()
|
|
"tp-match-set with an empty pattern on a string no-ops cleanly.
|
|
The old string branch signaled args-out-of-range after scanning past
|
|
the end of the string."
|
|
(let ((result (tp-match-set "" '(face bold) "abc")))
|
|
(should (equal result "abc"))))
|
|
|
|
(ert-deftest tp-search-test-regexp-zero-width-string-clean ()
|
|
"tp-regexp-set with a zero-width-capable regexp works on strings."
|
|
(let ((result (tp-regexp-set "x*" '(face bold) "axb")))
|
|
(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
|
|
|
|
(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."
|
|
(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 (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)."
|
|
(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"))))
|
|
|
|
(ert-deftest tp-search-test-forward-do-buffer-longer-replacement-grows ()
|
|
"Buffers may grow on longer replacements (delete-region + insert).
|
|
Uses an explicit VALUE: the buffer paths of the -do functions match
|
|
with predicate t, where VALUE nil matches property-absent runs."
|
|
(with-temp-buffer
|
|
(insert "hello world")
|
|
(put-text-property 1 6 'marker t)
|
|
(tp-forward-do (lambda (txt) (concat txt txt)) 'marker t)
|
|
(should (equal (buffer-substring-no-properties (point-min) (point-max))
|
|
"hellohello world"))))
|
|
|
|
;;; B40: tp-search-map must operate on OBJECT, not the current buffer
|
|
|
|
(ert-deftest tp-search-test-search-map-non-current-buffer ()
|
|
"tp-search-map with a buffer OBJECT mutates that buffer only."
|
|
(let ((target (generate-new-buffer " tp-search-test-target")))
|
|
(unwind-protect
|
|
(progn
|
|
(with-current-buffer target
|
|
(insert "aaa bbb")
|
|
(put-text-property 1 4 'marker t))
|
|
(with-temp-buffer
|
|
(insert "current buffer text")
|
|
(let ((count (tp-search-map #'upcase 'marker nil target)))
|
|
(should (= count 1)))
|
|
;; Current buffer untouched.
|
|
(should (equal (buffer-string) "current buffer text")))
|
|
;; Target buffer modified.
|
|
(should (equal (with-current-buffer target
|
|
(buffer-substring-no-properties (point-min)
|
|
(point-max)))
|
|
"AAA bbb")))
|
|
(kill-buffer target))))
|
|
|
|
(ert-deftest tp-search-test-search-do-non-current-buffer-bounds ()
|
|
"tp--search-do computes default bounds in OBJECT, not the current buffer."
|
|
(let ((target (generate-new-buffer " tp-search-test-target2")))
|
|
(unwind-protect
|
|
(progn
|
|
(with-current-buffer target
|
|
(insert "aaa bbb ccc")
|
|
(put-text-property 9 12 'marker t))
|
|
(with-temp-buffer
|
|
;; Current buffer is much shorter than the target.
|
|
(insert "x")
|
|
(let ((seen nil))
|
|
(tp--search-do (lambda (match _obj) (push match seen))
|
|
'marker nil target)
|
|
(should (equal seen '((9 12 t)))))))
|
|
(kill-buffer target))))
|
|
|
|
;;; B41: length-changing replacements over multiple matches
|
|
|
|
(ert-deftest tp-search-test-search-map-growing-replacements ()
|
|
"Growing replacements do not corrupt later match positions."
|
|
(with-temp-buffer
|
|
(insert "aaa bbb ccc")
|
|
(put-text-property 1 4 'marker t)
|
|
(put-text-property 5 8 'marker t)
|
|
(put-text-property 9 12 'marker t)
|
|
(let ((count (tp-search-map (lambda (_txt) "XXXXXX") 'marker nil nil)))
|
|
(should (= count 3))
|
|
(should (equal (buffer-substring-no-properties (point-min) (point-max))
|
|
"XXXXXX XXXXXX XXXXXX")))))
|
|
|
|
(ert-deftest tp-search-test-search-map-shrinking-replacements ()
|
|
"Shrinking replacements do not corrupt later match positions."
|
|
(with-temp-buffer
|
|
(insert "aaa bbb ccc")
|
|
(put-text-property 1 4 'marker t)
|
|
(put-text-property 5 8 'marker t)
|
|
(put-text-property 9 12 'marker t)
|
|
(tp-search-map (lambda (_txt) "-") 'marker nil nil)
|
|
(should (equal (buffer-substring-no-properties (point-min) (point-max))
|
|
"- - -"))))
|
|
|
|
(ert-deftest tp-search-test-search-map-mixed-length-positions ()
|
|
"Callbacks see up-to-date positions after earlier length changes."
|
|
(with-temp-buffer
|
|
(insert "aaa bbb ccc")
|
|
(put-text-property 1 4 'marker t)
|
|
(put-text-property 5 8 'marker t)
|
|
(put-text-property 9 12 'marker t)
|
|
(let ((texts nil))
|
|
(tp-search-map (lambda (txt _start _end idx)
|
|
(push txt texts)
|
|
(format "<%d>%s" idx txt))
|
|
'marker nil nil)
|
|
;; Each callback received the intact matched text, not garbage
|
|
;; from stale positions.
|
|
(should (equal (nreverse texts) '("aaa" "bbb" "ccc")))
|
|
(should (equal (buffer-substring-no-properties (point-min) (point-max))
|
|
"<0>aaa <1>bbb <2>ccc")))))
|
|
|
|
;;; B42: tp-match-add / tp-regexp-add preserve existing faces in buffers
|
|
|
|
(ert-deftest tp-search-test-match-add-buffer-preserves-face ()
|
|
"tp-match-add on a buffer merges faces instead of replacing them."
|
|
(with-temp-buffer
|
|
(insert "hello")
|
|
(put-text-property 1 6 'face 'italic)
|
|
(tp-match-add "hello" '(face bold))
|
|
(should (equal (get-text-property 1 'face) '(bold italic)))))
|
|
|
|
(ert-deftest tp-search-test-match-add-face-string-buffer-parity ()
|
|
"tp-match-add merges faces identically for strings and buffers."
|
|
(let* ((str (propertize "hello" 'face 'italic))
|
|
(str-face (get-text-property 0 'face
|
|
(tp-match-add "hello" '(face bold) str)))
|
|
(buf-face (with-temp-buffer
|
|
(insert "hello")
|
|
(put-text-property 1 6 'face 'italic)
|
|
(tp-match-add "hello" '(face bold))
|
|
(get-text-property 1 'face))))
|
|
(should (equal str-face buf-face))
|
|
(should (equal buf-face '(bold italic)))))
|
|
|
|
(ert-deftest tp-search-test-regexp-add-buffer-preserves-face ()
|
|
"tp-regexp-add on a buffer merges faces instead of replacing them."
|
|
(with-temp-buffer
|
|
(insert "abc 123")
|
|
(put-text-property 5 8 'face 'underline)
|
|
(tp-regexp-add "[0-9]+" '(face bold))
|
|
(should (equal (get-text-property 5 'face) '(bold underline)))))
|
|
|
|
(ert-deftest tp-search-test-match-add-buffer-non-face-deep-merge ()
|
|
"tp-match-add still deep-merges non-face plist properties in buffers."
|
|
(with-temp-buffer
|
|
(insert "hello")
|
|
(put-text-property 1 6 'data '(:a 1))
|
|
(tp-match-add "hello" '(data (:b 2)))
|
|
(let ((val (get-text-property 1 'data)))
|
|
(should (equal (plist-get val :a) 1))
|
|
(should (equal (plist-get val :b) 2)))))
|
|
|
|
;;; B44: property removal through tp-search-map on strings
|
|
|
|
(ert-deftest tp-search-test-search-map-removes-props-on-string ()
|
|
"A callback returning a stripped string removes properties."
|
|
(let ((str (copy-sequence "hello world")))
|
|
(tp-set 0 5 '(marker t face bold) str)
|
|
(tp-search-map (lambda (txt) (substring-no-properties txt))
|
|
'marker nil str)
|
|
(should (null (text-properties-at 0 str)))
|
|
(should (equal (substring-no-properties str) "hello world"))))
|
|
|
|
(ert-deftest tp-search-test-search-map-removes-single-prop-on-string ()
|
|
"A callback removing one property keeps the others."
|
|
(let ((str (copy-sequence "hello world")))
|
|
(tp-set 0 5 '(marker t face bold) str)
|
|
(tp-search-map (lambda (txt)
|
|
(remove-text-properties 0 (length txt) '(face nil) txt)
|
|
txt)
|
|
'marker nil str)
|
|
(should (null (get-text-property 0 'face str)))
|
|
(should (eq (get-text-property 0 'marker str) t))))
|
|
|
|
;;; Guard: nil return still means "no replacement" (used by tp-render)
|
|
|
|
(ert-deftest tp-search-test-search-map-nil-return-no-replacement ()
|
|
"A callback returning nil leaves text and properties untouched."
|
|
(let ((str (copy-sequence "hello world")))
|
|
(tp-set 0 5 '(marker t face bold) str)
|
|
(let ((count (tp-search-map (lambda (_txt) nil) 'marker nil str)))
|
|
(should (= count 1))
|
|
(should (equal (substring-no-properties str) "hello world"))
|
|
(should (eq (get-text-property 0 'face str) 'bold)))))
|
|
|
|
(provide 'tp-search-tests)
|
|
;;; tp-search-tests.el ends here
|