perf: rebuild shadow patch output in one pass
This commit is contained in:
Kinneyzhang
parent
c05174ff9d
commit
b2b9462269
@ -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
|
||||
|
||||
@ -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)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user