From b2b9462269ab290872819c6c728edfd8df5e36b1 Mon Sep 17 00:00:00 2001 From: Kinneyzhang Date: Sat, 5 Sep 2026 06:53:10 +0800 Subject: [PATCH] perf: rebuild shadow patch output in one pass --- tests/tp-surface-tests.el | 202 ++++++++++++++++++++++++++++++++++++++ tp-surface.el | 17 ++-- 2 files changed, 212 insertions(+), 7 deletions(-) diff --git a/tests/tp-surface-tests.el b/tests/tp-surface-tests.el index 53963cc..35bf01b 100644 --- a/tests/tp-surface-tests.el +++ b/tests/tp-surface-tests.el @@ -39,6 +39,37 @@ (error condition) (quit condition))) +(defun tp-surface-test--shadow-apply-commit-batch-oracle (string batch) + "Return the former exact replay result for STRING and BATCH." + (let ((result (copy-sequence string))) + (dolist (patch (reverse (tp-commit-batch-patches batch))) + (setq result + (concat (substring result 0 (plist-get patch :old-start)) + (plist-get patch :replacement) + (substring result (plist-get patch :old-end))))) + result)) + +(defun tp-surface-test--source-function (name) + "Return interpreted NAME from the current tp-surface.el source." + (let ((source + (expand-file-name + "tp-surface.el" + (file-name-directory (or (locate-library "tp-surface") + (error "Cannot locate tp-surface"))))) + definition) + (with-temp-buffer + (insert-file-contents source) + (condition-case nil + (while (not definition) + (let ((form (read (current-buffer)))) + (when (and (eq (car-safe form) 'defun) + (eq (cadr form) name)) + (setq definition form)))) + (end-of-file nil))) + (unless definition + (error "Cannot find source definition for %S" name)) + (eval `(lambda ,(nth 2 definition) ,@(nthcdr 3 definition)) t))) + (defun tp-surface-test--update-mode (mode surface object plan signal value) "Update SURFACE in MODE with PLAN while touching SIGNAL to VALUE." (tp-with-transaction @@ -107,6 +138,177 @@ (tp-surface-client-state surface)))) (should-error (tp-surface-commit-batch surface batch))))) +(ert-deftest tp-surface-test-shadow-batch-replay-preserves-exact-properties () + "Shadow replay preserves Unicode, properties, order, and input ownership." + (let* ((opaque (make-symbol "owner")) + (base (propertize (concat "A" "乙丙丁戊") + 'owner opaque 'face '(bold))) + (insertion (propertize (concat "a" "β") + 'owner opaque 'face '(italic))) + (replacement + (propertize (copy-sequence "Q") + 'owner opaque 'display '(space :width 2))) + (batch + (tp-commit-batch-create + :base-revision 0 :target-revision 1 + :base-extent 5 :target-extent 5 + :patches + (list + (list :old-start 0 :old-end 0 :new-start 0 :new-end 2 + :replacement insertion) + (list :old-start 1 :old-end 3 :new-start 3 :new-end 3 + :replacement "") + (list :old-start 4 :old-end 5 :new-start 4 :new-end 5 + :replacement replacement)))) + (expected + (concat insertion (substring base 0 1) + (substring base 3 4) replacement)) + (result (tp--shadow-apply-commit-batch-to-string base batch))) + (should (equal-including-properties expected result)) + (should (eq opaque (get-text-property 0 'owner result))) + (aset base 0 ?X) + (aset insertion 0 ?z) + (aset replacement 0 ?R) + (should (equal-including-properties expected result)))) + +(ert-deftest tp-surface-test-shadow-batch-replay-preserves-adjacent-inserts () + "Zero-width patches at one old coordinate retain declared list order." + (let* ((first (propertize "α" 'face 'bold)) + (second (propertize "乙" 'face 'italic)) + (batch + (tp-commit-batch-create + :base-revision 0 :target-revision 1 + :base-extent 0 :target-extent 2 + :patches + (list + (list :old-start 0 :old-end 0 :new-start 0 :new-end 1 + :replacement first) + (list :old-start 0 :old-end 0 :new-start 1 :new-end 2 + :replacement second)) + :coordinate-patches + '((:old-start 0 :old-end 0 :new-start 0 :new-end 1) + (:old-start 0 :old-end 0 :new-start 1 :new-end 2))))) + (let ((result (tp--shadow-apply-commit-batch-to-string "" batch))) + (should (equal-including-properties (concat first second) result)) + (should (eq (get-text-property 0 'face result) 'bold)) + (should (eq (get-text-property 1 'face result) 'italic))))) + +(ert-deftest tp-surface-test-shadow-batch-replay-no-patches-copies-input () + "No-patch shadow replay returns an independently mutable string." + (let* ((base (copy-sequence "value")) + (batch + (tp-commit-batch-create + :base-revision 0 :target-revision 1 + :base-extent 5 :target-extent 5)) + (result (tp--shadow-apply-commit-batch-to-string base batch))) + (should (equal base result)) + (should-not (eq base result)) + (aset result 0 ?X) + (should (equal base "value")))) + +(ert-deftest tp-surface-test-shadow-batch-replay-matches-oracle () + "Single-pass replay matches the former exact algorithm over varied patches." + (let ((cases + '(("abcdef" ((0 0 "α") (1 3 "XY") (6 6 "尾"))) + ("abcdef" ((0 6 "") (6 6 "新值"))) + ("abcdef" ((1 2 "") (2 2 "二") (4 5 "四五六")))))) + (dolist (case cases) + (let ((old-cursor 0) (new-cursor 0) patches) + (dolist (spec (cadr case)) + (pcase-let ((`(,old-start ,old-end ,replacement) spec)) + (let ((new-start (+ new-cursor (- old-start old-cursor))) + (new-end + (+ new-cursor (- old-start old-cursor) + (length replacement)))) + (push (list :old-start old-start :old-end old-end + :new-start new-start :new-end new-end + :replacement replacement) + patches) + (setq old-cursor old-end new-cursor new-end)))) + (setq patches (nreverse patches)) + (let* ((base (car case)) + (target-extent (+ new-cursor (- (length base) old-cursor))) + (coordinates + (mapcar + (lambda (patch) + (list :old-start (plist-get patch :old-start) + :old-end (plist-get patch :old-end) + :new-start (plist-get patch :new-start) + :new-end (plist-get patch :new-end))) + patches)) + (batch + (tp-commit-batch-create + :base-revision 0 :target-revision 1 + :base-extent (length base) :target-extent target-extent + :patches patches :coordinate-patches coordinates))) + (should + (equal-including-properties + (tp-surface-test--shadow-apply-commit-batch-oracle base batch) + (tp--shadow-apply-commit-batch-to-string base batch)))))))) + +(ert-deftest tp-surface-test-shadow-batch-replay-work-is-linear () + "Replay slices the base once and concatenates exactly the target extent." + (let* ((patch-count 512) + (base (make-string (* patch-count 2) ?a)) + patches + (old 0) + (new 0)) + (dotimes (index patch-count) + (push (list :old-start old :old-end (1+ old) + :new-start new :new-end (+ new 2) + :replacement (if (zerop (% index 2)) "甲乙" "αβ")) + patches) + (setq old (+ old 2) new (+ new 3))) + (let* ((patches (nreverse patches)) + (target-extent (+ new (- (length base) old))) + (coordinates + (mapcar + (lambda (patch) + (list :old-start (plist-get patch :old-start) + :old-end (plist-get patch :old-end) + :new-start (plist-get patch :new-start) + :new-end (plist-get patch :new-end))) + patches)) + (batch + (tp-commit-batch-create + :base-revision 0 :target-revision 1 + :base-extent (length base) :target-extent target-extent + :patches patches :coordinate-patches coordinates)) + (source-function + (tp-surface-test--source-function + 'tp--shadow-apply-commit-batch-to-string)) + (real-substring (symbol-function 'substring)) + (real-concat (symbol-function 'concat)) + (substring-count 0) + (substring-output 0) + (concat-count 0) + (concat-input 0) + recording) + (cl-letf (((symbol-function 'substring) + (lambda (string start &optional end) + (let ((result (funcall real-substring string start end))) + (when recording + (cl-incf substring-count) + (cl-incf substring-output (length result))) + result))) + ((symbol-function 'concat) + (lambda (&rest sequences) + (when recording + (cl-incf concat-count) + (cl-incf concat-input + (apply #'+ (mapcar #'length sequences)))) + (apply real-concat sequences)))) + (let ((result + (progn + (setq recording t) + (prog1 (funcall source-function base batch) + (setq recording nil))))) + (should (= (length result) target-extent)))) + (should (= substring-count (1+ patch-count))) + (should (<= substring-output (length base))) + (should (= concat-count 1)) + (should (= concat-input target-extent))))) + (ert-deftest tp-surface-test-producer-can-return-equal-coordinate-batch () "A retained producer can publish a strict batch through normal TP phases." (tp-surface-test--with-buffer diff --git a/tp-surface.el b/tp-surface.el index 7e17fc7..b67a701 100644 --- a/tp-surface.el +++ b/tp-surface.el @@ -3406,13 +3406,16 @@ When RETAIN-MARKERS is non-nil, keep snapshot markers for rollback." (defun tp--shadow-apply-commit-batch-to-string (string batch) "Return STRING with BATCH patches applied without touching a buffer." - (let ((result (copy-sequence string))) - (dolist (patch (reverse (tp-commit-batch-patches batch))) - (setq result - (concat (substring result 0 (plist-get patch :old-start)) - (plist-get patch :replacement) - (substring result (plist-get patch :old-end))))) - result)) + (let ((patches (tp-commit-batch-patches batch))) + (if (null patches) + (copy-sequence string) + (let ((cursor 0) pieces) + (dolist (patch patches) + (push (substring string cursor (plist-get patch :old-start)) pieces) + (push (plist-get patch :replacement) pieces) + (setq cursor (plist-get patch :old-end))) + (push (substring string cursor) pieces) + (apply #'concat (nreverse pieces)))))) (defun tp--shadow-apply-property-operations-to-string (string base operations)