ebox/tests/ebox-commit-tests.el
Kinneyzhang 7c21185215 merge: integrate retained native input with current main fixes
Reconcile duplicated native ancestry against the verified equivalent base. Preserve current source ownership, scroll partition, allocated owner rendering, and later retained-state repairs while adapting their consumers and existing fixtures to persistent runtime indexes.

Validation: strict byte compilation of 28 source files, static syntax across 56 Lisp files, cargo check, and native release build passed. Regression suites and benchmarks were not run at the user's direction.
2026-09-08 21:42:21 +08:00

5437 lines
268 KiB
EmacsLisp

;;; ebox-commit-tests.el --- Declarative commit smoke tests -*- lexical-binding: t; -*-
(require 'cl-lib)
(require 'ert)
(require 'ebox)
(require 'ebox-native-commit)
(require 'ebox-native-reflow)
;; These tests lock the named Elisp projection proofs. Native commit has its
;; own focused contract tests below; disable runtime module discovery here so
;; a locally built optional module cannot silently replace paint/span/mixed
;; plans with `native-frame' and make this suite environment-dependent.
(defvar ebox-native-reflow-module-path)
(setq ebox-native-reflow-module-path nil)
(defun ebox-commit-test--buffer-string (buffer)
"Return BUFFER's complete propertized contents."
(with-current-buffer buffer
(save-restriction
(widen)
(buffer-substring (point-min) (point-max)))))
(defun ebox-commit-test--count-root-renders (function)
"Return (RESULT . COUNT) for FUNCTION and its full-root render calls."
(let* ((count 0)
(observer (lambda (&rest _arguments) (cl-incf count))))
(advice-add 'ebox-surface--render-candidate :before observer)
(unwind-protect
(cons (funcall function) count)
(advice-remove 'ebox-surface--render-candidate observer))))
(defun ebox-commit-test--assert-full-render-equivalent ()
"Assert current buffer exactly matches its committed root's full render."
(let* ((state (ebox--buffer-render-state (current-buffer)))
(expected (ebox--render-node (plist-get state :root-node)
(plist-get state :source-index))))
(should (equal-including-properties expected (buffer-string)))))
(defun ebox-commit-test--face-value (face key)
"Return KEY from FACE whether FACE is one plist or a face stack."
(cond
((null face) nil)
((and (listp face) (keywordp (car face)))
(plist-get face key))
((listp face)
(cl-some (lambda (entry)
(ebox-commit-test--face-value entry key))
face))))
(defun ebox-commit-test--owner-proofs (proof)
"Return the uniform leaf-owner proof list represented by PROOF."
(or (plist-get proof :owner-proofs)
(and proof (list proof))))
(defun ebox-commit-test--observed-root (content)
"Return one stable declarative root containing CONTENT."
(ebox-test-box :key 'root (ebox-test-text content)))
(defun ebox-commit-test--scroll-sibling-root (content &optional nested)
"Return CONTENT beside an active scroll box, or inside it when NESTED."
(let ((label (ebox-test-text content :key 'label :source-identity 'label)))
(ebox-test-column :key 'root :width '(120)
(unless nested label)
(ebox-test-box :key 'scroll :id "scroll" :height 2 :width '(80)
:overflow 'scroll
(ebox-test-column
(when nested label)
(ebox-test-text "line-a\nline-b\nline-c\nline-d"
:key 'scroll-lines :source-identity 'scroll-lines
:color "#123456"))))))
(defun ebox-commit-test--replace-scroll-sibling-label (buffer content)
"Commit CONTENT into BUFFER's stable label host."
(let ((candidate (ebox-candidate-begin buffer)))
(ebox-candidate-replace-host-ref
candidate 'label
(ebox-test-text content :key 'label :source-identity 'label))
(ebox-commit buffer candidate)))
(ert-deftest ebox-commit-local-content-retains-disjoint-scroll ()
"An unrelated scroll box keeps its caches and registry across a local edit."
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer) (ebox-commit-test--scroll-sibling-root "old"))
(let* ((before (ebox--buffer-render-state (current-buffer)))
(scroll-id (car (plist-get before :scroll-region-ids)))
(old-scroll (gethash scroll-id ebox--scroll-global-state))
(raw (plist-get old-scroll :content-lines))
(rendered (plist-get old-scroll :rendered-content-lines))
(region-count (hash-table-count (plist-get before :region-box-table)))
(root-render (symbol-function 'ebox-surface--render-candidate))
(root-renders 0)
report)
(should scroll-id)
(cl-letf (((symbol-function 'ebox-surface--render-candidate)
(lambda (state)
(cl-incf root-renders)
(funcall root-render state))))
(setq report
(ebox-commit-test--replace-scroll-sibling-label
(current-buffer) "new")))
(should (memq (plist-get report :projection-kind) '(span-patch owner-scoped)))
(should (zerop root-renders))
(should-not (plist-get report :tp-full-root))
(let* ((after (ebox--buffer-render-state (current-buffer)))
(scroll (gethash scroll-id ebox--scroll-global-state)))
(should (= region-count (hash-table-count (plist-get after :region-box-table))))
(should (eq (plist-get scroll :box) (gethash scroll-id ebox--region-box-table)))
(should (eq raw (plist-get scroll :content-lines)))
(should (eq rendered (plist-get scroll :rendered-content-lines))))
(should (= 1 (ebox--scroll-region-by scroll-id 1)))
(should (string-match-p "new" (buffer-string)))
(should (string-match-p "line-c" (buffer-string)))
(should (= -1 (ebox--scroll-region-by scroll-id -1)))
(should (string-match-p "new" (buffer-string)))
(should (string-match-p "line-a" (buffer-string))))))
(ert-deftest ebox-commit-disjoint-scroll-rolls-back-with-local-content ()
"Late rejection restores both the local content and the scroll registry."
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer) (ebox-commit-test--scroll-sibling-root "old"))
(let* ((state (ebox--buffer-render-state (current-buffer)))
(scroll-id (car (plist-get state :scroll-region-ids)))
(scroll (gethash scroll-id ebox--scroll-global-state))
(box (gethash scroll-id ebox--region-box-table))
(before (buffer-string)))
(cl-letf (((symbol-function 'accept-change-group)
(lambda (_) (error "Reject local content publication"))))
(should-error
(ebox-commit-test--replace-scroll-sibling-label (current-buffer) "new")))
(should (eq state (ebox--buffer-render-state (current-buffer))))
(should (eq scroll (gethash scroll-id ebox--scroll-global-state)))
(should (eq box (gethash scroll-id ebox--region-box-table)))
(should (equal-including-properties before (buffer-string)))
(should (= 1 (ebox--scroll-region-by scroll-id 1)))
(should (string-match-p "old" (buffer-string)))
(ebox-commit-test--replace-scroll-sibling-label (current-buffer) "new")
(should (= -1 (ebox--scroll-region-by scroll-id -1)))
(should (string-match-p "new" (buffer-string))))))
(ert-deftest ebox-commit-local-content-inside-scroll-keeps-full-cache-update ()
"A scrolling ancestor still needs its retained content regenerated."
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer) (ebox-commit-test--scroll-sibling-root "old" t))
(let* ((state (ebox--buffer-render-state (current-buffer)))
(scroll-id (car (plist-get state :scroll-region-ids)))
(report (ebox-commit-test--replace-scroll-sibling-label
(current-buffer) "new")))
(should-not (memq (plist-get report :projection-kind) '(span-patch owner-scoped)))
(should (= 1 (ebox--scroll-region-by scroll-id 1)))
(should (= -1 (ebox--scroll-region-by scroll-id -1)))
(should (string-match-p "new" (buffer-string)))
(should-not (string-match-p "old" (buffer-string))))))
(ert-deftest ebox-commit-disjoint-scroll-proof-rejects-incomplete-or-overlapping-state ()
"Missing mappings, changed membership and either ancestor direction reject."
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer) (ebox-commit-test--scroll-sibling-root "old"))
(let* ((state (ebox--buffer-render-state (current-buffer)))
(owner (plist-get (ebox--host-ref-node (current-buffer) 'label) :node-id))
(root (plist-get (plist-get state :root-node) :node-id))
(region (car (plist-get state :scroll-region-ids)))
(scroll (gethash region ebox--scroll-global-state))
(scroll-id (plist-get (plist-get scroll :box) :node-id))
(table (make-hash-table :test 'equal))
(prepared (list :scroll-state-table table))
(candidate (copy-sequence state)))
(puthash region scroll table)
(should (ebox-incremental--owner-disjoint-from-scroll-p
(current-buffer) state prepared candidate owner))
(should-not (ebox-incremental--owner-disjoint-from-scroll-p
(current-buffer) state prepared candidate root))
(should-not (ebox-incremental--owner-disjoint-from-scroll-p
(current-buffer) state prepared candidate scroll-id))
(remhash region table)
(should-not (ebox-incremental--owner-disjoint-from-scroll-p
(current-buffer) state prepared candidate owner))
(puthash 'different-region scroll table)
(should-not (ebox-incremental--owner-disjoint-from-scroll-p
(current-buffer) state prepared candidate owner))
(clrhash table)
(puthash region scroll table)
(let ((regions (copy-hash-table (plist-get state :region-box-table))))
(remhash region regions)
(plist-put candidate :region-box-table regions)
(should-not (ebox-incremental--owner-disjoint-from-scroll-p
(current-buffer) state prepared candidate owner)))
(plist-put candidate :region-box-table (plist-get state :region-box-table))
(let ((parents (ebox-incremental--candidate-copy-index-table
state :parent-table 'equal)))
(setq parents (ebox-runtime-index-put scroll-id owner parents))
(plist-put candidate :parent-table parents)
(should-not (ebox-incremental--owner-disjoint-from-scroll-p
(current-buffer) state prepared candidate owner)))
(plist-put candidate :parent-table (plist-get state :parent-table))
(let* ((parents (ebox-incremental--candidate-copy-index-table
state :parent-table 'equal))
(overlapping-old-state (copy-sequence state))
(ebox-incremental--buffer-render-state-override
(cons (current-buffer) candidate)))
;; The caller may already expose candidate ancestry. Old-state
;; ancestry must still reject an owner that used to be inside scroll.
(setq parents (ebox-runtime-index-put owner scroll-id parents))
(plist-put overlapping-old-state :parent-table parents)
(should-not (ebox-incremental--owner-disjoint-from-scroll-p
(current-buffer) overlapping-old-state prepared
candidate owner))))))
(ert-deftest ebox-commit-content-shift-preserves-later-scroll-targets ()
"Longer and shorter local text retain the later scroll widget's targets."
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer) (ebox-commit-test--scroll-sibling-root "old"))
(let ((scroll-id (car (plist-get (ebox--buffer-render-state (current-buffer))
:scroll-region-ids))))
(dolist (value '("longer" "x"))
(ebox-commit-test--replace-scroll-sibling-label (current-buffer) value)
(should (= 1 (ebox--scroll-region-by scroll-id 1)))
(should (string-match-p (concat "\\`" value) (buffer-string)))
(should (string-match-p "line-c" (buffer-string)))
(should (= -1 (ebox--scroll-region-by scroll-id -1)))
(should (string-match-p (concat "\\`" value) (buffer-string)))
(should (string-match-p "line-a" (buffer-string)))))))
(ert-deftest ebox-commit-mixed-content-and-scroll-paint-refreshes-cache ()
"An unrelated label edit cannot authorize stale paint in a scroll cache."
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer) (ebox-commit-test--scroll-sibling-root "old"))
(let* ((scroll-id (car (plist-get (ebox--buffer-render-state (current-buffer))
:scroll-region-ids)))
(candidate (ebox-candidate-begin (current-buffer))))
(ebox-candidate-replace-host-ref
candidate 'label (ebox-test-text "new" :key 'label :source-identity 'label))
(ebox-candidate-replace-host-ref
candidate 'scroll-lines
(ebox-test-text "line-a\nline-b\nline-c\nline-d"
:key 'scroll-lines :source-identity 'scroll-lines
:color "#654321"))
(let ((report (ebox-commit (current-buffer) candidate)))
(should-not (eq (plist-get report :projection-kind) 'mixed-owner-reflow)))
(dotimes (_ 2)
(goto-char (point-min))
(search-forward "line-a")
(should (equal "#654321"
(ebox-commit-test--face-value
(get-text-property (1- (point)) 'face) :foreground)))
(should (= 1 (ebox--scroll-region-by scroll-id 1)))
(should (= -1 (ebox--scroll-region-by scroll-id -1)))))))
(defun ebox-commit-test--scroll-family-root (left right color)
"Return independent fixed-width LEFT, RIGHT and COLOR owners beside scroll."
(ebox-test-column :key 'family-root :width '(120)
(ebox-test-box :key 'left :source-identity 'left :width '(80)
(ebox-test-text left))
(ebox-test-box :key 'right :source-identity 'right :width '(80)
(ebox-test-text right))
(ebox-test-box :key 'paint :source-identity 'paint :color color
(ebox-test-text "paint"))
(ebox-commit-test--scroll-sibling-root "untouched")))
(defun ebox-commit-test--scroll-family-candidate (buffer color &optional content)
"Return BUFFER candidate changing COLOR and, when CONTENT, both text owners."
(let ((candidate (ebox-candidate-begin buffer)))
(when content
(ebox-candidate-replace-host-ref
candidate 'left
(ebox-test-box :key 'left :source-identity 'left :width '(80)
(ebox-test-text "left-new")))
(ebox-candidate-replace-host-ref
candidate 'right
(ebox-test-box :key 'right :source-identity 'right :width '(80)
(ebox-test-text "right-new"))))
(ebox-candidate-replace-host-ref
candidate 'paint
(if color
(ebox-test-box :key 'paint :source-identity 'paint :color color
(ebox-test-text "paint"))
(ebox-test-box :key 'paint :source-identity 'paint
(ebox-test-text "paint"))))
candidate))
(defun ebox-commit-test--assert-scroll-family-output (left right color)
"Assert current buffer contains LEFT, RIGHT, and the painted COLOR."
(should (string-match-p left (buffer-string)))
(should (string-match-p right (buffer-string)))
(save-excursion
(goto-char (point-min))
(search-forward "paint")
(should (equal color
(ebox-commit-test--face-value
(get-text-property (1- (point)) 'face) :foreground)))))
(ert-deftest ebox-commit-content-patch-retains-ancestor-paint ()
"Local text retains nested paint, caller faces and opaque property values."
(with-temp-buffer
(let* ((callback (lambda () 'counter-action))
(payload (make-hash-table :test #'eq))
(slot (tp-paint-slot-create '(:background "#E0E8E0")))
(face '(:weight bold)))
(ebox-render-to-buffer
(current-buffer)
(ebox-test-column :width '(200) :bgcolor "#FFFDF8"
:surface-properties (list 'help-echo callback)
(ebox-test-box :bgcolor slot
(ebox-test-text (propertize "10" 'face face 'custom payload)
:key 'counter :source-identity 'counter))
(ebox-test-text "untouched")))
(let* ((candidate (ebox-candidate-begin (current-buffer)))
(before-id (plist-get (ebox--host-ref-node (current-buffer) 'counter)
:node-id)))
(ebox-candidate-replace-host-ref
candidate 'counter
(ebox-test-text (propertize "20" 'face face 'custom payload)
:key 'counter :source-identity 'counter))
(let* ((result (ebox-commit-test--count-root-renders
(lambda () (ebox-commit (current-buffer) candidate))))
(report (car result)))
(ebox-commit-test--assert-full-render-equivalent)
(should (= before-id
(plist-get (ebox--host-ref-node (current-buffer) 'counter)
:node-id)))
(dotimes (offset 2)
(let ((position (+ (point-min) offset)))
(should (eq callback (get-text-property position 'help-echo)))
(should (eq payload (get-text-property position 'custom)))
(should (eq 'bold
(ebox-commit-test--face-value
(get-text-property position 'face) :weight)))
(should (memq (tp-paint-slot-face slot)
(flatten-tree (get-text-property position 'face))))))
(should (zerop (cdr result)))
(should (memq (plist-get report :projection-kind)
'(span-patch owner-scoped)))
(should-not (plist-get report :tp-full-root)))))))
(ert-deftest ebox-commit-content-patch-retains-ancestor-surface-properties ()
"Changing text retains properties supplied by its containing box."
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer)
(ebox-test-column :width '(200) :surface-properties '(help-echo "parent")
(ebox-test-text "10" :key 'counter :source-identity (list 'counter))
(ebox-test-text "untouched")))
(let ((candidate (ebox-candidate-begin (current-buffer))))
(ebox-candidate-replace-host-ref
candidate (list 'counter)
(ebox-test-text "20" :key 'counter :source-identity (list 'counter)))
(let ((result (ebox-commit-test--count-root-renders
(lambda () (ebox-commit (current-buffer) candidate)))))
(ebox-commit-test--assert-full-render-equivalent)
(should (zerop (cdr result)))
(should-not (plist-get (car result) :tp-full-root))))))
(ert-deftest ebox-commit-inherited-box-checkbox-roundtrip-retains-properties ()
"A fixed-width Box under Flex retains paint with fresh equal identities."
(with-temp-buffer
(let ((previous-identity (list 'control 'checkbox)))
(cl-labels
((checkbox (text identity)
(ebox-test-box :key 'checkbox :source-identity identity :width '(24)
(ebox-test-text text :key 'glyph
:source-identity (append identity '(glyph))))))
(ebox-render-to-buffer
(current-buffer)
(ebox-test-column :width '(200) :bgcolor "#FFFDF8"
(ebox-test-flex :width '(160) :height 1 :bgcolor "#E0E8E0"
:surface-properties '(help-echo "checkbox control")
(checkbox "" previous-identity))
(ebox-test-text "untouched")))
(let ((owner-id
(plist-get (ebox--host-ref-node (current-buffer) previous-identity)
:node-id)))
(dolist (text '("" "" "" ""))
(let ((identity (list 'control 'checkbox))
(candidate (ebox-candidate-begin (current-buffer))))
(should (equal previous-identity identity))
(should-not (eq previous-identity identity))
(ebox-candidate-replace-host-ref
candidate identity (checkbox text identity))
(let* ((result (ebox-commit-test--count-root-renders
(lambda () (ebox-commit (current-buffer) candidate))))
(report (car result)))
(ebox-commit-test--assert-full-render-equivalent)
(should (string-prefix-p text (buffer-string)))
(should (= owner-id
(plist-get (ebox--host-ref-node (current-buffer) identity)
:node-id)))
(should (equal "checkbox control"
(get-text-property (point-min) 'help-echo)))
(should (zerop (cdr result)))
(should (memq (plist-get report :projection-kind)
'(span-patch owner-scoped)))
(should-not (plist-get report :tp-full-root)))
(setq previous-identity identity))))))))
(ert-deftest ebox-commit-inherited-text-roundtrip-keeps-paint-provenance ()
"Repeated text edits retain the baseline needed to replace/remove paint."
(with-temp-buffer
(let ((face '(:weight bold))
(callback (lambda () 'counter-action)))
(cl-labels
((counter (text)
(ebox-test-text (propertize text 'face face 'action callback)
:key 'counter :source-identity 'counter))
(parent (color)
(apply #'ebox-test-box
(append (list :key 'parent :source-identity 'parent
:surface-properties '(help-echo "parent")
(counter "10"))
(and color (list :bgcolor color))))))
(ebox-render-to-buffer
(current-buffer)
(ebox-test-column :width '(200) :bgcolor "#FFFDF8"
(parent "#E0E8E0")
(ebox-test-text "untouched")))
(let* ((initial (ebox--buffer-render-state (current-buffer)))
(fragments (copy-tree (plist-get initial :surface-fragments)))
(root-renders 0)
(counter-id
(plist-get (ebox--host-ref-node (current-buffer) 'counter)
:node-id)))
(dolist (text '("20" "10" "20" "10"))
(let ((candidate (ebox-candidate-begin (current-buffer))))
(ebox-candidate-replace-host-ref candidate 'counter (counter text))
(let ((result (ebox-commit-test--count-root-renders
(lambda () (ebox-commit (current-buffer) candidate)))))
(ebox-commit-test--assert-full-render-equivalent)
(should (equal fragments
(plist-get (ebox--buffer-render-state (current-buffer))
:surface-fragments)))
(cl-incf root-renders (cdr result)))))
(let ((previous "#E0E8E0"))
(dolist (color '("#667788" nil))
(let ((candidate (ebox-candidate-begin (current-buffer))))
(should (ebox-candidate-patch-host-paint
candidate 'parent (parent previous) (parent color)))
(let ((report (ebox-commit (current-buffer) candidate)))
(should (eq (plist-get report :projection-kind) 'paint)))
(ebox-commit-test--assert-full-render-equivalent)
(should (eq callback (get-text-property (point-min) 'action)))
(should (eq 'bold
(ebox-commit-test--face-value
(get-text-property (point-min) 'face) :weight)))
(should (equal (or color "#FFFDF8")
(ebox-commit-test--face-value
(get-text-property (point-min) 'face) :background)))
(should (= counter-id
(plist-get (ebox--host-ref-node (current-buffer) 'counter)
:node-id))))
(setq previous color)))
(should (zerop root-renders)))))))
(ert-deftest ebox-commit-inherited-text-exclusions-render-current-properties ()
"Property, extent, display and identity changes retain the exact fallback."
(dolist (change '(property char-length display identity opaque-callback))
(ert-info ((format "inherited text exclusion: %S" change))
(with-temp-buffer
(let* ((make-callback (lambda ()
(let ((value (vector t))) (lambda () value))))
(old-callback (funcall make-callback))
(new-callback (if (eq change 'opaque-callback)
(funcall make-callback) old-callback))
(old (propertize "10" 'help-echo "old" 'action old-callback))
(new (propertize (if (eq change 'char-length) "200" "20")
'help-echo (if (eq change 'property) "new" "old")
'action new-callback)))
(when (eq change 'opaque-callback)
(should (equal old-callback new-callback))
(should-not (eq old-callback new-callback)))
(when (eq change 'display)
(add-text-properties 0 2 '(display (raise 0)) old)
(add-text-properties 0 2 '(display (raise 0)) new))
(ebox-render-to-buffer
(current-buffer)
(ebox-test-column :width '(200) :bgcolor "#FFFDF8"
(ebox-test-text old :key 'counter :source-identity 'counter)
(ebox-test-text "untouched")))
(let ((candidate (ebox-candidate-begin (current-buffer))))
(ebox-candidate-replace-host-ref
candidate 'counter
(ebox-test-text new :key 'counter
:source-identity
(if (eq change 'identity) 'new-counter 'counter)))
(let ((result (ebox-commit-test--count-root-renders
(lambda () (ebox-commit (current-buffer) candidate)))))
(ebox-commit-test--assert-full-render-equivalent)
(should (eq new-callback (get-text-property (point-min) 'action)))
(when (eq change 'identity)
(should-not (ebox--host-ref-node (current-buffer) 'counter))
(should (ebox--host-ref-node (current-buffer) 'new-counter)))
(should (> (cdr result) 0)))))))))
(ert-deftest ebox-commit-inherited-text-rolls-back-properties-and-retries ()
"Late publication rejection retains text, metadata and one old generation."
(with-temp-buffer
(let ((callback (lambda () 'counter-action))
(face '(:weight bold)))
(cl-labels
((counter (text)
(ebox-test-text (propertize text 'face face 'action callback)
:key 'counter :source-identity 'counter))
(candidate ()
(let ((candidate (ebox-candidate-begin (current-buffer))))
(ebox-candidate-replace-host-ref candidate 'counter (counter "20"))
candidate)))
(ebox-render-to-buffer
(current-buffer)
(ebox-test-column :width '(200) :bgcolor "#FFFDF8"
:surface-properties '(help-echo "parent")
(counter "10") (ebox-test-text "untouched")))
(let* ((before (buffer-string))
(state (ebox--buffer-render-state (current-buffer)))
(fragments (copy-tree (plist-get state :surface-fragments)))
(revision (tp-surface-revision ebox-surface--buffer-surface))
(rejected
(ebox-commit-test--count-root-renders
(lambda ()
(cl-letf (((symbol-function 'accept-change-group)
(lambda (_) (error "Reject inherited text"))))
(should-error (ebox-commit (current-buffer) (candidate))))))))
(should (equal (car rejected) '(error "Reject inherited text")))
(should (eq state (ebox--buffer-render-state (current-buffer))))
(should (equal fragments (plist-get state :surface-fragments)))
(should (= revision (tp-surface-revision ebox-surface--buffer-surface)))
(should (equal-including-properties before (buffer-string)))
(should (eq callback (get-text-property (point-min) 'action)))
(let ((retry (ebox-commit-test--count-root-renders
(lambda () (ebox-commit (current-buffer) (candidate))))))
(ebox-commit-test--assert-full-render-equivalent)
(should (string-prefix-p "20" (buffer-string)))
(should (eq callback (get-text-property (point-min) 'action)))
(should (equal fragments
(plist-get (ebox--buffer-render-state (current-buffer))
:surface-fragments)))
(should (zerop (cdr rejected)))
(should (zerop (cdr retry)))
(should-not (plist-get (car retry) :tp-full-root))))))))
(ert-deftest ebox-commit-inherited-text-probe-error-aborts-before-publication ()
"An old-owner probe failure propagates intact and permits a local retry."
(with-temp-buffer
(let ((callback (lambda () 'counter-action)))
(cl-labels
((counter (text)
(ebox-test-text (propertize text 'action callback 'face '(:weight bold))
:key 'counter :source-identity 'counter))
(candidate ()
(let ((candidate (ebox-candidate-begin (current-buffer))))
(ebox-candidate-replace-host-ref candidate 'counter (counter "20"))
candidate)))
(ebox-render-to-buffer
(current-buffer)
(ebox-test-column :width '(200) :bgcolor "#FFFDF8"
:surface-properties '(help-echo "parent")
(counter "10") (ebox-test-text "untouched")))
(let* ((before (buffer-string))
(state (ebox--buffer-render-state (current-buffer)))
(fragments (copy-tree (plist-get state :surface-fragments)))
(surface ebox-surface--buffer-surface)
(revision (tp-surface-revision surface))
(modified-tick (buffer-modified-tick))
(owner-id (plist-get (ebox--host-ref-node (current-buffer) 'counter)
:node-id))
(payload (make-symbol "old-owner-probe"))
(failure-data (list "Old-owner probe invariant failed" payload))
(old-probes 0)
(publications 0)
(injector
(lambda (render-state node)
(when (and (eq node (plist-get render-state :root-node))
(equal owner-id (plist-get node :node-id))
(ebox-text-node-p node)
(equal "10" (ebox-text-node-value node)))
(cl-incf old-probes)
(signal 'error failure-data))))
rejected)
(advice-add 'ebox-surface--render-candidate-node :before injector)
(unwind-protect
(setq rejected
(ebox-commit-test--count-root-renders
(lambda ()
(condition-case condition
(ebox-commit (current-buffer) (candidate)
(lambda (_report) (cl-incf publications)))
(error condition)))))
(advice-remove 'ebox-surface--render-candidate-node injector))
(should (= old-probes 1))
(should (equal (car rejected) (cons 'error failure-data)))
(should (eq payload (nth 2 (car rejected))))
(should (zerop publications))
(should (zerop (cdr rejected)))
(should (eq state (ebox--buffer-render-state (current-buffer))))
(should (eq surface ebox-surface--buffer-surface))
(should (= revision (tp-surface-revision surface)))
(should (= modified-tick (buffer-modified-tick)))
(should (equal fragments (plist-get state :surface-fragments)))
(should (equal-including-properties before (buffer-string)))
(should (eq callback (get-text-property (point-min) 'action)))
(let* ((retry (ebox-commit-test--count-root-renders
(lambda () (ebox-commit (current-buffer) (candidate)))))
(report (car retry)))
(ebox-commit-test--assert-full-render-equivalent)
(should (string-prefix-p "20" (buffer-string)))
(should (eq callback (get-text-property (point-min) 'action)))
(should (zerop (cdr retry)))
(should (memq (plist-get report :projection-kind)
'(span-patch owner-scoped)))
(should-not (plist-get report :tp-full-root))))))))
(ert-deftest ebox-commit-range-patch-retains-ancestor-paint ()
"An equal-line Range replacement retains enclosing paint."
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer)
(ebox-test-column :width '(200) :bgcolor "#FFFDF8"
(ebox-test-box :width '(80) :height 1
(ebox-test-column
(ebox-test-child-range 'items
(ebox-test-text "10" :key 'old))))
(ebox-test-text "untouched")))
(let ((candidate (ebox-candidate-begin (current-buffer))))
(ebox-candidate-replace-range-ref
candidate 'items (ebox-test-text "20" :key 'new))
(ebox-commit (current-buffer) candidate))
(let* ((state (ebox--buffer-render-state (current-buffer)))
(expected (ebox--render-node (plist-get state :root-node)
(plist-get state :source-index))))
(should (equal-including-properties expected (buffer-string))))))
(ert-deftest ebox-commit-paint-retains-disjoint-scroll ()
"Pure sibling paint retains scroll caches and stays painted after scrolling."
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer)
(ebox-commit-test--scroll-family-root "left-old" "right-old" "#123456"))
(let* ((state (ebox--buffer-render-state (current-buffer)))
(scroll-id (car (plist-get state :scroll-region-ids)))
(scroll (gethash scroll-id ebox--scroll-global-state))
(raw (plist-get scroll :content-lines))
(rendered (plist-get scroll :rendered-content-lines))
(region-count (hash-table-count ebox--region-box-table))
(root-render (symbol-function 'ebox-surface--render-candidate))
(root-renders 0)
report)
(should scroll-id)
(cl-letf (((symbol-function 'ebox-surface--render-candidate)
(lambda (candidate-state)
(cl-incf root-renders)
(funcall root-render candidate-state))))
(setq report
(ebox-commit
(current-buffer)
(ebox-commit-test--scroll-family-candidate
(current-buffer) "#654321"))))
(should (eq (plist-get report :projection-kind) 'paint))
(should (zerop root-renders))
(should-not (plist-get report :tp-full-root))
(should (= 1 (tp-signal-subscriber-count
(ebox-surface--signals-scroll
ebox-surface--context-signals))))
(let ((next-scroll (gethash scroll-id ebox--scroll-global-state)))
(should (eq raw (plist-get next-scroll :content-lines)))
(should (eq rendered (plist-get next-scroll :rendered-content-lines)))
(should (eq (plist-get next-scroll :box)
(gethash scroll-id ebox--region-box-table)))
(should (= region-count (hash-table-count ebox--region-box-table))))
(ebox-commit-test--assert-scroll-family-output "left-old" "right-old" "#654321")
(should (= 1 (ebox--scroll-region-by scroll-id 1)))
(should (string-match-p "line-c" (buffer-string)))
(ebox-commit-test--assert-scroll-family-output "left-old" "right-old" "#654321")
(should (= -1 (ebox--scroll-region-by scroll-id -1)))
(should (string-match-p "line-a" (buffer-string)))
(ebox-commit-test--assert-scroll-family-output "left-old" "right-old" "#654321"))))
(ert-deftest ebox-commit-mixed-owners-retain-disjoint-scroll-and-rollback ()
"Two text owners plus paint retain exact output, scroll caches and rollback."
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer)
(ebox-commit-test--scroll-family-root "left-old" "right-old" "#123456"))
(let* ((state (ebox--buffer-render-state (current-buffer)))
(scroll-id (car (plist-get state :scroll-region-ids)))
(scroll (gethash scroll-id ebox--scroll-global-state))
(box (gethash scroll-id ebox--region-box-table))
(raw (plist-get scroll :content-lines))
(rendered (plist-get scroll :rendered-content-lines))
(region-count (hash-table-count ebox--region-box-table))
(before (buffer-string))
(footprint (ebox--rendered-span-footprint-signature before))
(expected (replace-regexp-in-string
"right-old" "right-new"
(replace-regexp-in-string "left-old" "left-new"
(substring-no-properties before))))
(root-render (symbol-function 'ebox-surface--render-candidate))
(root-renders 0)
report)
(should scroll-id)
(cl-letf (((symbol-function 'accept-change-group)
(lambda (_) (error "Reject mixed sibling publication"))))
(should
(equal
(should-error
(ebox-commit
(current-buffer)
(ebox-commit-test--scroll-family-candidate
(current-buffer) "#654321" t)))
'(error "Reject mixed sibling publication"))))
(should (eq state (ebox--buffer-render-state (current-buffer))))
(should (equal-including-properties before (buffer-string)))
(should (eq scroll (gethash scroll-id ebox--scroll-global-state)))
(should (eq box (gethash scroll-id ebox--region-box-table)))
(should (eq raw (plist-get scroll :content-lines)))
(should (eq rendered (plist-get scroll :rendered-content-lines)))
(should (= region-count (hash-table-count ebox--region-box-table)))
(should (= 1 (ebox--scroll-region-by scroll-id 1)))
(ebox-commit-test--assert-scroll-family-output "left-old" "right-old" "#123456")
(should (= -1 (ebox--scroll-region-by scroll-id -1)))
(cl-letf (((symbol-function 'ebox-surface--render-candidate)
(lambda (candidate-state)
(cl-incf root-renders)
(funcall root-render candidate-state))))
(setq report
(ebox-commit
(current-buffer)
(ebox-commit-test--scroll-family-candidate
(current-buffer) "#654321" t))))
(should (eq (plist-get report :projection-kind) 'mixed-owner-reflow))
(should (zerop root-renders))
(should-not (plist-get report :tp-full-root))
(should (equal expected (buffer-substring-no-properties (point-min) (point-max))))
(should (equal footprint
(ebox--rendered-span-footprint-signature (buffer-string))))
(let ((next-scroll (gethash scroll-id ebox--scroll-global-state)))
(should (eq raw (plist-get next-scroll :content-lines)))
(should (eq rendered (plist-get next-scroll :rendered-content-lines)))
(should (eq (plist-get next-scroll :box)
(gethash scroll-id ebox--region-box-table)))
(should (= region-count (hash-table-count ebox--region-box-table))))
(ebox-commit-test--assert-scroll-family-output "left-new" "right-new" "#654321")
(should (= 1 (ebox--scroll-region-by scroll-id 1)))
(should (string-match-p "line-c" (buffer-string)))
(ebox-commit-test--assert-scroll-family-output "left-new" "right-new" "#654321")
(should (= -1 (ebox--scroll-region-by scroll-id -1)))
(should (string-match-p "line-a" (buffer-string)))
(ebox-commit-test--assert-scroll-family-output "left-new" "right-new" "#654321"))))
(ert-deftest ebox-commit-mixed-paint-followups-replace-and-remove-prior-color ()
"Mixed paint must not reappear after pure paint, removal, rollback or scroll."
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer)
(ebox-commit-test--scroll-family-root "left-old" "right-old" "#123456"))
(let* ((initial (ebox--buffer-render-state (current-buffer)))
(scroll-id (car (plist-get initial :scroll-region-ids)))
(scroll (gethash scroll-id ebox--scroll-global-state))
(raw (plist-get scroll :content-lines))
(rendered (plist-get scroll :rendered-content-lines))
(paint-id (plist-get (ebox--host-ref-node (current-buffer) 'paint) :node-id)))
(dolist (stage '(("#0000FF" t mixed-owner-reflow)
("#00FF00" nil paint)
(nil nil paint)))
(let ((color (car stage))
(content-p (cadr stage)))
(ert-info ((format "paint transition: %S" stage))
(when (equal color "#00FF00")
(let ((before (buffer-string))
(state (ebox--buffer-render-state (current-buffer)))
(old-scroll (gethash scroll-id ebox--scroll-global-state)))
(cl-letf (((symbol-function 'accept-change-group)
(lambda (_) (error "Reject followup paint"))))
(should
(equal
(should-error
(ebox-commit
(current-buffer)
(ebox-commit-test--scroll-family-candidate (current-buffer) color)))
'(error "Reject followup paint"))))
(should (eq state (ebox--buffer-render-state (current-buffer))))
(should (eq old-scroll (gethash scroll-id ebox--scroll-global-state)))
(should (equal-including-properties before (buffer-string)))))
(let ((report
(ebox-commit
(current-buffer)
(ebox-commit-test--scroll-family-candidate
(current-buffer) color content-p))))
(should (eq (plist-get report :projection-kind) (nth 2 stage))))
(should (= paint-id (plist-get (ebox--host-ref-node (current-buffer) 'paint)
:node-id)))
(dolist (delta '(0 1 -1))
(unless (zerop delta)
(should (= delta (ebox--scroll-region-by scroll-id delta))))
(ebox-commit-test--assert-scroll-family-output "left-new" "right-new" color)
(let* ((contents (buffer-string))
(start (string-match "paint" contents)))
(dotimes (offset (length "paint"))
(should (equal (get-text-property (+ start offset) 'face contents)
(and color (list :foreground color)))))))
(should (string-match-p "line-a" (buffer-string)))
(let ((next-scroll (gethash scroll-id ebox--scroll-global-state)))
(should (eq raw (plist-get next-scroll :content-lines)))
(should (eq rendered (plist-get next-scroll :rendered-content-lines)))
(should (eq (plist-get next-scroll :box)
(gethash scroll-id ebox--region-box-table))))))))))
(ert-deftest ebox-commit-disjoint-scroll-validates-rendered-font-extent ()
"Equal raw widths do not authorize changed rendered glyph widths."
(let ((measure (symbol-function 'ebox--string-pixel-width)))
;; Model an unchanged proportional font: raw WWW/iii both measure three
;; units, but styled iii is narrower. The final painted line must still
;; include exactly the filler required by its 120px parent allocation.
(cl-letf (((symbol-function 'ebox--string-pixel-width)
(lambda (string)
(let ((width (funcall measure string)) (start 0))
(while (string-match "iii" string start)
(when (get-text-property (match-beginning 0) 'face string)
(cl-decf width))
(setq start (match-end 0)))
width))))
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer)
(ebox-test-column :key 'root :width '(120)
(ebox-test-text "WWW" :font-size 16 :key 'label :source-identity 'label)
(ebox-test-box :height 1 :overflow 'scroll
(ebox-test-text "first\nsecond"))))
(let ((candidate (ebox-candidate-begin (current-buffer))))
(ebox-candidate-replace-host-ref
candidate 'label
(ebox-test-text "iii" :font-size 16 :key 'label :source-identity 'label))
(ebox-commit (current-buffer) candidate))
(goto-char (point-min))
(should (looking-at "iii"))
(should (= 120 (ebox--string-pixel-width
(buffer-substring (point) (line-end-position)))))))))
(defun ebox-commit-test--hash-facts (table &optional values)
"Return sorted TABLE keys, or key/value pairs when VALUES is non-nil."
(let (facts)
(ebox-runtime-index-map
(lambda (key value)
(push (if values (cons key value) key) facts))
table)
(sort facts
(lambda (left right)
(string< (prin1-to-string left)
(prin1-to-string right))))))
(defun ebox-commit-test--runtime-facts (buffer)
"Return stable retained runtime facts for BUFFER equivalence checks."
(let* ((surface (with-current-buffer buffer
ebox-surface--buffer-surface))
(state (tp-surface-client-state surface)))
(list :surface-revision (tp-surface-revision surface)
:runtime-revision (plist-get state :runtime-revision)
:last-update-report (plist-get state :last-update-report)
:viewport-width (plist-get state :viewport-width)
:viewport-height (plist-get state :viewport-height)
:projection-kind (plist-get state :projection-kind)
:node-ids
(ebox-commit-test--hash-facts (plist-get state :node-table))
:region-ids
(ebox-commit-test--hash-facts (plist-get state :region-id-set))
:parents
(ebox-commit-test--hash-facts (plist-get state :parent-table) t)
:type-counts
(ebox-commit-test--hash-facts
(plist-get state :runtime-type-count-table) t)
:scroll-region-ids (copy-sequence
(plist-get state :scroll-region-ids)))))
(defun ebox-commit-test--participant-v2-count ()
"Return the structured participant registration count for mount and commit."
(let ((buffer (generate-new-buffer " *ebox-participant-v2*"))
(v2-register (symbol-function 'tp-transaction-participate-v2))
(v2-count 0))
(unwind-protect
(cl-letf (((symbol-function 'tp-transaction-participate-v2)
(lambda (&rest arguments)
(cl-incf v2-count)
(apply v2-register arguments))))
(ebox-render-to-buffer
buffer (ebox-test-box :key 'root (ebox-test-text "old")
:width '(80)))
(ebox-commit
buffer (ebox-test-box :key 'root (ebox-test-text "new")
:width '(80)))
(with-current-buffer buffer
(should (string-match-p "new" (buffer-string))))
v2-count)
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-source-index-promotes-and-rolls-back-atomically ()
"Candidate source indexes promote once and never corrupt retained state."
(let ((buffer (generate-new-buffer " *ebox-source-index-lifecycle*")))
(unwind-protect
(let* ((old-root
(ebox-build
'(column :key root :id "root" :class "old"
(box :key row :class "row" "Old"))))
(candidate
(ebox-build
'(column :key root :id "root" :class "new"
(box :key row :class "row" "New")))))
(ebox-render-to-buffer buffer old-root)
(let* ((old-state (ebox--buffer-render-state buffer))
(old-index (plist-get old-state :source-index))
(old-node-id
(plist-get (plist-get old-state :root-node) :node-id))
(before (ebox-commit-test--buffer-string buffer)))
(should (ebox-source-index-p old-index))
(cl-letf (((symbol-function 'accept-change-group)
(lambda (_group) (error "source accept failed"))))
(should-error (ebox-commit buffer candidate) :type 'error))
(let ((retained (ebox--buffer-render-state buffer)))
(should (eq old-index (plist-get retained :source-index)))
(should (equal-including-properties
before (ebox-commit-test--buffer-string buffer))))
(ebox-commit buffer candidate)
(let* ((new-state (ebox--buffer-render-state buffer))
(new-index (plist-get new-state :source-index))
(new-root (plist-get new-state :root-node))
(record
(ebox-source-index-record
new-index (ebox-node-source-handle new-root))))
(should (ebox-source-index-p new-index))
(should-not (eq old-index new-index))
(should (= old-node-id (plist-get new-root :node-id)))
(should (equal '("new")
(ebox-source-record-classes record))))))
(when (buffer-live-p buffer) (kill-buffer buffer)))
(should-not (ebox--buffer-render-state buffer))))
(defun ebox-commit-test--assert-observer-pair (events stage)
"Assert reversed EVENTS contain one TP/Ebox pair for STAGE."
(should (= (length events) 2))
(let ((ordered (nreverse events)))
(should (equal (mapcar (lambda (report)
(plist-get report :provider))
ordered)
'(tp ebox)))
(should (equal (mapcar (lambda (report)
(plist-get report :stage))
ordered)
(list 'publication stage)))
(should (equal (plist-get (car ordered) :correlation-id)
(plist-get (cadr ordered) :correlation-id)))))
(ert-deftest ebox-observer-initial-mount-preserves-state-and-report-contract ()
"Observed mount is equivalent and does not retain its transient report."
(let ((plain (generate-new-buffer " *ebox-observer-plain*"))
(observed (generate-new-buffer " *ebox-observer-mounted*"))
events)
(unwind-protect
(progn
(let ((ebox--region-id-counter 0)
(ebox--runtime-node-id-counter 0))
(ebox-render-to-buffer
plain (ebox-commit-test--observed-root "same")))
(let ((ebox--region-id-counter 0)
(ebox--runtime-node-id-counter 0))
(ebox-render-to-buffer
observed (ebox-commit-test--observed-root "same")
(list :observer
(lambda (buffer report)
(push (list buffer report) events)))))
(should
(equal-including-properties
(ebox-commit-test--buffer-string plain)
(ebox-commit-test--buffer-string observed)))
(should (equal (ebox-commit-test--runtime-facts plain)
(ebox-commit-test--runtime-facts observed)))
(should-not (ebox-buffer-update-report plain))
(should-not (ebox-buffer-update-report observed))
(should (= (length events) 2))
(let* ((ordered (nreverse events))
(tp-report (cadar ordered))
(ebox-report (cadadr ordered)))
(should (eq (caar ordered) observed))
(should (eq (caadr ordered) observed))
(should (eq (plist-get tp-report :provider) 'tp))
(should (eq (plist-get tp-report :stage) 'publication))
(should (eq (plist-get ebox-report :provider) 'ebox))
(should (eq (plist-get ebox-report :stage) 'mount))
(should (equal (plist-get tp-report :correlation-id)
(plist-get ebox-report :correlation-id)))
(dolist (key '(:duration-ms :gc-count :gc-duration-ms
:tp-duration-ms))
(should (plist-member ebox-report key)))))
(when (buffer-live-p plain) (kill-buffer plain))
(when (buffer-live-p observed) (kill-buffer observed)))))
(ert-deftest ebox-observer-covers-public-update-boundaries-once ()
"Viewport, region, selector, batch, and scroll each emit one flat pair."
(let ((buffer (generate-new-buffer " *ebox-observer-operations*"))
(scroll-buffer (generate-new-buffer " *ebox-observer-scroll*"))
events)
(unwind-protect
(progn
(ebox-render-to-buffer
buffer
(ebox-build
'(column :width (viewport)
(box :id first :class card "One")
(box :id second :class card "Two")))
(list :observer
(lambda (_buffer report) (push report events))))
(setq events nil)
(ebox-rerender-buffer-with-context buffer 80)
(ebox-commit-test--assert-observer-pair events 'viewport)
(setq events nil)
(ebox-region-update
(ebox-region-resolve buffer 'first) :color "#123456")
(ebox-commit-test--assert-observer-pair events 'region)
(setq events nil)
(ebox-selector-update-buffer buffer ".card" :bgcolor "#eeeeee")
(ebox-commit-test--assert-observer-pair events 'selector)
(setq events nil)
(ebox-incremental-begin-batch buffer)
(ebox-region-update
(ebox-region-resolve buffer 'first) :color "#654321")
(should-not events)
(ebox-incremental-flush buffer)
(ebox-commit-test--assert-observer-pair events 'batch)
(setq events nil)
(ebox-incremental-begin-batch buffer)
(ebox-incremental-flush buffer)
(should-not events)
(let* ((root
(ebox-build
'(box :id scroll-root :height 1 :overflow scroll
"A\nB\nC")))
(scroll-id
(car
(ebox-region-ids
(ebox-canonical-input--single-root
root "Ebox observer scroll fixture")))))
(ebox-render-to-buffer
scroll-buffer root
(list :observer
(lambda (_buffer report) (push report events))))
(setq events nil)
(should (= (ebox--scroll-region-by scroll-id 1) 1))
(ebox-commit-test--assert-observer-pair events 'scroll)))
(when (buffer-live-p buffer) (kill-buffer buffer))
(when (buffer-live-p scroll-buffer) (kill-buffer scroll-buffer)))))
(ert-deftest ebox-observer-commit-emits-one-flat-pair-after-completion ()
"One accepted commit emits TP then the completed Ebox report exactly once."
(let (events
(buffer (generate-new-buffer " *ebox-observer-commit*")))
(unwind-protect
(progn
(ebox-render-to-buffer
buffer (ebox-commit-test--observed-root "old")
(list :observer
(lambda (_buffer report) (push report events))))
(setq events nil)
(let ((report
(ebox-commit
buffer (ebox-commit-test--observed-root "new"))))
(should (eq (plist-get report :framework-participant-state)
'completed)))
(should (= (length events) 2))
(let ((ordered (nreverse events)))
(should (equal (mapcar (lambda (report)
(plist-get report :provider))
ordered)
'(tp ebox)))
(should (equal (mapcar (lambda (report)
(plist-get report :stage))
ordered)
'(publication commit)))
(should (equal (plist-get (car ordered) :correlation-id)
(plist-get (cadr ordered) :correlation-id)))
(should (eq (plist-get (cadr ordered)
:framework-participant-state)
'completed))))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-observer-disabled-path-does-no-instrumentation-work ()
"An unobserved mount and commit bypass every Ebox instrumentation helper."
(let ((calls 0)
(buffer (generate-new-buffer " *ebox-observer-disabled*")))
(unwind-protect
(cl-letf (((symbol-function 'ebox-surface--make-observation)
(lambda (&rest _args) (cl-incf calls)))
((symbol-function 'ebox-surface--observation-clock)
(lambda () (cl-incf calls)))
((symbol-function 'ebox-surface--observation-gc-snapshot)
(lambda () (cl-incf calls)))
((symbol-function 'ebox-surface--decorate-observation-report)
(lambda (&rest _args) (cl-incf calls))))
(ebox-render-to-buffer
buffer (ebox-commit-test--observed-root "old"))
(ebox-commit buffer (ebox-commit-test--observed-root "new"))
(should (= calls 0)))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-buffer-observer-setter-keeps-one-stable-tp-bridge ()
"Add and replacement reuse one bridge; nil removes it from TP."
(let ((buffer (generate-new-buffer " *ebox-observer-setter*"))
first-events second-events)
(unwind-protect
(progn
(ebox-render-to-buffer
buffer (ebox-commit-test--observed-root "zero"))
(let ((first
(lambda (_buffer report) (push report first-events))))
(should (eq (ebox-buffer-set-observer buffer first) first)))
(should-error (ebox-buffer-set-observer buffer 'not-a-function)
:type 'wrong-type-argument)
(let ((bridge (with-current-buffer buffer
ebox-surface--tp-observer))
(surface (with-current-buffer buffer
ebox-surface--buffer-surface)))
(should (memq bridge (tp--surface-observers surface)))
(ebox-buffer-set-observer
buffer (lambda (_buffer report) (push report second-events)))
(should (eq bridge (with-current-buffer buffer
ebox-surface--tp-observer)))
(should (= (length (tp--surface-observers surface)) 1))
(ebox-commit buffer (ebox-commit-test--observed-root "one"))
(should-not first-events)
(should (= (length second-events) 2))
(should-not (ebox-buffer-set-observer buffer nil))
(should-not (memq bridge (tp--surface-observers surface)))
(setq second-events nil)
(ebox-commit buffer (ebox-commit-test--observed-root "two"))
(should-not second-events)))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-observer-render-failure-releases-new-observation-state ()
"A failed observed first mount leaves no observer, bridge, or context."
(let ((buffer (generate-new-buffer " *ebox-observer-mount-failure*")))
(unwind-protect
(progn
(cl-letf (((symbol-function 'ebox-surface-mount-buffer)
(lambda (&rest _args) (error "mount failed"))))
(should-error
(ebox-render-to-buffer
buffer (ebox-commit-test--observed-root "never")
(list :observer (lambda (&rest _args))))
:type 'error))
(with-current-buffer buffer
(should-not ebox-surface--buffer-observer)
(should-not ebox-surface--tp-observer)
(should-not ebox-surface--observation-contexts)))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-observer-boundary-rejects-outer-tp-before-operation ()
"A public observation boundary cannot finish before an outer TP accept."
(let ((buffer (generate-new-buffer " *ebox-observer-outer-tp*"))
events)
(unwind-protect
(progn
(ebox-render-to-buffer
buffer (ebox-build '(box :id target "old"))
(list :observer
(lambda (_buffer report) (push report events))))
(setq events nil)
(let ((before (ebox-commit-test--buffer-string buffer)))
(tp-with-transaction
(let ((failure
(condition-case condition
(progn
(ebox-region-update
(ebox-region-resolve buffer 'target)
:color "#123456")
nil)
(error condition))))
(should
(equal
(cdr failure)
'("Ebox public operation cannot join an outer TP transaction")))))
(should (equal-including-properties
before (ebox-commit-test--buffer-string buffer))))
(should-not events)
(should-not (ebox-buffer-update-report buffer))
(should-not (with-current-buffer buffer
ebox-surface--observation-contexts)))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-observer-reentrant-publication-gets-a-new-context ()
"A publication started by an observer emits its own correlated pair."
(let ((buffer (generate-new-buffer " *ebox-observer-reentrant*"))
events allow nested)
(unwind-protect
(progn
(ebox-render-to-buffer
buffer (ebox-commit-test--observed-root "initial")
(list
:observer
(lambda (_buffer report)
(push report events)
(when (and allow
(not nested)
(eq (plist-get report :provider) 'tp))
(setq nested t)
(ebox-commit
buffer (ebox-commit-test--observed-root "nested"))))))
(setq events nil allow t)
(ebox-commit buffer (ebox-commit-test--observed-root "outer"))
(let* ((ordered (nreverse events))
(outer-correlation
(plist-get (nth 0 ordered) :correlation-id))
(nested-correlation
(plist-get (nth 1 ordered) :correlation-id)))
(should (= (length ordered) 4))
(should (equal (mapcar (lambda (report)
(plist-get report :provider))
ordered)
'(tp tp ebox ebox)))
(should (equal outer-correlation
(plist-get (nth 3 ordered) :correlation-id)))
(should (equal nested-correlation
(plist-get (nth 2 ordered) :correlation-id)))
(should-not (equal outer-correlation nested-correlation)))
(should
(equal (substring-no-properties
(ebox-commit-test--buffer-string buffer))
"nested"))
(should-not (with-current-buffer buffer
ebox-surface--observation-contexts)))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-observer-error-cannot-roll-back-publication ()
"Each observer failure is contained after the accepted state is visible."
(let ((buffer (generate-new-buffer " *ebox-observer-error*"))
(calls 0))
(unwind-protect
(progn
(ebox-render-to-buffer
buffer (ebox-commit-test--observed-root "old")
(list :observer
(lambda (_buffer _report)
(cl-incf calls)
(error "observer failure"))))
(setq calls 0)
(let ((report
(ebox-commit
buffer (ebox-commit-test--observed-root "committed"))))
(should (eq (plist-get report :framework-participant-state)
'completed)))
(should (= calls 2))
(should (equal (substring-no-properties
(ebox-commit-test--buffer-string buffer))
"committed")))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-commit-rejects-outer-tp-transaction-before-mutation ()
"Observed and plain commits reject an outer TP transaction before mutation."
(dolist (observed '(nil t))
(let ((buffer (generate-new-buffer " *ebox-outer-transaction*"))
events)
(unwind-protect
(progn
(ebox-render-to-buffer
buffer (ebox-commit-test--observed-root "old")
(and observed
(list :observer
(lambda (_buffer report) (push report events)))))
(setq events nil)
(let ((failure
(condition-case condition
(progn
(tp-with-transaction
(ebox-commit
buffer (ebox-commit-test--observed-root "new")))
nil)
(error condition))))
(should (equal (cdr failure)
'("Ebox public operation cannot join an outer TP transaction"))))
(should-not events)
(should (equal (substring-no-properties
(ebox-commit-test--buffer-string buffer))
"old"))
(should-not (with-current-buffer buffer
ebox-surface--observation-contexts)))
(when (buffer-live-p buffer) (kill-buffer buffer))))))
(ert-deftest ebox-native-fragment-style-delta-copies-only-changed-records ()
"A native style delta keeps the retained template immutable."
(let* ((first [0 1 0 nil nil nil nil (1)])
(second [1 2 0 nil nil nil nil (2)])
(template (vector first second))
(target
(ebox-native-commit--apply-fragment-style-delta
template '((1 3 5)))))
(should (eq (aref target 0) first))
(should-not (eq (aref target 1) second))
(should (equal (aref (aref target 1) 7) '(3 5)))
(should (equal (aref second 7) '(2)))))
(ert-deftest ebox-native-session-isolation-bootstraps-or-forks-privately ()
"Session isolation creates the first candidate and forks later candidates."
(let ((created (list 'created-session))
(forked (list 'forked-session))
create-arguments fork-argument)
(cl-letf (((symbol-function 'ebox-native-reflow-create-session)
(lambda (&rest arguments)
(setq create-arguments arguments)
created))
((symbol-function 'ebox-native-reflow-fork-session)
(lambda (session &rest _options)
(setq fork-argument session)
forked)))
(let ((candidate (list :native-sync-pending 'stale
:native-sync-confirmed-p t)))
(should (ebox-native-commit--isolate-session nil candidate))
(should (eq (plist-get candidate :native-sync-session) created))
(should (equal create-arguments
'(:workers 1 :max-jobs 4 :max-results 4)))
(should-not fork-argument)
(should-not (plist-get candidate :native-sync-pending))
(should-not (plist-get candidate :native-sync-confirmed-p)))
(let* ((committed (list 'committed-session))
(candidate (list :native-sync-pending 'stale
:native-sync-confirmed-p t)))
(setq create-arguments nil)
(should
(ebox-native-commit--isolate-session
(list :native-sync-session committed) candidate))
(should (eq fork-argument committed))
(should (eq (plist-get candidate :native-sync-session) forked))
(should-not create-arguments)
(should-not (plist-get candidate :native-sync-pending))
(should (plist-get candidate :native-sync-confirmed-p))))))
(ert-deftest ebox-native-published-frame-confirms-exact-runtime-revision ()
"A pending frame is confirmed only at the installed runtime revision."
(let ((session (list 'candidate-session))
confirmed)
(cl-letf (((symbol-function 'ebox-native-reflow-confirm-native-frame)
(lambda (&rest arguments)
(setq confirmed arguments)
t)))
(let ((state (list :native-sync-session session
:native-sync-pending
'(:generation 3 :key 7 :confirmed-revision 11)
:native-sync-confirmed-p nil
:runtime-revision 11)))
(should (eq (ebox-native-commit-confirm-published-frame state 11)
state))
(should (equal confirmed (list session 3 7 11)))
(should (plist-get state :native-sync-confirmed-p))
(should-not (plist-member state :native-sync-pending)))
(let ((state (list :native-sync-session session
:native-sync-pending
'(:generation 3 :key 7 :confirmed-revision 11)
:runtime-revision 10)))
(should-error (ebox-native-commit-confirm-published-frame state 10))
(should (plist-member state :native-sync-pending))))))
(ert-deftest ebox-native-session-isolation-rejects-create-and-fork-errors ()
"A failed private-session operation preserves state and its diagnosis."
(dolist (previous
(list nil (list :native-sync-session (list 'committed-session))))
(let ((candidate (list :native-sync-pending 'unchanged
:native-sync-confirmed-p t)))
(cl-letf (((symbol-function 'ebox-native-reflow-create-session)
(lambda (&rest _) (error "create failed")))
((symbol-function 'ebox-native-reflow-fork-session)
(lambda (&rest _) (error "fork failed"))))
(should-not
(ebox-native-commit--isolate-session
previous candidate))
(should-not (plist-member candidate :native-sync-session))
(should (eq (plist-get candidate :native-sync-pending) 'unchanged))
(should (plist-get candidate :native-sync-confirmed-p))
(let ((failure (plist-get candidate :native-session-setup-failure)))
(should (eq (plist-get failure :phase)
(if previous 'fork 'create)))
(should (eq (car (plist-get failure :condition)) 'error)))))))
(ert-deftest ebox-native-session-setup-failure-enters-public-report ()
"Ordinary fallback reports and consumes a native setup failure."
(let* ((failure '(:phase create :condition (error "setup failed")))
(state (list :runtime-revision 2
:native-session-setup-failure failure))
report)
(cl-letf (((symbol-function 'tp-surface-report-summary)
(lambda (_surface)
'(:transaction-id 7 :text-operations 1
:property-operations 0 :full-root t :scope-count 0)))
((symbol-function 'tp-surface-revision)
(lambda (_surface) 3)))
(setq report
(ebox-surface--commit-report
'surface state
'(:strategy native-frame :publication-scope layout-owners))))
(should (eq (plist-get report :strategy) 'ordinary-fallback))
(should (equal (plist-get report :native-fallback-reason) failure))
(should-not (plist-member state :native-session-setup-failure))))
(ert-deftest ebox-native-session-retirement-contains-release-failures ()
"Losing native sessions all retire and return diagnostics after commit."
(let ((old (list 'old-session))
(candidate (list 'candidate-session))
(committed (list 'committed-session))
released)
(cl-letf (((symbol-function 'tp-surface-client-state)
(lambda (_surface)
(list :native-sync-session committed)))
((symbol-function 'ebox-surface--release-native-session)
(lambda (session)
(push session released)
(when (eq session old)
(error "release failed")))))
(let ((diagnostics
(ebox-surface--settle-native-session
(list :native-sync-session old)
(list :native-sync-session candidate)
'surface t)))
(should (equal (nreverse released) (list old candidate)))
(should (= 1 (length diagnostics)))
(should (eq (plist-get (car diagnostics) :phase)
'native-session-retirement))
(should (eq (car (plist-get (car diagnostics) :condition))
'error))))))
(ert-deftest ebox-native-object-delta-orders-moved-and-new-nodes ()
"A topology delta names parents before moved and introduced children."
(let* ((old-input
(ebox-test-column (ebox-test-box :key 'a (ebox-test-text "A"))
(ebox-test-box :key 'b (ebox-test-text "B"))))
(old-root (ebox-test-root old-input))
(_old-ids (ebox--runtime-node-ids old-root))
(old-index
(ebox--runtime-index old-root t (ebox-test-source-index old-input)))
(old-objects (make-hash-table :test 'equal))
(new-input
(ebox-test-column (ebox-test-box :key 'b (ebox-test-text "B"))
(ebox-test-box :key 'a (ebox-test-text "A"))
(ebox-test-box :key 'c (ebox-test-text "C"))))
(new-root (ebox-test-root new-input))
(new-source-index
(ebox-tree-source-index
new-root nil nil (ebox-test-source-index new-input)))
(_reconciled
(ebox-tree-reconcile-runtime
old-root (plist-get old-index :source-index)
new-root new-source-index))
(new-index (ebox--runtime-index new-root t new-source-index))
(root-id (plist-get old-root :node-id)))
(ebox-runtime-index-map (lambda (node-id _node)
(puthash node-id (list 'object node-id) old-objects))
(plist-get old-index :node-table))
(let* ((old-state (append (list :root-node old-root
:surface-node-object-table old-objects)
old-index))
(new-state (append (list :root-node new-root) new-index))
(delta
(ebox-native-commit-object-delta-node-ids
old-state new-state
(list :touched-node-ids (list root-id)
:removed-node-ids nil)))
(children (ebox-tree--children-raw new-root))
(introduced (car (last children))))
(should
(equal delta
(append
(list root-id
(plist-get (car children) :node-id)
(plist-get (cadr children) :node-id))
(ebox--runtime-node-ids introduced)))))))
(ert-deftest ebox-native-object-delta-requires-complete-removal-proof ()
"An unreported disappeared object rejects the native topology delta."
(let* ((old-input
(ebox-test-column (ebox-test-box :key 'a (ebox-test-text "A"))
(ebox-test-box :key 'tail (ebox-test-text "T"))
(ebox-test-box :key 'b (ebox-test-text "B"))))
(old-root (ebox-test-root old-input))
(_old-ids (ebox--runtime-node-ids old-root))
(old-index
(ebox--runtime-index old-root t (ebox-test-source-index old-input)))
(old-objects (make-hash-table :test 'equal))
(removed-node (car (last (ebox-tree--children-raw old-root))))
(new-input
(ebox-test-column (ebox-test-box :key 'a (ebox-test-text "A"))
(ebox-test-box :key 'tail (ebox-test-text "T"))))
(new-root (ebox-test-root new-input))
(new-source-index
(ebox-tree-source-index
new-root nil nil (ebox-test-source-index new-input)))
(_reconciled
(ebox-tree-reconcile-runtime
old-root (plist-get old-index :source-index)
new-root new-source-index))
(new-index (ebox--runtime-index new-root t new-source-index))
(root-id (plist-get old-root :node-id)))
(ebox-runtime-index-map (lambda (node-id _node)
(puthash node-id (list 'object node-id) old-objects))
(plist-get old-index :node-table))
(let ((old-state (append (list :root-node old-root
:surface-node-object-table old-objects)
old-index))
(new-state (append (list :root-node new-root) new-index)))
(should-not
(ebox-native-commit-object-delta-node-ids
old-state new-state
(list :touched-node-ids (list root-id)
:removed-node-ids nil)))
(should
(equal
(list root-id)
(ebox-native-commit-object-delta-node-ids
old-state new-state
(list :touched-node-ids (list root-id)
:removed-node-ids
(ebox--runtime-node-ids removed-node))))))))
(ert-deftest ebox-native-frame-spec-patches-only-stable-topology ()
"Only a topology-stable candidate may request a confirmed native patch."
(let* ((node
(ebox-test-box :key 'root (ebox-test-text "Frame") :width '(100)))
(state
(list :viewport-width 120 :viewport-height 10
:runtime-revision 3 :display-signature '(display)
:native-sync-confirmed-p t
:native-base-viewport-width 80
:native-base-viewport-height 10
:native-base-root-width 80
:native-topology-stable-p nil))
(full (ebox-native-commit--frame-spec state node)))
(should full)
(should-not (plist-member full :base-viewport-width))
(plist-put state :native-topology-stable-p t)
(let ((patch (ebox-native-commit--frame-spec state node)))
(should (= (plist-get patch :base-viewport-width) 80))
(should (= (plist-get patch :base-viewport-height) 10))
(should (= (plist-get patch :base-root-width) 80)))))
(ert-deftest ebox-style-schema-composition-is-not-per-node-work ()
"Repeated node construction must not rebuild the immutable schema domain."
(let ((package-calls 0)
(compose-calls 0)
(original-package (symbol-function 'ecss-schema-package-create))
(original-compose (symbol-function 'ecss-schema-set-compose)))
(cl-letf (((symbol-function 'ecss-schema-package-create)
(lambda (&rest arguments)
(cl-incf package-calls)
(apply original-package arguments)))
((symbol-function 'ecss-schema-set-compose)
(lambda (&rest arguments)
(cl-incf compose-calls)
(apply original-compose arguments))))
(dotimes (_ 24)
(ebox-test-box (ebox-test-text "schema-hot-path") :color "#111111")))
(should (= package-calls 0))
(should (= compose-calls 0))))
(ert-deftest ebox-style-declaration-compilation-is-memoized ()
"Repeated equivalent style declarations compile through ECSS once."
(clrhash ebox-style--declaration-cache)
(let ((calls 0)
(original (symbol-function 'ecss-expand-declarations)))
(cl-letf (((symbol-function 'ecss-expand-declarations)
(lambda (&rest arguments)
(cl-incf calls)
(apply original arguments))))
(dotimes (_ 24)
(ebox-style-compile-declarations
'(:color "#111111" :bgcolor "#222222"))))
(should (= calls 1))))
(ert-deftest ebox-commit-publishes-content-change ()
"A declarative commit should publish changed content."
(let* ((buffer (ebox-render-to-buffer
(generate-new-buffer-name " *ebox-commit-content*")
(ebox-test-box :key 'root (ebox-test-text "Before") :width '(80))))
(report (ebox-commit
buffer
(ebox-test-box :key 'root (ebox-test-text "After") :width '(80)))))
(unwind-protect
(progn
(should (string-prefix-p
"After"
(string-trim-right
(substring-no-properties
(ebox-commit-test--buffer-string buffer)))))
(should (plist-get report :runtime-published))
(should (> (plist-get report :patch-count) 0)))
(when (buffer-live-p buffer)
(kill-buffer buffer)))))
(ert-deftest ebox-commit-ignores-caller-narrowing ()
"A full Ebox surface commit must not inherit caller narrowing."
(let ((buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-commit-narrowing*")
(ebox-test-box :key 'root (ebox-test-text "Before")
:width '(80))))
report)
(unwind-protect
(progn
(with-current-buffer buffer
(goto-char (1+ (point-min)))
(narrow-to-region (point) (point-max))
(setq report
(ebox-commit
buffer
(ebox-test-box :key 'root (ebox-test-text "After!")
:width '(80)))))
(should (plist-get report :runtime-published))
(should
(string-prefix-p
"After!"
(string-trim-right
(substring-no-properties
(ebox-commit-test--buffer-string buffer))))))
(when (buffer-live-p buffer)
(kill-buffer buffer)))))
(ert-deftest ebox-commit-preserves-keyed-sibling-identity ()
"Keyed siblings should remain addressable after a reorder commit."
(let* ((buffer (ebox-render-to-buffer
(generate-new-buffer-name " *ebox-commit-keyed*")
(ebox-test-column
(ebox-test-box :key 'a :source-identity 'a (ebox-test-text "A") :width '(40))
(ebox-test-box :key 'b :source-identity 'b (ebox-test-text "B") :width '(40)))))
(old-b (ebox-host-ref-position buffer 'b))
(report (ebox-commit
buffer
(ebox-test-column
(ebox-test-box :key 'b :source-identity 'b (ebox-test-text "B2") :width '(40))
(ebox-test-box :key 'a :source-identity 'a (ebox-test-text "A") :width '(40))))))
(unwind-protect
(progn
(should old-b)
(should (ebox-host-ref-position buffer 'b))
(should (plist-get report :runtime-published))
(should (string-match-p "B2"
(substring-no-properties
(ebox-commit-test--buffer-string buffer)))))
(when (buffer-live-p buffer)
(kill-buffer buffer)))))
(ert-deftest ebox-candidate-root-replacement-is-last-wins-and-absorbing ()
"The private root address absorbs descendant operations without ref overlap."
(let* ((buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-root-candidate*")
(ebox-test-column
(ebox-test-box :key 'a :source-identity 'a (ebox-test-text "A") :width '(40))
(ebox-test-box :key 'b :source-identity 'b (ebox-test-text "B") :width '(40)))))
(surface (with-current-buffer buffer ebox-surface--buffer-surface))
(revision (tp-surface-revision surface))
(candidate (ebox-candidate-begin buffer)))
(unwind-protect
(progn
(ebox-candidate-replace-host-ref
candidate 'a (ebox-test-box :key 'a (ebox-test-text "ignored-before")))
(ebox-candidate-replace-root
candidate
(ebox-test-box :key 'root :source-identity 'a (ebox-test-text "first-root")
:width '(80)))
(ebox-candidate-replace-host-ref
candidate 'b (ebox-test-box :key 'b (ebox-test-text "ignored-after")))
(ebox-candidate-replace-root
candidate
(ebox-test-box :key 'root :source-identity 'b (ebox-test-text "final-root")
:width '(80)))
(should (= (length (ebox-candidate--replacements candidate)) 1))
(let ((report (ebox-commit buffer candidate)))
(should (string-match-p
"final-root"
(substring-no-properties
(ebox-commit-test--buffer-string buffer))))
(should-not (string-match-p
"ignored"
(substring-no-properties
(ebox-commit-test--buffer-string buffer))))
(should (= (tp-surface-revision surface) (1+ revision)))
(should (plist-get report :runtime-published)))
(should-error
(ebox-candidate-replace-root
candidate (ebox-test-box :key 'root (ebox-test-text "sealed")))))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-commit-framework-participant-completes-and-rolls-back ()
"Framework publication is paired, diagnosed, and completed exactly once."
(let ((buffer (generate-new-buffer " *ebox-framework-participant*")))
(unwind-protect
(progn
(ebox-render-to-buffer
buffer (ebox-test-box :key 'root (ebox-test-text "old") :width '(80)))
(let (trace)
(let ((report
(ebox-commit
buffer (ebox-test-box :key 'root (ebox-test-text "new") :width '(80))
(lambda (_report) (push 'publish trace))
(lambda (_report) (push 'rollback trace)))))
(should (equal trace '(publish)))
(should (eq (plist-get report :framework-participant-state)
'completed))
(should-not
(plist-get report :framework-participant-diagnostics))))
(let* ((before (ebox-commit-test--buffer-string buffer))
(original
(symbol-function 'tp--run-transaction-precommit-functions))
trace captured failure)
(cl-letf
(((symbol-function 'tp--run-transaction-precommit-functions)
(lambda ()
(funcall original)
(error "later TP failure"))))
(setq failure
(condition-case condition
(ebox-commit
buffer
(ebox-test-box :key 'root (ebox-test-text "rejected")
:width '(80))
(lambda (report)
(setq captured report)
(push 'publish trace))
(lambda (_report)
(push 'rollback trace)
(error "rollback diagnostic")))
(error condition))))
(should (equal trace '(rollback publish)))
(should (equal (cadr failure) "later TP failure"))
(should (equal-including-properties
(ebox-commit-test--buffer-string buffer) before))
(should (eq (plist-get captured :framework-participant-state)
'rolled-back))
(should (= (length
(plist-get
captured :framework-participant-diagnostics))
1))))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-transaction-participant-is-v2-only ()
"Mount and commit register only through TP's structured participant API."
(should (= (ebox-commit-test--participant-v2-count) 2)))
(ert-deftest ebox-transaction-participant-accepts-structured-protocols ()
"Both consumer-first and final TP manifests satisfy Ebox's v2 contract."
(dolist (protocol '(tp-transaction-protocol-v1+v2
tp-transaction-protocol-v2))
(should
(ebox-surface--validate-tp-v2-capability
(list :transaction-protocol protocol
:structured-participant-api
'tp-transaction-participate-v2)))))
(ert-deftest ebox-transaction-participant-rejects-missing-or-malformed-v2 ()
"Missing or incompatible structured capabilities fail closed."
(should-error
(ebox-surface--validate-tp-v2-capability
'(:transaction-protocol tp-transaction-protocol-v1+v2))
:type 'ebox-surface-tp-protocol-error)
(should-error
(ebox-surface--validate-tp-v2-capability
'(:transaction-protocol tp-transaction-protocol-v1+v2
:structured-participant-api ignore))
:type 'ebox-surface-tp-protocol-error)
(should-error
(ebox-surface--validate-tp-v2-capability
'(:transaction-protocol incompatible
:structured-participant-api tp-transaction-participate-v2))
:type 'ebox-surface-tp-protocol-error))
(ert-deftest ebox-commit-framework-publish-failure-rolls-back-full-and-scoped ()
"A framework publish failure invokes its pair once on both commit paths."
(dolist (mode '(full scoped))
(let ((buffer (generate-new-buffer " *ebox-framework-publish-fail*")))
(unwind-protect
(progn
(ebox-render-to-buffer
buffer
(ebox-test-column
(ebox-test-box :key 'a :source-identity 'a (ebox-test-text "old-a") :width '(40))
(ebox-test-box :key 'b :source-identity 'b (ebox-test-text "old-b") :width '(40))))
(let ((before (ebox-commit-test--buffer-string buffer))
(candidate (ebox-candidate-begin buffer))
trace captured)
(when (eq mode 'scoped)
(ebox-candidate-replace-host-ref
candidate 'a
(ebox-test-box :key 'a :source-identity 'a (ebox-test-text "new-a")
:width '(40))))
(should-error
(ebox-commit
buffer
(if (eq mode 'scoped)
candidate
(ebox-test-box :key 'root (ebox-test-text "new-root") :width '(80)))
(lambda (report)
(setq captured report)
(push 'publish trace)
(error "framework publish failed"))
(lambda (_report) (push 'rollback trace))))
(should (equal trace '(rollback publish)))
(should (eq (plist-get captured :framework-participant-state)
'rolled-back))
(should (equal-including-properties
(ebox-commit-test--buffer-string buffer) before))))
(when (buffer-live-p buffer) (kill-buffer buffer))))))
(ert-deftest ebox-commit-framework-argument-validation ()
"Four-argument framework callbacks have an exact paired contract."
(let ((buffer (generate-new-buffer " *ebox-framework-validation*"))
(root (ebox-test-box :key 'root (ebox-test-text "x"))))
(unwind-protect
(progn
(ebox-render-to-buffer buffer root)
(should-error (ebox-commit buffer root 7) :type 'wrong-type-argument)
(should-error
(ebox-commit buffer root nil #'ignore))
(should-error
(ebox-commit buffer root #'ignore 7)
:type 'wrong-type-argument))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-commit-expands-scope-for-length-changing-column-content ()
"A column content growth must publish shifted later styled siblings."
(let* ((buffer (generate-new-buffer-name " *ebox-commit-column-scope*"))
(old-root
(ebox-test-column
(ebox-test-box :key 'panel :padding '(1 (2))
:border "#687386" :bgcolor "#FFFDF8"
(ebox-test-text "Panel"))
(ebox-test-box :key 'payload :padding '(0 (1))
:border "#AAA" (ebox-test-text "No payload yet."))
(ebox-test-box :key 'later :padding '(0 (1))
:border "#BBB" (ebox-test-text "Later sibling"))))
(new-root
(ebox-test-column
(ebox-test-box :key 'panel :padding '(1 (2))
:border "#687386" :bgcolor "#FFFDF8"
(ebox-test-text "Panel"))
(ebox-test-box :key 'payload :padding '(0 (1))
:border "#AAA"
(ebox-test-text "Payload received: payload=42"))
(ebox-test-box :key 'later :padding '(0 (1))
:border "#BBB" (ebox-test-text "Later sibling"))))
(report nil))
(unwind-protect
(progn
(ebox-render-to-buffer buffer old-root)
(setq report (ebox-commit buffer new-root))
(should (string-match-p
"Payload received: payload=42"
(with-current-buffer buffer (buffer-string))))
(should (string-match-p "Later sibling"
(with-current-buffer buffer (buffer-string))))
(should (eq (plist-get report :strategy) 'owner-rerender))
(should (equal (plist-get report :patch-ops) '(owner-rerender)))
(should-not (plist-get report :tp-scope-fallback)))
(when (buffer-live-p buffer)
(kill-buffer buffer)))))
(ert-deftest ebox-commit-reuses-unchanged-style-computations ()
"A content-only commit should not recompute unchanged retained styles."
(let* ((ebox-style-stylesheet (ecss-stylesheet-create))
(calls 0)
(original (symbol-function 'ecss-compute-style))
(buffer nil))
(ebox-style-add-rule ".card" '(:color "#111111") :layer 'components)
(unwind-protect
(progn
(setq buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-commit-style-cache*")
(ebox-test-column
(ebox-test-box :key 'first :class "card" (ebox-test-text "Before")
:width '(40))
(ebox-test-box :key 'second :class "card" (ebox-test-text "Stable")
:width '(40)))))
(setq calls 0)
(cl-letf (((symbol-function 'ecss-compute-style)
(lambda (&rest arguments)
(cl-incf calls)
(apply original arguments))))
(ebox-commit
buffer
(ebox-test-column
(ebox-test-box :key 'first :class "card" (ebox-test-text "After")
:width '(40))
(ebox-test-box :key 'second :class "card" (ebox-test-text "Stable")
:width '(40))))
(should (= calls 0))))
(when (buffer-live-p buffer)
(kill-buffer buffer)))))
(ert-deftest ebox-commit-builds-one-selector-tree-snapshot ()
"A styled commit should snapshot selector context once for the whole tree."
(let* ((ebox-style-stylesheet (ecss-stylesheet-create))
(calls 0)
(original (symbol-function 'ebox-surface--subject-signature))
(buffer nil))
(ebox-style-add-rule ".card" '(:color "#111111") :layer 'components)
(unwind-protect
(progn
(setq buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-commit-selector-snapshot*")
(ebox-test-column
(ebox-test-box :key 'first :class "card" (ebox-test-text "Before")
:width '(40))
(ebox-test-box :key 'second :class "card" (ebox-test-text "Stable")
:width '(40)))))
(cl-letf (((symbol-function 'ebox-surface--subject-signature)
(lambda (&rest arguments)
(cl-incf calls)
(apply original arguments))))
(ebox-commit
buffer
(ebox-test-column
(ebox-test-box :key 'first :class "card" (ebox-test-text "After")
:width '(40))
(ebox-test-box :key 'second :class "card" (ebox-test-text "Stable")
:width '(40))))
(should (= calls 1))))
(when (buffer-live-p buffer)
(kill-buffer buffer)))))
(ert-deftest ebox-commit-reuses-local-selector-styles-across-tree-change ()
"A subject-local stylesheet should compute only the new Box and Text facts."
(let* ((ebox-style-stylesheet (ecss-stylesheet-create))
(calls 0)
(original (symbol-function 'ecss-compute-style))
(buffer nil))
(ebox-style-add-rule ".card" '(:color "#2255AA") :layer 'components)
(unwind-protect
(progn
(setq buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-local-selector-reuse*")
(ebox-test-column
(ebox-test-box :key 'first :class "card" (ebox-test-text "First")
:width '(40))
(ebox-test-box :key 'second :class "card" (ebox-test-text "Second")
:width '(40)))))
(cl-letf (((symbol-function 'ecss-compute-style)
(lambda (&rest arguments)
(cl-incf calls)
(apply original arguments))))
(ebox-commit
buffer
(ebox-test-column
(ebox-test-box :key 'first :class "card" (ebox-test-text "First")
:width '(40))
(ebox-test-box :key 'second :class "card" (ebox-test-text "Second")
:width '(40))
(ebox-test-box :key 'third :class "card" (ebox-test-text "Third")
:width '(40)))))
(should (= calls 2))
(let* ((text (ebox-commit-test--buffer-string buffer))
(position (string-match "Third" text)))
(should position)
(should (equal (ebox-commit-test--face-value
(get-text-property position 'face text)
:foreground)
"#2255AA"))))
(when (buffer-live-p buffer)
(kill-buffer buffer)))))
(ert-deftest ebox-commit-invalidates-selector-tree-token-for-sibling-change ()
"A sibling metadata change must invalidate retained selector computations."
(let* ((ebox-style-stylesheet (ecss-stylesheet-create))
(buffer nil))
(ebox-style-add-rule ".active + .target" '(:color "#2255AA")
:layer 'components)
(unwind-protect
(progn
(setq buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-commit-selector-change*")
(ebox-test-column
(ebox-test-box :key 'state :class "inactive" (ebox-test-text "State")
:width '(40))
(ebox-test-box :key 'target :class "target" (ebox-test-text "Target")
:width '(40)))))
(let* ((before (ebox-commit-test--buffer-string buffer))
(position (string-match "Target" before)))
(should position)
(should-not (get-text-property position 'face before)))
(ebox-commit
buffer
(ebox-test-column
(ebox-test-box :key 'state :class "active" (ebox-test-text "State")
:width '(40))
(ebox-test-box :key 'target :class "target" (ebox-test-text "Target")
:width '(40))))
(let* ((after (ebox-commit-test--buffer-string buffer))
(position (string-match "Target" after)))
(should position)
(should (equal (ebox-commit-test--face-value
(get-text-property position 'face after)
:foreground)
"#2255AA"))))
(when (buffer-live-p buffer)
(kill-buffer buffer)))))
(ert-deftest ebox-commit-observes-in-place-stylesheet-changes ()
"A retained commit must refresh when its stylesheet changes in place."
(let* ((ebox-style-stylesheet (ecss-stylesheet-create))
(buffer nil))
(ebox-style-add-rule ".card" '(:color "#111111") :layer 'components)
(unwind-protect
(progn
(setq buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-commit-style-rule*")
(ebox-test-box :key 'card :class "card" (ebox-test-text "Stable")
:width '(40))))
(should (equal (ebox-commit-test--face-value
(get-text-property (point-min) 'face buffer)
:foreground)
"#111111"))
(ebox-style-add-rule ".card" '(:color "#222222") :layer 'components)
(ebox-commit
buffer
(ebox-test-box :key 'card :class "card" (ebox-test-text "Stable")
:width '(40)))
(should (equal (ebox-commit-test--face-value
(get-text-property (point-min) 'face buffer)
:foreground)
"#222222")))
(when (buffer-live-p buffer)
(kill-buffer buffer)))))
(ert-deftest ebox-commit-observes-cascade-activation-during-content-change ()
"A commit must not span-patch across an inactive-to-active cascade change."
(let* ((ebox-style-stylesheet (ecss-stylesheet-create))
(buffer nil))
(unwind-protect
(progn
(setq buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-commit-cascade-activation*")
(ebox-test-box :key 'card :class "card" (ebox-test-text "Before")
:width '(40))))
(should-not (get-text-property (point-min) 'face buffer))
(ebox-style-add-rule ".card" '(:color "#2255AA")
:layer 'components)
(let ((report
(ebox-commit
buffer
(ebox-test-box :key 'card :class "card" (ebox-test-text "After")
:width '(40)))))
(should (string-prefix-p
"After"
(string-trim-right
(substring-no-properties
(ebox-commit-test--buffer-string buffer)))))
(should-not (eq (plist-get report :strategy) 'span-patch))
(should (equal (ebox-commit-test--face-value
(get-text-property (point-min) 'face buffer)
:foreground)
"#2255AA"))))
(when (buffer-live-p buffer)
(kill-buffer buffer)))))
(ert-deftest ebox-commit-formatting-context-reflow-owns-variable-line-siblings ()
"Two variable-line owners should publish through their nearest stack context.
The context owns the complete local block; the root and untouched header/footer
remain retained identities."
(let* ((old-root
(ebox-test-column
(ebox-test-box :key 'header (ebox-test-text "Header") :width '(160))
(ebox-test-box
:key 'shell :width '(160)
(ebox-test-column
(ebox-test-box :key 'message :source-identity 'message
(ebox-test-text "Callback action pending"))
(ebox-test-flex :width '(120) :height 1
(ebox-test-box :key 'toggle :source-identity 'toggle
(ebox-test-text "Behavior: off")))))
(ebox-test-box :key 'footer (ebox-test-text "Footer") :width '(160))))
(new-message
(ebox-test-box :key 'message :source-identity 'message
(ebox-test-text "Behavior toggle: on / callback active / a longer status line")))
(new-toggle
(ebox-test-box :key 'toggle :source-identity 'toggle
(ebox-test-text "Behavior: on")))
(new-root
(ebox-test-column
(ebox-test-box :key 'header (ebox-test-text "Header") :width '(160))
(ebox-test-box
:key 'shell :width '(160)
(ebox-test-column
new-message
(ebox-test-flex :width '(120) :height 1 new-toggle)))
(ebox-test-box :key 'footer (ebox-test-text "Footer") :width '(160))))
(buffer nil)
(fresh nil))
(unwind-protect
(progn
(setq buffer
(ebox-render-to-buffer
(generate-new-buffer-name
" *ebox-formatting-context-reflow*")
old-root))
(let ((candidate (ebox-candidate-begin buffer)))
(ebox-candidate-replace-host-ref candidate 'message new-message)
(ebox-candidate-replace-host-ref candidate 'toggle new-toggle)
(let ((root-id
(plist-get (plist-get (ebox--buffer-render-state buffer)
:root-node)
:node-id))
report)
(setq report (ebox-commit buffer candidate))
(should (eq (plist-get report :projection-kind)
'formatting-context-reflow))
(should (= 1 (length (plist-get report :owner-ids))))
(should-not (member root-id (plist-get report :owner-ids)))
(should-not (plist-get report :tp-full-root))
(should-not (plist-get report :tp-scope-fallback))
(should (= 1 (plist-get report :tp-scope-count)))
(should (= 1 (plist-get report :tp-scope-range-count)))
(should (= 1 (plist-get report :tp-text-operations)))))
(setq fresh
(ebox-render-to-buffer
(generate-new-buffer-name
" *ebox-formatting-context-fresh*")
new-root))
(let* ((committed (ebox-commit-test--buffer-string buffer))
(expected (ebox-commit-test--buffer-string fresh))
(keys '(ebox-content ebox-content-idx ebox-content-owner
ebox-content-owners display))
(semantic-owner
(lambda (state value)
(if (numberp value)
(let* ((region-node-table
(plist-get state :region-node-table))
(node-table (plist-get state :node-table))
(parent-table (plist-get state :parent-table))
(node-id (and region-node-table
(ebox-runtime-index-get
value region-node-table)))
(source-node-id node-id)
(root-node-id
(plist-get (plist-get state :root-node)
:node-id))
key)
(while (and node-id (not key))
(when-let* ((node
(ebox-runtime-index-get
node-id node-table)))
(setq key
(ebox-tree-node-key
(plist-get state :source-index) node)))
(setq node-id
(and (not key)
(ebox-runtime-index-get
node-id parent-table))))
(or key
(and (equal source-node-id root-node-id) 'root)
value))
value)))
(semantic-properties
(lambda (state text position)
(mapcar
(lambda (key)
(cons key
(let ((value (get-text-property
position key text)))
(if (memq key '(ebox-content-owner
ebox-content-owners
ebox-content))
(if (listp value)
(mapcar (lambda (owner)
(funcall semantic-owner
state owner))
value)
(funcall semantic-owner state value))
value))))
keys))))
;; Region ids are buffer-local allocation identities. Compare
;; stable node semantics and layout properties, not those ids.
(should (equal (substring-no-properties committed)
(substring-no-properties expected)))
(should (= (length committed) (length expected)))
(dotimes (position (length committed))
(should
(equal (funcall semantic-properties
(ebox--buffer-render-state buffer)
committed position)
(funcall semantic-properties
(ebox--buffer-render-state fresh)
expected position))))))
(when (buffer-live-p buffer)
(kill-buffer buffer))
(when (buffer-live-p fresh)
(kill-buffer fresh)))))
(ert-deftest ebox-commit-formatting-context-reflow-rolls-back-and-retries ()
"Formatting-context reflow keeps one rollback boundary and can retry."
(cl-labels
((root (message toggle)
(ebox-test-column
(ebox-test-box :key 'header (ebox-test-text "Header") :width '(160))
(ebox-test-box
:key 'shell :width '(160)
(ebox-test-column
(ebox-test-box :key 'message :source-identity 'message (ebox-test-text message))
(ebox-test-flex :width '(120) :height 1
(ebox-test-box :key 'toggle :source-identity 'toggle
(ebox-test-text toggle)))))
(ebox-test-box :key 'footer (ebox-test-text "Footer") :width '(160)))))
(dolist (failure-kind '(client-state final-accept))
(let ((buffer (generate-new-buffer
(format " *ebox-formatting-context-%S*" failure-kind))))
(unwind-protect
(progn
(ebox-render-to-buffer
buffer (root "Callback action pending" "Behavior: off"))
(let* ((before (ebox-commit-test--buffer-string buffer))
(state (tp-surface-client-state
(with-current-buffer
buffer ebox-surface--buffer-surface)))
(revision (tp-surface-revision
(with-current-buffer
buffer ebox-surface--buffer-surface)))
(candidate (ebox-candidate-begin buffer)))
(ebox-candidate-replace-host-ref
candidate 'message
(ebox-test-box
:key 'message :source-identity 'message
(ebox-test-text "Behavior toggle: on / callback active / a longer status line")))
(ebox-candidate-replace-host-ref
candidate 'toggle
(ebox-test-box :key 'toggle :source-identity 'toggle
(ebox-test-text "Behavior: on")))
(if (eq failure-kind 'client-state)
(let ((tp--surface-publication-step-function
(lambda (step _surface)
(when (eq step 'client-state)
(error "reject formatting reflow publication")))))
(should-error (ebox-commit buffer candidate)))
(cl-letf (((symbol-function 'accept-change-group)
(lambda (_group)
(error "reject formatting reflow accept"))))
(should-error (ebox-commit buffer candidate))))
(let ((surface (with-current-buffer
buffer ebox-surface--buffer-surface)))
(should (eq (tp-surface-client-state surface) state))
(should (= (tp-surface-revision surface) revision))
(should (equal-including-properties
(ebox-commit-test--buffer-string buffer) before)))
(let ((retry (ebox-candidate-begin buffer)))
(ebox-candidate-replace-host-ref
retry 'message
(ebox-test-box
:key 'message :source-identity 'message
(ebox-test-text "Behavior toggle: on / callback active / a longer status line")))
(ebox-candidate-replace-host-ref
retry 'toggle
(ebox-test-box :key 'toggle :source-identity 'toggle
(ebox-test-text "Behavior: on")))
(let ((report (ebox-commit buffer retry)))
(should (eq (plist-get report :projection-kind)
'formatting-context-reflow))
(should-not (plist-get report :tp-scope-fallback))
(should-not (plist-get report :tp-full-root))))))
(when (buffer-live-p buffer)
(kill-buffer buffer)))))))
(ert-deftest ebox-commit-multi-owner-variable-content-keeps-fixed-slots ()
"Two fixed Grid slots accept unequal one-line content in one publication."
(let* ((new-left
(ebox-test-box :key 'left :source-identity 'left
(ebox-test-text "L")))
(new-right
(ebox-test-box :key 'right :source-identity 'right (ebox-test-text "R")))
(old-root
(ebox-test-grid :key 'grid :width '(80) :grid-template-columns
'((36) (36)) :column-gap '(8)
(ebox-test-box :key 'left :source-identity 'left (ebox-test-text "left-old"))
(ebox-test-box :key 'right :source-identity 'right (ebox-test-text "right-old"))))
(buffer nil)
(fresh nil)
report)
(unwind-protect
(progn
(setq buffer
(ebox-render-to-buffer
(generate-new-buffer-name
" *ebox-multi-owner-variable-slots*")
old-root))
(let ((candidate (ebox-candidate-begin buffer)))
(ebox-candidate-replace-host-ref candidate 'left new-left)
(ebox-candidate-replace-host-ref candidate 'right new-right)
(setq report (ebox-commit buffer candidate)))
(should (memq (plist-get report :projection-kind)
'(span-patch owner-scoped)))
(should-not (plist-get report :tp-full-root))
(should-not (plist-get report :tp-scope-fallback))
;; The 8px Grid gap keeps the two changed slots disjoint. TP still
;; publishes one scoped transaction, with one exact text operation
;; per changed slot instead of replacing the unchanged gap.
(should (= 2 (plist-get report :tp-text-operations)))
(should (string-match-p "L"
(ebox-commit-test--buffer-string buffer)))
(setq fresh
(ebox-render-to-buffer
(generate-new-buffer-name
" *ebox-multi-owner-variable-slots-fresh*")
(ebox-test-grid :key 'grid :width '(80) :grid-template-columns
'((36) (36)) :column-gap '(8)
(ebox-test-box :key 'left :source-identity 'left (ebox-test-text "L"))
(ebox-test-box :key 'right :source-identity 'right (ebox-test-text "R")))))
(should (equal
(substring-no-properties
(ebox-commit-test--buffer-string buffer))
(substring-no-properties
(ebox-commit-test--buffer-string fresh))))
(when (buffer-live-p buffer)
(kill-buffer buffer))
(when (buffer-live-p fresh)
(kill-buffer fresh))))))
(ert-deftest ebox-commit-multi-owner-variable-content-rolls-back-and-retries ()
"Variable multi-owner spans restore old state at both TP failure points."
(cl-labels
((root (left right)
(ebox-test-grid :key 'grid :width '(80)
:grid-template-columns '((36) (36))
:column-gap '(8)
(ebox-test-box :key 'left :source-identity 'left (ebox-test-text left))
(ebox-test-box :key 'right :source-identity 'right (ebox-test-text right))))
(candidate (buffer)
(let ((candidate (ebox-candidate-begin buffer)))
(ebox-candidate-replace-host-ref
candidate 'left
(ebox-test-box :key 'left :source-identity 'left (ebox-test-text "L")))
(ebox-candidate-replace-host-ref
candidate 'right
(ebox-test-box :key 'right :source-identity 'right (ebox-test-text "R")))
candidate)))
(dolist (failure-kind '(client-state final-accept))
(let ((buffer (generate-new-buffer
(format " *ebox-variable-span-%S*" failure-kind))))
(unwind-protect
(progn
(ebox-render-to-buffer
buffer (root "left-old" "right-old"))
(let* ((surface (with-current-buffer
buffer ebox-surface--buffer-surface))
(state (tp-surface-client-state surface))
(revision (tp-surface-revision surface))
(before (ebox-commit-test--buffer-string buffer))
(candidate (candidate buffer)))
(if (eq failure-kind 'client-state)
(let ((tp--surface-publication-step-function
(lambda (step _surface)
(when (eq step 'client-state)
(error "reject variable span publication")))))
(should-error (ebox-commit buffer candidate)))
(cl-letf (((symbol-function 'accept-change-group)
(lambda (_group)
(error "reject variable span accept"))))
(should-error (ebox-commit buffer candidate))))
(should (eq (tp-surface-client-state surface) state))
(should (= (tp-surface-revision surface) revision))
(should (equal-including-properties
(ebox-commit-test--buffer-string buffer) before))
(let ((report (ebox-commit buffer (candidate buffer))))
(should (memq (plist-get report :projection-kind)
'(span-patch owner-scoped)))
(should-not (plist-get report :tp-full-root))
(should-not (plist-get report :tp-scope-fallback)))))
(when (buffer-live-p buffer)
(kill-buffer buffer)))))))
(ert-deftest ebox-commit-updates-selector-type-counts ()
"A structural candidate should publish exact author selector-type counts."
(let* ((buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-commit-types*")
(ebox-build
'(flex :key root :width (80)
(box :key child :width (40) "A")))))
(before (gethash buffer ebox--buffer-render-state-table)))
(unwind-protect
(progn
(should (= (gethash
'box (plist-get before :runtime-type-count-table))
1))
(should (= (gethash
'flex (plist-get before :runtime-type-count-table))
1))
(should (= (gethash
'text (plist-get before :runtime-type-count-table))
1))
(ebox-commit
buffer (ebox-build '(box :key root :width (80) "B")))
(let ((after (gethash buffer ebox--buffer-render-state-table)))
(should-not
(gethash 'item (plist-get after :runtime-type-count-table)))
(should-not
(gethash 'flex (plist-get after :runtime-type-count-table)))
(should (= (gethash
'box (plist-get after :runtime-type-count-table))
1))
(should (= (gethash
'text (plist-get after :runtime-type-count-table))
1))))
(when (buffer-live-p buffer)
(kill-buffer buffer)))))
(ert-deftest ebox-commit-rolls-back-on-invalid-root ()
"A failed candidate must leave the previously published buffer intact."
(let ((buffer (ebox-render-to-buffer
(generate-new-buffer-name " *ebox-commit-rollback*")
(ebox-test-box :key 'root (ebox-test-text "Stable") :width '(80)))))
(unwind-protect
(progn
(should-error
(ebox-commit buffer (ebox-test-box :key 'root (ebox-test-text nil)
:width 'invalid)))
(should (string-prefix-p
"Stable"
(string-trim-right
(substring-no-properties
(ebox-commit-test--buffer-string buffer))))))
(when (buffer-live-p buffer)
(kill-buffer buffer)))))
(ert-deftest ebox-candidate-rejects-invalid-final-parent-participation ()
"A detached replacement must be revalidated after its final graft."
(let* ((buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-participation-rollback*")
(ebox-test-column
(ebox-test-box :key 'target :source-identity 'target
(ebox-test-text "Stable") :width '(80)))))
(surface (with-current-buffer buffer ebox-surface--buffer-surface))
(revision (tp-surface-revision surface))
(before (ebox-commit-test--buffer-string buffer))
(candidate (ebox-candidate-begin buffer)))
(unwind-protect
(progn
;; Detached subtrees do not know their parent yet, so recording the
;; replacement is legal. The final Column graft is authoritative.
(ebox-candidate-replace-host-ref
candidate 'target
(ebox-test-box :key 'target :source-identity 'target
(ebox-test-text "Invalid") :width '(80) :flex-grow 1))
(should-error (ebox-commit buffer candidate) :type 'error)
(should (= (tp-surface-revision surface) revision))
(should (equal (ebox-commit-test--buffer-string buffer) before)))
(when (buffer-live-p buffer)
(kill-buffer buffer)))))
(ert-deftest ebox-candidate-participation-validation-stays-changed-local ()
"One replacement must not participation-validate every sibling."
(let* ((children
(cl-loop for index below 200
collect
(if (= index 99)
(ebox-test-box :key index :source-identity 'target
(ebox-test-text (number-to-string index)))
(ebox-test-box :key index
(ebox-test-text (number-to-string index))))))
(buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-participation-local*")
(apply #'ebox-test-column children)))
(candidate (ebox-candidate-begin buffer))
(original
(symbol-function 'ebox-tree-validate-indexed-participation))
validation-frontiers)
(unwind-protect
(progn
(ebox-candidate-replace-host-ref
candidate 'target
(ebox-test-box :key 99 :source-identity 'target (ebox-test-text "changed")))
(cl-letf
(((symbol-function 'ebox-tree-validate-indexed-participation)
(lambda (node-table parent-table node-ids
&optional source source-index)
(push (cons source (length node-ids))
validation-frontiers)
(funcall original node-table parent-table node-ids
source source-index))))
(ebox-commit buffer candidate))
;; The changed Box, its Text leaf, and direct parent context are the
;; complete validation frontier; 197 siblings remain untouched.
(should (equal validation-frontiers '((computed . 3)))))
(when (buffer-live-p buffer)
(kill-buffer buffer)))))
(ert-deftest ebox-candidate-root-replacement-reuses-candidate-validity-contract ()
"Root replacement rejects invalid, other-buffer, stale, and sealed use."
(let ((first (generate-new-buffer " *ebox-root-valid-first*"))
(second (generate-new-buffer " *ebox-root-valid-second*")))
(unwind-protect
(progn
(ebox-render-to-buffer first (ebox-test-box :key 'root (ebox-test-text "one")))
(ebox-render-to-buffer second (ebox-test-box :key 'root (ebox-test-text "two")))
(let ((candidate (ebox-candidate-begin first)))
(should-error (ebox-candidate-replace-root candidate "invalid"))
(ebox-candidate-replace-root
candidate (ebox-test-box :key 'root (ebox-test-text "candidate")))
(should-error (ebox-commit second candidate))
(should-error
(ebox-candidate-replace-root
candidate (ebox-test-box :key 'root (ebox-test-text "sealed")))))
(let ((candidate (ebox-candidate-begin first)))
(ebox-candidate-replace-root
candidate (ebox-test-box :key 'root (ebox-test-text "stale")))
(ebox-commit first (ebox-test-box :key 'root (ebox-test-text "new-base")))
(should-error (ebox-commit first candidate))))
(dolist (buffer (list first second))
(when (buffer-live-p buffer) (kill-buffer buffer))))))
(ert-deftest ebox-commit-two-and-three-argument-compatibility ()
"Two-argument commits complete and legacy callbacks receive one same report."
(let ((buffer (generate-new-buffer " *ebox-framework-compat*")))
(unwind-protect
(progn
(ebox-render-to-buffer buffer (ebox-test-box :key 'root (ebox-test-text "0")))
(should (eq (plist-get
(ebox-commit buffer (ebox-test-box :key 'root (ebox-test-text "1")))
:framework-participant-state)
'completed))
(let ((calls 0) seen)
(let ((report
(ebox-commit
buffer (ebox-test-box :key 'root (ebox-test-text "2"))
(lambda (value) (cl-incf calls) (setq seen value)))))
(should (= calls 1))
(should (eq seen report))
(should (eq (plist-get seen :framework-participant-state)
'completed)))))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-commit-final-accept-failure-rolls-framework-back ()
"A TP final-accept failure rolls the paired framework pointer back once."
(dolist (mode '(full scoped))
(let ((buffer (generate-new-buffer " *ebox-framework-accept-fail*")))
(unwind-protect
(progn
(ebox-render-to-buffer
buffer
(ebox-test-column
(ebox-test-box :key 'a :source-identity 'a (ebox-test-text "old-a"))
(ebox-test-box :key 'b :source-identity 'b (ebox-test-text "old-b"))))
(let* ((before (ebox-commit-test--buffer-string buffer))
(candidate (ebox-candidate-begin buffer))
trace captured failure)
(ebox-candidate-replace-host-ref
candidate 'a (ebox-test-box :key 'a :source-identity 'a (ebox-test-text "new-a")))
(cl-letf (((symbol-function 'accept-change-group)
(lambda (_group) (error "accept failed"))))
(setq failure
(condition-case condition
(ebox-commit
buffer
(if (eq mode 'scoped)
candidate
(ebox-test-box :key 'root (ebox-test-text "new-root")))
(lambda (report)
(setq captured report)
(push 'publish trace))
(lambda (_report)
(push 'rollback trace)
(signal 'quit nil)))
(error condition))))
(should (equal (cadr failure) "accept failed"))
(should (equal trace '(rollback publish)))
(should (eq (plist-get captured :framework-participant-state)
'rolled-back))
(should (= (length
(plist-get captured
:framework-participant-diagnostics))
1))
(should (equal-including-properties
(ebox-commit-test--buffer-string buffer) before))
(should (eq (plist-get
(ebox-commit
buffer (ebox-test-box :key 'root (ebox-test-text "next")))
:framework-participant-state)
'completed))))
(when (buffer-live-p buffer) (kill-buffer buffer))))))
(ert-deftest ebox-commit-records-scroll-diagnostics-before-completion ()
"Contained scroll failures are separately reported and do not block retry."
(let ((buffer (generate-new-buffer " *ebox-scroll-diagnostics*"))
(diagnostics
'((:region-id one :phase scroll-finalization :action cancel
:condition (error "x"))
(:region-id one :phase scroll-finalization :action stop
:condition (quit)))))
(unwind-protect
(progn
(ebox-render-to-buffer buffer (ebox-test-box :key 'root (ebox-test-text "0")))
(cl-letf
(((symbol-function
'ebox-incremental--finalize-declarative-scroll-publication)
(lambda (&rest _arguments) diagnostics)))
(let ((report
(ebox-commit
buffer (ebox-test-box :key 'root (ebox-test-text "1")))))
(should (eq (plist-get report :framework-participant-state)
'completed))
(should (equal
(plist-get report :scroll-finalization-diagnostics)
diagnostics))))
(should (eq (plist-get
(ebox-commit buffer
(ebox-test-box :key 'root (ebox-test-text "2")))
:framework-participant-state)
'completed)))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-commit-restores-ebox-after-participant-owner-failure ()
"A rollback-owner failure cannot skip restoration of Ebox runtime state."
(let ((buffer (generate-new-buffer " *ebox-participant-owner-failure*")))
(unwind-protect
(progn
(ebox-render-to-buffer buffer (ebox-test-box :key 'root (ebox-test-text "old")))
(let* ((surface (with-current-buffer
buffer ebox-surface--buffer-surface))
(old-state (tp-surface-client-state surface))
(old-buffer (ebox-commit-test--buffer-string buffer))
(original-report
(symbol-function 'ebox-surface--participant-report))
rollback-called failure)
(cl-letf
(((symbol-function 'accept-change-group)
(lambda (_group) (error "primary accept failure")))
((symbol-function 'ebox-surface--participant-report)
(lambda (participant report state)
(prog1 (funcall original-report participant report state)
(when (and rollback-called (eq state 'rolled-back))
(error "rollback owner failure"))))))
(setq failure
(condition-case condition
(ebox-commit
buffer (ebox-test-box :key 'root (ebox-test-text "new"))
#'ignore
(lambda (_report) (setq rollback-called t)))
(error condition))))
(should (equal (cadr failure) "primary accept failure"))
(should rollback-called)
(should
(tp--transaction-condition-trailer failure :rollback-failures))
(should (eq (tp-surface-client-state surface) old-state))
(should (eq (ebox--buffer-render-state buffer) old-state))
(should (equal-including-properties
(ebox-commit-test--buffer-string buffer) old-buffer))))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(defun ebox-commit-test--mixed-owner-root
(left right paint-a paint-b paint-c)
"Return the raw sibling fixture for mixed geometry/paint publication."
(ebox-test-column
(ebox-test-box
:key 'geometry-context :width '(80)
(ebox-test-column
(ebox-test-box :key 'left :source-identity 'left
(ebox-test-text left) :font-weight 'bold)
(ebox-test-box :key 'right :source-identity 'right
(ebox-test-text right))))
(ebox-test-box :key 'paint-a :source-identity 'paint-a
(ebox-test-text "paint-a") :color paint-a)
(ebox-test-box :key 'paint-b :source-identity 'paint-b
(ebox-test-text "paint-b") :bgcolor paint-b)
(ebox-test-box :key 'paint-c :source-identity 'paint-c
(ebox-test-text "paint-c") :color paint-c)
(ebox-test-box :key 'untouched :source-identity 'untouched
(ebox-test-text "untouched"))))
(ert-deftest ebox-candidate-host-paint-patch-preserves-subtree-identity ()
"Patch one Host's paint without copying or reconciling its descendants."
(let* ((buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-host-paint-patch* ")
(ebox-test-box
:key 'target :source-identity 'target :bgcolor "#111111"
(ebox-test-column
(ebox-test-box :key 'child :source-identity 'child (ebox-test-text "child"))))))
(child-id (plist-get (ebox--host-ref-node buffer 'child) :node-id)))
(unwind-protect
(progn
(let ((candidate (ebox-candidate-begin buffer)))
(ebox-candidate-patch-host-paint
candidate 'target
(ebox-test-box
:key 'target :source-identity 'target :bgcolor "#111111"
(ebox-test-column
(ebox-test-box :key 'child :source-identity 'child (ebox-test-text "child"))))
(ebox-test-box
:key 'target :source-identity 'target :bgcolor "#EEEEEE"
(ebox-test-column
(ebox-test-box :key 'child :source-identity 'child (ebox-test-text "child")))))
(let ((report (ebox-commit buffer candidate)))
(should (eq (plist-get report :projection-kind) 'paint))
(should (= child-id
(plist-get (ebox--host-ref-node buffer 'child)
:node-id)))
(should (equal "#EEEEEE"
(plist-get (ebox--host-ref-node buffer 'target)
:bgcolor)))))
(let ((candidate (ebox-candidate-begin buffer)))
(should-not
(ebox-candidate-patch-host-paint
candidate 'target
(ebox-test-box
:key 'target :source-identity 'target :bgcolor "#EEEEEE"
(ebox-test-text "child"))
(ebox-test-box
:key 'target :source-identity 'target :bgcolor "#EEEEEE"
:width '(40) (ebox-test-text "child")))))
(let ((candidate (ebox-candidate-begin buffer)))
(should
(ebox-candidate-patch-host-paint
candidate 'target
(ebox-test-box
:key 'target :source-identity 'target :bgcolor "#EEEEEE"
(ebox-test-column
(ebox-test-box :key 'child :source-identity 'child (ebox-test-text "child"))))
(ebox-test-box
:key 'target :source-identity 'target :bgcolor "#EEEEEE"
:color "#FFFFFF"
(ebox-test-column
(ebox-test-box :key 'child :source-identity 'child (ebox-test-text "child"))))))
(ebox-commit buffer candidate)
(should
(equal "#FFFFFF"
(ebox-style-node-specified-value
(ebox--host-ref-node buffer 'target) :color nil
(plist-get (ebox--buffer-render-state buffer)
:source-index))))
(let* ((rendered (ebox-commit-test--buffer-string buffer))
(position (string-match "child" rendered)))
(should position)
(should
(equal "#FFFFFF"
(ebox-commit-test--face-value
(get-text-property position 'face rendered)
:foreground))))))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(defun ebox-commit-test--fixed-basis-selection-root (row-1 row-2 &optional scroll)
"Return a fixed-basis panel with two rows, inside a scroll box when SCROLL."
(let* ((rows
(ebox-test-column
(ebox-test-box :key 'row-1 :source-identity 'row-1 (ebox-test-text row-1))
(ebox-test-box :key 'row-2 :source-identity 'row-2 (ebox-test-text row-2))))
(panel
(ebox-test-box
:key 'selection-panel :width 'stretch :min-width 0 :min-height 24
:flex-grow 2 :flex-shrink 1 :flex-basis '(340)
(if scroll
(ebox-test-box :key 'scroll :id "scroll" :height 2 :width '(80)
:overflow 'scroll
(ebox-test-column rows (ebox-test-text "line-c\nline-d")))
rows))))
(ebox-test-flex
:key 'fixed-basis-selection-root
:width '(900) :height 24
:flex-flow '(row nowrap) :align-items 'stretch
(ebox-test-box :key 'peer (ebox-test-text "peer") :width 'stretch
:min-width 0 :min-height 24
:flex-grow 4 :flex-shrink 1 :flex-basis '(620))
panel)))
(defun ebox-commit-test--fixed-basis-selection-candidate
(buffer row-1 row-2)
"Return BUFFER candidate replacing both fixed-basis selection rows."
(let ((candidate (ebox-candidate-begin buffer)))
(ebox-candidate-replace-host-ref
candidate 'row-1
(ebox-test-box :key 'row-1 :source-identity 'row-1 (ebox-test-text row-1)))
(ebox-candidate-replace-host-ref
candidate 'row-2
(ebox-test-box :key 'row-2 :source-identity 'row-2 (ebox-test-text row-2)))
candidate))
(defun ebox-commit-test--allocated-single-root
(content color &optional boundary sibling-content)
"Return CONTENT and COLOR beside scroll, with BOUNDARY and SIBLING-CONTENT."
(let ((root
(ebox-test-column :width '(900)
(ebox-commit-test--fixed-basis-selection-root
content (or sibling-content "stable") (eq boundary 'scroll))
(ebox-test-box :key 'paint :source-identity 'paint :color color
(ebox-test-text "paint"))
(unless (eq boundary 'scroll)
(ebox-commit-test--scroll-sibling-root "untouched")))))
(if (eq boundary 'enclosing-paint)
(ebox-test-box :bgcolor "#EEEEEE" root)
root)))
(defun ebox-commit-test--allocated-single-candidate (buffer content &optional color)
"Return BUFFER candidate replacing one row with CONTENT and optional COLOR."
(let ((candidate (ebox-candidate-begin buffer)))
(ebox-candidate-replace-host-ref
candidate 'row-1
(ebox-test-box :key 'row-1 :source-identity 'row-1 (ebox-test-text content)))
(when color
(ebox-candidate-replace-host-ref
candidate 'paint
(ebox-test-box :key 'paint :source-identity 'paint :color color
(ebox-test-text "paint"))))
candidate))
(defun ebox-commit-test--allocated-single-output (buffer)
"Return BUFFER's complete text and public mount coordinates by tree path.
Normalize only buffer-local region identifiers; retain every text property."
(let* ((state (ebox--buffer-render-state buffer))
(objects (plist-get state :surface-node-object-table))
(paths (make-hash-table :test #'eql))
(regions (make-hash-table :test #'eql))
(text (ebox-commit-test--buffer-string buffer))
(properties (delete-dups
(append (mapcar #'cdr ebox-region-types)
'(ebox-scroll-window
ebox-overflow-foreground-source))))
nodes mounts)
(cl-labels ((walk (node path)
(push (cons path node) nodes)
(puthash (plist-get node :node-id) path paths)
(cl-loop for child in (ebox-tree-node-children node)
for index from 0
do (walk child (append path (list index)))))
(region-path (id)
(or (gethash id regions)
(ert-fail (list :unknown-region id)))))
(walk (plist-get state :root-node) '(root))
(ebox-runtime-index-map (lambda (region node-id)
(puthash region (gethash node-id paths) regions))
(plist-get state :region-node-table))
(let ((position 0))
(while (< position (length text))
(let ((end (or (next-property-change position text) (length text)))
(props (text-properties-at position text)))
(dolist (property properties)
(when-let* ((id (plist-get props property)))
(setq props (plist-put props property (region-path id)))))
(when-let* ((owners (plist-get props 'ebox-content-owners)))
(setq props (plist-put props 'ebox-content-owners
(mapcar #'region-path owners))))
(set-text-properties position end props text)
(setq position end))))
(dolist (entry nodes)
(let* ((object (gethash (plist-get (cdr entry) :node-id) objects))
(ranges (mapcar (lambda (mount)
(cons (plist-get mount :start)
(plist-get mount :end)))
(tp-object-mounts object))))
;; Local and full publication can use different role tags, but
;; every owner must cover the same complete published coordinates.
(push (cons (car entry)
(sort ranges (lambda (a b)
(if (= (car a) (car b))
(< (cdr a) (cdr b))
(< (car a) (car b))))))
mounts))))
(list text mounts)))
(defun ebox-commit-test--assert-allocated-output (buffer input)
"Compare BUFFER with an independent full render of canonical INPUT."
(with-temp-buffer
(unwind-protect
(progn
(ebox-render-to-buffer (current-buffer) input)
(let ((actual (ebox-commit-test--allocated-single-output buffer))
(expected (ebox-commit-test--allocated-single-output (current-buffer))))
(should (equal-including-properties (car actual) (car expected)))
(should (equal (cadr actual) (cadr expected)))))
(when (ebox-surface-buffer-mounted-p (current-buffer))
(ebox-unmount-buffer (current-buffer))))))
(defun ebox-commit-test--assert-allocated-single-fresh
(buffer content color &optional sibling-content)
"Compare BUFFER with a new full render of CONTENT, COLOR and SIBLING-CONTENT."
(ebox-commit-test--assert-allocated-output
buffer (ebox-commit-test--allocated-single-root content color nil sibling-content)))
(defun ebox-commit-test--allocated-single-round-trip (paint-p)
"One longer/shorter row promotes its allocated owner, with disjoint paint."
(ert-info ((format "allocated single with disjoint paint: %S" paint-p))
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer)
(ebox-commit-test--allocated-single-root "short" "#123456"))
(let* ((state (ebox--buffer-render-state (current-buffer)))
(owner-id
(cl-loop for id in (ebox-runtime-index-keys (plist-get state :node-table))
for node = (ebox-runtime-index-get id (plist-get state :node-table))
when (eq (ebox-tree-node-author-key
(plist-get state :source-index) node)
'selection-panel)
return (plist-get node :node-id)))
(paint-id (plist-get (ebox--host-ref-node
(current-buffer) 'paint) :node-id))
(scroll-id (car (plist-get state :scroll-region-ids)))
(scroll (gethash scroll-id ebox--scroll-global-state))
(raw (plist-get scroll :content-lines))
(rendered (plist-get scroll :rendered-content-lines))
(region-count (hash-table-count ebox--region-box-table)))
(should (integerp owner-id))
(dolist (step '(("a longer row" "#654321") ("short" "#123456")))
(let* ((content (car step))
(color (if paint-p (cadr step) "#123456"))
(result
(ebox-commit-test--count-root-renders
(lambda ()
(ebox-commit
(current-buffer)
(ebox-commit-test--allocated-single-candidate
(current-buffer) content (and paint-p color))))))
(report (car result)))
(should (zerop (cdr result)))
(should (eq (plist-get report :projection-kind)
(if paint-p 'mixed-owner-reflow 'owner-scoped)))
(should (equal (plist-get report :owner-ids)
(if paint-p (list owner-id paint-id) (list owner-id))))
(should-not (plist-get report :tp-full-root))
(should-not (plist-get report :tp-scope-fallback))
(ebox-commit-test--assert-allocated-single-fresh
(current-buffer) content color)
(let ((next-scroll (gethash scroll-id ebox--scroll-global-state)))
(should (eq raw (plist-get next-scroll :content-lines)))
(should (eq rendered (plist-get next-scroll :rendered-content-lines)))
(should (eq (plist-get next-scroll :box)
(gethash scroll-id ebox--region-box-table)))
(should (= region-count (hash-table-count ebox--region-box-table))))
(should (= 1 (ebox--scroll-region-by scroll-id 1)))
(should (string-match-p "line-c" (buffer-string)))
(should (string-match-p (regexp-quote content) (buffer-string)))
(should (= -1 (ebox--scroll-region-by scroll-id -1)))
(ebox-commit-test--assert-allocated-single-fresh
(current-buffer) content color)))))))
(ert-deftest ebox-commit-allocated-single-round-trip-retains-disjoint-scroll ()
"One content change retains its disjoint scroll through both directions."
(ebox-commit-test--allocated-single-round-trip nil))
(ert-deftest ebox-commit-allocated-single-mixed-round-trip-retains-disjoint-scroll ()
"One content change and sibling paint retain scroll in both directions."
(ebox-commit-test--allocated-single-round-trip t))
(defun ebox-commit-test--allocated-single-rollback (paint-p)
"Rejected allocated-owner publication restores mounts, scroll and revision."
(ert-info ((format "allocated single rollback with paint: %S" paint-p))
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer)
(ebox-commit-test--allocated-single-root "short" "#123456"))
(let* ((before (ebox--buffer-render-state (current-buffer)))
(surface ebox-surface--buffer-surface)
(revision (tp-surface-revision surface))
(report (tp-surface-report surface))
(output (ebox-commit-test--allocated-single-output (current-buffer)))
(scroll-id (car (plist-get before :scroll-region-ids)))
(scroll (gethash scroll-id ebox--scroll-global-state))
(box (gethash scroll-id ebox--region-box-table))
(color (if paint-p "#654321" "#123456"))
(failures 0)
(attempt
(ebox-commit-test--count-root-renders
(lambda ()
(let ((tp--surface-publication-step-function
(lambda (step target)
(when (eq step 'client-state)
(should (eq target surface))
(cl-incf failures)
(should (= (tp-surface-revision surface) (1+ revision)))
(should-not (eq before (tp-surface-client-state surface)))
(error "Reject allocated single publication")))))
(should-error
(ebox-commit
(current-buffer)
(ebox-commit-test--allocated-single-candidate
(current-buffer) "a longer row" (and paint-p color)))))))))
(should (= failures 1))
(should (equal (car attempt) '(error "Reject allocated single publication")))
(should (eq before (ebox--buffer-render-state (current-buffer))))
(should (eq before (tp-surface-client-state surface)))
(should (= revision (tp-surface-revision surface)))
(should (equal report (tp-surface-report surface)))
(should (equal-including-properties
output (ebox-commit-test--allocated-single-output (current-buffer))))
(should (eq scroll (gethash scroll-id ebox--scroll-global-state)))
(should (eq box (gethash scroll-id ebox--region-box-table)))
(should (= 1 (ebox--scroll-region-by scroll-id 1)))
(should (= -1 (ebox--scroll-region-by scroll-id -1)))
(let* ((retry-revision (tp-surface-revision surface))
(retry
(ebox-commit-test--count-root-renders
(lambda ()
(ebox-commit
(current-buffer)
(ebox-commit-test--allocated-single-candidate
(current-buffer) "a longer row" (and paint-p color)))))))
(should (zerop (cdr attempt)))
(should (zerop (cdr retry)))
(should (= (tp-surface-revision surface) (1+ retry-revision)))
(should-not (plist-get (car retry) :tp-full-root))
(ebox-commit-test--assert-allocated-single-fresh
(current-buffer) "a longer row" color))))))
(ert-deftest ebox-commit-allocated-single-publication-rollback-and-fresh-retry ()
"One allocated content change rolls back and accepts a fresh retry."
(ebox-commit-test--allocated-single-rollback nil))
(ert-deftest ebox-commit-allocated-single-mixed-rollback-and-fresh-retry ()
"An allocated content and paint transaction rolls back and retries."
(ebox-commit-test--allocated-single-rollback t))
(ert-deftest ebox-commit-allocated-single-unsafe-boundaries-fall-back ()
"Changed extent and owner-scroll overlap retain fallback."
(dolist (boundary '(extent scroll))
(ert-info ((format "allocated single unsafe boundary: %S" boundary))
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer)
(ebox-commit-test--allocated-single-root "short" "#123456" boundary))
(let* ((content (if (eq boundary 'extent)
(mapconcat #'identity (make-list 30 "long row") "\n")
"a longer row"))
(result
(ebox-commit-test--count-root-renders
(lambda ()
(ebox-commit
(current-buffer)
(ebox-commit-test--allocated-single-candidate
(current-buffer) content))))))
(should (= (cdr result) 1))
(should-not (memq (plist-get (car result) :projection-kind)
'(span-patch owner-scoped mixed-owner-reflow)))
(should (string-match-p "long" (buffer-string))))))))
(ert-deftest ebox-commit-allocated-single-retains-anonymous-enclosing-paint ()
"Unchanged paint on an anonymous ancestor permits allocated publication."
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer)
(ebox-commit-test--allocated-single-root "short" "#123456" 'enclosing-paint))
(dolist (content '("a longer row" "short"))
(let ((result
(ebox-commit-test--count-root-renders
(lambda ()
(ebox-commit
(current-buffer)
(ebox-commit-test--allocated-single-candidate
(current-buffer) content))))))
(ebox-commit-test--assert-allocated-output
(current-buffer)
(ebox-commit-test--allocated-single-root content "#123456" 'enclosing-paint))
(should (zerop (cdr result)))
(should (eq (plist-get (car result) :projection-kind) 'owner-scoped))
(should-not (plist-get (car result) :tp-full-root))
(should-not (plist-get (car result) :tp-scope-fallback))))))
(ert-deftest ebox-commit-allocated-single-keeps-successful-leaf-proof ()
"An existing narrow single-leaf proof stays local without owner promotion."
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer) (ebox-commit-test--scroll-sibling-root "old"))
(let* ((leaf-id (plist-get (ebox--host-ref-node (current-buffer) 'label) :node-id))
(result
(ebox-commit-test--count-root-renders
(lambda ()
(ebox-commit-test--replace-scroll-sibling-label
(current-buffer) "new")))))
(should (zerop (cdr result)))
(should (equal (plist-get (car result) :owner-ids) (list leaf-id)))
(should-not (plist-get (car result) :tp-full-root))
(should (string-match-p "new" (buffer-string))))))
(ert-deftest ebox-commit-grouped-allocation-retains-ancestor-ownership ()
"An existing multiple-descendant allocation preserves every ancestor mount."
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer) (ebox-commit-test--allocated-single-root "short" "#123456"))
(let ((result
(ebox-commit-test--count-root-renders
(lambda ()
(ebox-commit
(current-buffer)
(ebox-commit-test--fixed-basis-selection-candidate
(current-buffer) "a longer row" "other"))))))
(should (zerop (cdr result)))
(should (eq (plist-get (car result) :projection-kind) 'owner-scoped))
(ebox-commit-test--assert-allocated-single-fresh
(current-buffer) "a longer row" "#123456" "other"))))
(defun ebox-commit-test--padded-grouped-allocation-root
(first second color &optional owner-sizing)
"Return FIRST and SECOND in a padded panel beside COLOR and scroll.
OWNER-SIZING adds asymmetric margins, padding and borders to the inner Column."
(ebox-test-column :width '(900)
(ebox-test-flex :width '(900) :height 24
:flex-flow '(row nowrap) :align-items 'stretch
(ebox-test-box :key 'peer :width 'stretch :min-width 0 :min-height 24
:flex-grow 0 :flex-shrink 0 :flex-basis '(561)
(ebox-test-text "peer"))
(ebox-test-column :key 'panel :source-identity 'panel
:width 'stretch :min-width 0 :min-height 24
:box-sizing 'border-box :padding '(0 (15))
:flex-grow 0 :flex-shrink 0 :flex-basis '(339)
:bgcolor "#EEEEEE"
(apply #'ebox-test-column
(append
(list :key 'rows :source-identity 'rows :min-width 0
(ebox-test-text first :key 'row-1 :source-identity 'row-1)
(ebox-test-text second :key 'row-2 :source-identity 'row-2))
(and owner-sizing
(list :box-sizing owner-sizing
:margin-left '(2) :margin-right '(4)
:padding-left '(3) :padding-right '(5)
:border-left '(1 solid "#223344")
:border-right '(2 solid "#445566")))))))
(ebox-test-box :key 'paint :source-identity 'paint :color color
(ebox-test-text "paint"))
(ebox-commit-test--scroll-sibling-root "untouched")))
(defun ebox-commit-test--padded-grouped-allocation-candidate
(buffer first second color)
"Return BUFFER candidate replacing both nested rows and sibling COLOR."
(let ((candidate (ebox-candidate-begin buffer)))
(cl-loop for identity in '(row-1 row-2) for content in (list first second)
do (ebox-candidate-replace-host-ref
candidate identity
(ebox-test-text content :key identity :source-identity identity)))
(ebox-candidate-replace-host-ref
candidate 'paint
(ebox-test-box :key 'paint :source-identity 'paint :color color
(ebox-test-text "paint")))
candidate))
(defun ebox-commit-test--padded-grouped-allocation-round-trip (&optional owner-sizing)
"Check grouped width and repeated edits with optional OWNER-SIZING."
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer)
(ebox-commit-test--padded-grouped-allocation-root
"short" "small" "#123456" owner-sizing))
(let ((owner-id (plist-get (ebox--host-ref-node (current-buffer) 'rows) :node-id))
(grouped-proof (symbol-function 'ebox-incremental--grouped-owner-span-proof)))
;; Equal-extent edits coalesce their successful narrow proofs at the
;; inner Column. Length changes promote the containing fixed-basis
;; panel under the existing scroll guard; both owners must stay local.
(dolist (step '(("other" "later" "#654321")
("a longer first row" "a longer second row" "#123456")
("short" "small" "#654321")))
(let ((candidate (apply #'ebox-commit-test--padded-grouped-allocation-candidate
(current-buffer) step))
proof result)
(cl-letf (((symbol-function 'ebox-incremental--grouped-owner-span-proof)
(lambda (&rest arguments)
(let ((value (apply grouped-proof arguments)))
(when value (setq proof value))
value))))
(setq result (ebox-commit-test--count-root-renders
(lambda () (ebox-commit (current-buffer) candidate)))))
(ebox-commit-test--assert-allocated-output
(current-buffer)
(apply #'ebox-commit-test--padded-grouped-allocation-root
(append step (list owner-sizing))))
(when (equal (car step) "other")
(should (equal (plist-get proof :owner-ids) (list owner-id)))
(let* ((owner-proof (car (plist-get proof :owner-proofs)))
(snapshot (plist-get owner-proof :snapshot))
(owner-width
(plist-get (plist-get snapshot :external-footprint-signature)
:max-line-pixel-width))
(capacity (plist-get owner-proof :allocated-width)))
(message "Padded grouped Column: sizing=%S owner-width=%S ancestor-capacity=%S root-renders=%S"
owner-sizing owner-width capacity (cdr result))
(should (= owner-width 309))
(should (= capacity 339))))
(should (zerop (cdr result)))
(should (eq (plist-get (car result) :projection-kind) 'mixed-owner-reflow))
(should-not (plist-get (car result) :tp-full-root)))))))
(ert-deftest ebox-commit-grouped-padded-panel-renders-own-column-width ()
"A grouped Column uses its own published width inside a padded Flex item."
(ebox-commit-test--padded-grouped-allocation-round-trip))
(ert-deftest ebox-commit-grouped-padded-panel-preserves-owner-box-model ()
"Asymmetric margins, padding and borders preserve both owner box models."
(dolist (sizing '(content-box border-box))
(ert-info ((format "padded grouped owner sizing: %S" sizing))
(ebox-commit-test--padded-grouped-allocation-round-trip sizing))))
(ert-deftest ebox-commit-grouped-padded-panel-rolls-back-and-retries ()
"Rejected nested owner publication restores mounts and both box models."
(dolist (sizing '(content-box border-box))
(ert-info ((format "padded grouped rollback sizing: %S" sizing))
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer)
(ebox-commit-test--padded-grouped-allocation-root
"short" "small" "#123456" sizing))
(let* ((before (ebox--buffer-render-state (current-buffer)))
(surface ebox-surface--buffer-surface)
(revision (tp-surface-revision surface))
(report (tp-surface-report surface))
(output (ebox-commit-test--allocated-single-output (current-buffer)))
(owner-id (plist-get (ebox--host-ref-node (current-buffer) 'rows) :node-id))
(paint-id (plist-get (ebox--host-ref-node (current-buffer) 'paint) :node-id))
(scroll-id (car (plist-get before :scroll-region-ids)))
(scroll (gethash scroll-id ebox--scroll-global-state))
(failures 0)
(rejected
(ebox-commit-test--count-root-renders
(lambda ()
(let ((tp--surface-publication-step-function
(lambda (step target)
(when (eq step 'client-state)
(should (eq target surface))
(cl-incf failures)
(should (= (tp-surface-revision surface) (1+ revision)))
(should-not (eq before (tp-surface-client-state surface)))
(error "Reject padded grouped publication")))))
(should-error
(ebox-commit
(current-buffer)
(ebox-commit-test--padded-grouped-allocation-candidate
(current-buffer) "other" "later" "#654321"))))))))
(should (= failures 1))
(should (equal (car rejected) '(error "Reject padded grouped publication")))
(should (zerop (cdr rejected)))
(should (eq before (ebox--buffer-render-state (current-buffer))))
(should (eq before (tp-surface-client-state surface)))
(should (= revision (tp-surface-revision surface)))
(should (equal report (tp-surface-report surface)))
(should (eq scroll (gethash scroll-id ebox--scroll-global-state)))
(should (equal-including-properties
output (ebox-commit-test--allocated-single-output (current-buffer))))
(ebox-commit-test--assert-allocated-output
(current-buffer)
(ebox-commit-test--padded-grouped-allocation-root
"short" "small" "#123456" sizing))
(let ((retry
(ebox-commit-test--count-root-renders
(lambda ()
(ebox-commit
(current-buffer)
(ebox-commit-test--padded-grouped-allocation-candidate
(current-buffer) "other" "later" "#654321"))))))
(should (zerop (cdr retry)))
(should (= (tp-surface-revision surface) (1+ revision)))
(should (equal (plist-get (car retry) :owner-ids) (list owner-id paint-id)))
(should (eq (plist-get (car retry) :projection-kind) 'mixed-owner-reflow))
(should-not (plist-get (car retry) :tp-full-root))
(let ((next-scroll (gethash scroll-id ebox--scroll-global-state)))
(should (eq (plist-get scroll :content-lines)
(plist-get next-scroll :content-lines)))
(should (eq (plist-get scroll :rendered-content-lines)
(plist-get next-scroll :rendered-content-lines)))
(should (eq (plist-get next-scroll :box)
(gethash scroll-id ebox--region-box-table))))
(ebox-commit-test--assert-allocated-output
(current-buffer)
(ebox-commit-test--padded-grouped-allocation-root
"other" "later" "#654321" sizing))))))))
(ert-deftest ebox-commit-allocated-owner-retains-enclosing-properties ()
"Resized text retains caller faces and the baseline for later paint edits."
(let ((callback (lambda () 'allocated-action))
(payload (make-hash-table :test #'eq))
(keymap (make-sparse-keymap))
(face '(:weight bold)))
(define-key keymap (kbd "RET") callback)
(cl-labels
((text (content)
(propertize content 'face face 'action callback))
(parent (content color)
(apply #'ebox-test-box
(append
(list :key 'enclosing :source-identity 'enclosing
:surface-properties
(list 'help-echo callback 'custom payload 'keymap keymap)
(ebox-commit-test--fixed-basis-selection-root
(text content) "stable"))
(and color (list :bgcolor color)))))
(root (content color)
(ebox-test-column :width '(900)
(ebox-test-box :bgcolor "#FFFDF8" (parent content color))
(ebox-commit-test--scroll-sibling-root "untouched")))
(assert-content (content background)
(save-excursion
(goto-char (point-min))
(search-forward content)
(let ((position (- (point) (length content))))
(dotimes (offset (length content))
(let ((at (+ position offset)))
(should (eq callback (get-text-property at 'help-echo)))
(should (eq callback (get-text-property at 'action)))
(should (eq payload (get-text-property at 'custom)))
(should (eq callback
(lookup-key (get-text-property at 'keymap) (kbd "RET"))))
(should (eq 'bold (ebox-commit-test--face-value
(get-text-property at 'face) :weight)))
(should (equal background
(ebox-commit-test--face-value
(get-text-property at 'face) :background)))))))))
(with-temp-buffer
(ebox-render-to-buffer (current-buffer) (root "short" "#EEEEEE"))
(dolist (content '("a longer row" "short"))
(let ((result
(ebox-commit-test--count-root-renders
(lambda ()
(ebox-commit
(current-buffer)
(ebox-commit-test--allocated-single-candidate
(current-buffer) (text content)))))))
(ebox-commit-test--assert-allocated-output
(current-buffer) (root content "#EEEEEE"))
(assert-content content "#EEEEEE")
(should (zerop (cdr result)))
(should (eq (plist-get (car result) :projection-kind) 'owner-scoped))))
(let ((previous "#EEEEEE"))
(dolist (color '("#667788" nil))
(let ((candidate (ebox-candidate-begin (current-buffer))))
(should (ebox-candidate-patch-host-paint
candidate 'enclosing
(parent "short" previous) (parent "short" color)))
(let ((result (ebox-commit-test--count-root-renders
(lambda () (ebox-commit (current-buffer) candidate)))))
(ebox-commit-test--assert-allocated-output
(current-buffer) (root "short" color))
(assert-content "short" (or color "#FFFDF8"))
(should (zerop (cdr result)))
(should (eq (plist-get (car result) :projection-kind) 'paint))))
(setq previous color)))))))
(ert-deftest ebox-commit-allocated-owner-property-changes-render-current-values ()
"Opaque payload and caller display changes cannot retain stale properties."
(dolist (change '(callback keymap hash caller-display noncanonical-display))
(ert-info ((format "allocated owner changed property: %S" change))
(let* ((make-callback (lambda ()
(let ((value (vector t))) (lambda () value))))
(callback (funcall make-callback))
(other-callback (funcall make-callback))
(property (pcase change
('callback 'action) ('keymap 'keymap) ('hash 'custom)
(_ 'display)))
(old-value (pcase change
('callback callback)
('keymap (let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") callback) map))
('hash (make-hash-table :test #'eq))
('caller-display '(space :width (8)))
(_ '(raise 0))))
(new-value (pcase change
('callback other-callback)
('keymap (let ((map (make-sparse-keymap)))
(define-key map (kbd "RET") other-callback) map))
('hash (make-hash-table :test #'eq))
('caller-display '(space :width (12)))
(_ '(raise 1))))
(old (propertize "short" property old-value))
(new (propertize "a longer row" property new-value)))
(when (memq change '(callback keymap))
(should (equal old-value new-value))
(should-not (eq old-value new-value)))
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer)
(ebox-commit-test--allocated-single-root old "#123456" 'enclosing-paint))
(let ((result
(ebox-commit-test--count-root-renders
(lambda ()
(ebox-commit
(current-buffer)
(ebox-commit-test--allocated-single-candidate (current-buffer) new))))))
(ebox-commit-test--assert-allocated-output
(current-buffer)
(ebox-commit-test--allocated-single-root new "#123456" 'enclosing-paint))
(save-excursion
(goto-char (point-min))
(search-forward "a longer row")
(let ((actual (get-text-property (1- (point)) property)))
(pcase change
((or 'callback 'hash) (should (eq new-value actual)))
('keymap (should (eq other-callback (lookup-key actual (kbd "RET")))))
(_ (should (equal new-value actual))))))
(should (> (cdr result) 0))))))))
(ert-deftest ebox-commit-allocated-owner-interior-property-boundary-declines ()
"A published property boundary inside resized content declines transport."
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer)
(ebox-commit-test--allocated-single-root "short" "#123456" 'enclosing-paint))
(save-excursion
(goto-char (point-min))
(search-forward "short")
(let ((inhibit-read-only t))
(put-text-property (- (point) 3) (- (point) 1) 'external-boundary 'published)))
(let ((transport (symbol-function 'ebox-surface--retained-slot-owner-text))
(declines 0)
result)
(cl-letf (((symbol-function 'ebox-surface--retained-slot-owner-text)
(lambda (&rest arguments)
(let ((value (apply transport arguments)))
(unless value (cl-incf declines))
value))))
(setq result
(ebox-commit-test--count-root-renders
(lambda ()
(ebox-commit
(current-buffer)
(ebox-commit-test--allocated-single-candidate
(current-buffer) "a longer row"))))))
(should (> declines 0))
(should (> (cdr result) 0))
(ebox-commit-test--assert-allocated-output
(current-buffer)
(ebox-commit-test--allocated-single-root
"a longer row" "#123456" 'enclosing-paint)))))
(ert-deftest ebox-commit-allocated-owner-enclosing-properties-rollback-and-retry ()
"Late rejection restores enclosing properties, mounts and opaque identities."
(let ((callback (lambda () 'allocated-action))
(payload (make-hash-table :test #'eq))
(keymap (make-sparse-keymap)))
(define-key keymap (kbd "RET") callback)
(cl-labels
((text (content) (propertize content 'face '(:weight bold) 'action callback))
(root (content)
(ebox-test-box :bgcolor "#FFFDF8"
(ebox-test-box :bgcolor "#EEEEEE"
:surface-properties
(list 'help-echo callback 'custom payload 'keymap keymap)
(ebox-commit-test--allocated-single-root (text content) "#123456")))))
(with-temp-buffer
(ebox-render-to-buffer (current-buffer) (root "short"))
(let* ((before (ebox--buffer-render-state (current-buffer)))
(surface ebox-surface--buffer-surface)
(revision (tp-surface-revision surface))
(report (tp-surface-report surface))
(output (ebox-commit-test--allocated-single-output (current-buffer)))
(failures 0)
(attempt
(ebox-commit-test--count-root-renders
(lambda ()
(let ((tp--surface-publication-step-function
(lambda (step target)
(when (eq step 'client-state)
(should (eq target surface))
(cl-incf failures)
(should (= (tp-surface-revision surface) (1+ revision)))
(should-not (eq before (tp-surface-client-state surface)))
(error "Reject allocated enclosing properties")))))
(should-error
(ebox-commit
(current-buffer)
(ebox-commit-test--allocated-single-candidate
(current-buffer) (text "a longer row")))))))))
(should (= failures 1))
(should (equal (car attempt) '(error "Reject allocated enclosing properties")))
(should (zerop (cdr attempt)))
(should (eq before (ebox--buffer-render-state (current-buffer))))
(should (eq before (tp-surface-client-state surface)))
(should (= revision (tp-surface-revision surface)))
(should (equal report (tp-surface-report surface)))
(should (equal-including-properties
output (ebox-commit-test--allocated-single-output (current-buffer))))
(ebox-commit-test--assert-allocated-output (current-buffer) (root "short"))
(let ((retry
(ebox-commit-test--count-root-renders
(lambda ()
(ebox-commit
(current-buffer)
(ebox-commit-test--allocated-single-candidate
(current-buffer) (text "a longer row")))))))
(should (zerop (cdr retry)))
(should (= (tp-surface-revision surface) (1+ revision)))
(should (eq (plist-get (car retry) :projection-kind) 'owner-scoped))
(should-not (plist-get (car retry) :tp-full-root))
(ebox-commit-test--assert-allocated-output (current-buffer) (root "a longer row"))
(save-excursion
(goto-char (point-min))
(search-forward "a longer row")
(should (eq callback (get-text-property (1- (point)) 'action)))
(should (eq callback (get-text-property (1- (point)) 'help-echo)))
(should (eq payload (get-text-property (1- (point)) 'custom)))
(should (eq callback
(lookup-key (get-text-property (1- (point)) 'keymap)
(kbd "RET")))))))))))
(ert-deftest ebox-commit-grouped-owners-retain-disjoint-scroll ()
"A stable slot groups two text edits, with optional paint, beside scroll."
(dolist (paint-p '(nil t))
(ert-info ((format "grouped geometry with external paint: %S" paint-p))
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer)
(ebox-test-column :width '(900)
(if paint-p
(ebox-test-box :width '(200) :height 2
(ebox-test-column :key 'header :source-identity 'header
(ebox-test-text "[x] row 1" :key 'row-1 :source-identity 'row-1)
(ebox-test-text "[ ] row 2" :key 'row-2 :source-identity 'row-2)))
(ebox-commit-test--fixed-basis-selection-root "[x] row 1" "[ ] row 2"))
(ebox-test-box :key 'paint :source-identity 'paint :color "#123456"
(ebox-test-text "paint"))
(ebox-commit-test--scroll-sibling-root "untouched")))
(let* ((state (ebox--buffer-render-state (current-buffer)))
(scroll-id (car (plist-get state :scroll-region-ids)))
(scroll (gethash scroll-id ebox--scroll-global-state))
(raw (plist-get scroll :content-lines))
(rendered (plist-get scroll :rendered-content-lines))
(region-count (hash-table-count ebox--region-box-table))
(owner-id
(if paint-p
(plist-get (ebox--host-ref-node (current-buffer) 'header) :node-id)
(ebox-incremental--nearest-fixed-basis-flex-item-owner-id
(current-buffer)
(plist-get (ebox--host-ref-node (current-buffer) 'row-1) :node-id))))
(before (buffer-substring-no-properties (point-min) (point-max)))
(footprint (ebox--rendered-span-footprint-signature (buffer-string)))
(expected (replace-regexp-in-string
(regexp-quote "[ ] row 2") "[x] row 2"
(replace-regexp-in-string
(regexp-quote "[x] row 1") "[ ] row 1" before)))
(root-render (symbol-function 'ebox-surface--render-candidate))
(root-renders 0)
report)
(should scroll-id)
(cl-letf (((symbol-function 'ebox-surface--render-candidate)
(lambda (candidate-state)
(cl-incf root-renders)
(funcall root-render candidate-state))))
(let ((candidate
(if paint-p
(ebox-candidate-begin (current-buffer))
(ebox-commit-test--fixed-basis-selection-candidate
(current-buffer) "[ ] row 1" "[x] row 2"))))
(when paint-p
(ebox-candidate-replace-host-ref
candidate 'row-1
(ebox-test-text "[ ] row 1" :key 'row-1 :source-identity 'row-1))
(ebox-candidate-replace-host-ref
candidate 'row-2
(ebox-test-text "[x] row 2" :key 'row-2 :source-identity 'row-2))
(ebox-candidate-replace-host-ref
candidate 'paint
(ebox-test-box :key 'paint :source-identity 'paint :color "#654321"
(ebox-test-text "paint"))))
(setq report (ebox-commit (current-buffer) candidate))))
(if paint-p
(should (eq (plist-get report :projection-kind) 'mixed-owner-reflow))
(should (memq (plist-get report :projection-kind) '(span-patch owner-scoped))))
(should (equal (plist-get report :owner-ids)
(append (list owner-id)
(when paint-p
(list (plist-get
(ebox--host-ref-node (current-buffer) 'paint)
:node-id))))))
(should (zerop root-renders))
(should-not (plist-get report :tp-full-root))
(should (equal expected (buffer-substring-no-properties (point-min) (point-max))))
(should (equal footprint
(ebox--rendered-span-footprint-signature (buffer-string))))
(let ((next-scroll (gethash scroll-id ebox--scroll-global-state)))
(should (eq raw (plist-get next-scroll :content-lines)))
(should (eq rendered (plist-get next-scroll :rendered-content-lines)))
(should (eq (plist-get next-scroll :box)
(gethash scroll-id ebox--region-box-table)))
(should (= region-count (hash-table-count ebox--region-box-table))))
(should (= 1 (ebox--scroll-region-by scroll-id 1)))
(should (string-match-p "line-c" (buffer-string)))
(should (string-match-p (regexp-quote "[x] row 2") (buffer-string)))
(should (= -1 (ebox--scroll-region-by scroll-id -1)))
(should (string-match-p "line-a" (buffer-string)))
(should (equal expected (buffer-substring-no-properties (point-min) (point-max))))
(ebox-commit-test--assert-scroll-family-output
(regexp-quote "[ ] row 1") (regexp-quote "[x] row 2")
(if paint-p "#654321" "#123456")))))))
(ert-deftest ebox-commit-group-containing-scroll-refreshes-cache ()
"A group containing scrolling descendants must rebuild their cached text."
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer)
(ebox-commit-test--fixed-basis-selection-root "[x] row 1" "[ ] row 2" t))
(let* ((state (ebox--buffer-render-state (current-buffer)))
(scroll-id (car (plist-get state :scroll-region-ids)))
(raw (plist-get (gethash scroll-id ebox--scroll-global-state)
:content-lines))
(report
(ebox-commit
(current-buffer)
(ebox-commit-test--fixed-basis-selection-candidate
(current-buffer) "[ ] row 1" "[x] row 2"))))
(should scroll-id)
(should-not (memq (plist-get report :projection-kind)
'(span-patch owner-scoped)))
(should-not (eq raw (plist-get (gethash scroll-id ebox--scroll-global-state)
:content-lines)))
(should (= 1 (ebox--scroll-region-by scroll-id 1)))
(should (string-match-p "line-c" (buffer-string)))
(should (string-match-p (regexp-quote "[x] row 2") (buffer-string)))
(should (= -1 (ebox--scroll-region-by scroll-id -1)))
(should (string-match-p (regexp-quote "[ ] row 1") (buffer-string)))
(should (string-match-p (regexp-quote "[x] row 2") (buffer-string)))
(should-not (string-match-p (regexp-quote "[x] row 1") (buffer-string)))
(should-not (string-match-p (regexp-quote "[ ] row 2") (buffer-string))))))
(ert-deftest ebox-commit-fixed-basis-selection-round-trip-stays-local ()
"Continuous row-1 -> row-2 -> row-1 publication keeps local TP scope."
(let ((planner-render-count 0)
(surface-render-count 0)
(original-planner-render
(symbol-function 'ebox--flex-item-slot-footprint-safe-p))
(original-surface-render
(symbol-function 'ebox-surface--render-candidate-node))
(buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-fixed-basis-round-trip* ")
(ebox-commit-test--fixed-basis-selection-root
"[x] row 1" "[ ] row 2"))))
(unwind-protect
(let* ((root-id (ebox--buffer-root-node-id buffer))
(panel-id
(plist-get (ebox--host-ref-node buffer 'row-1) :node-id))
reports)
(setq panel-id
(ebox-incremental--nearest-fixed-basis-flex-item-owner-id
buffer panel-id))
(cl-letf
(((symbol-function 'ebox--flex-item-slot-footprint-safe-p)
(lambda (&rest arguments)
(cl-incf planner-render-count)
(apply original-planner-render arguments)))
((symbol-function 'ebox-surface--render-candidate-node)
(lambda (&rest arguments)
(cl-incf surface-render-count)
(apply original-surface-render arguments))))
(dolist (contents '(("[ ] row 1" "[x] row 2")
("[x] row 1" "[ ] row 2")))
(let* ((report
(ebox-commit
buffer
(ebox-commit-test--fixed-basis-selection-candidate
buffer (car contents) (cadr contents))))
(surface
(with-current-buffer buffer ebox-surface--buffer-surface))
(tp-report (tp-surface-report surface))
(object-count
(plist-get (tp-surface-inspect surface) :object-count))
(snapshots
(plist-get (ebox--buffer-render-state buffer)
:layout-snapshots))
(panel-snapshot
(and snapshots (gethash panel-id snapshots))))
(push report reports)
(should (memq (plist-get report :projection-kind)
'(span-patch owner-scoped)))
(should-not (member root-id (plist-get report :owner-ids)))
(should-not (plist-get report :tp-full-root))
(should-not (plist-get report :tp-scope-fallback))
(should (< (plist-get tp-report :reconciled-objects)
object-count))
(should (<= (plist-get tp-report :reconciled-objects) 4))
;; Successful publication leaves the fixed-basis owner ready
;; to recapture geometry from the committed TP mounts.
(should panel-snapshot)
(should-not (plist-member panel-snapshot :buffer-spans))
(with-current-buffer buffer
(should
(equal
(buffer-substring-no-properties (point-min) (point-max))
(substring-no-properties
(let ((state (ebox--buffer-render-state buffer)))
(ebox--render-node
(plist-get state :root-node)
(plist-get state :source-index))))))))))
(should (= (length reports) 2))
(should (zerop planner-render-count))
(should (= surface-render-count 2)))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(defun ebox-commit-test--mixed-owner-candidate
(buffer left right paint-a paint-b paint-c)
"Return BUFFER candidate replacing all mixed fixture owners."
(let ((candidate (ebox-candidate-begin buffer)))
(ebox-candidate-replace-host-ref
candidate 'left
(ebox-test-box :key 'left :source-identity 'left
(ebox-test-text left) :font-weight 'bold))
(ebox-candidate-replace-host-ref
candidate 'right
(ebox-test-box :key 'right :source-identity 'right
(ebox-test-text right)))
(ebox-candidate-replace-host-ref
candidate 'paint-a
(ebox-test-box :key 'paint-a :source-identity 'paint-a
(ebox-test-text "paint-a") :color paint-a))
(ebox-candidate-replace-host-ref
candidate 'paint-b
(ebox-test-box :key 'paint-b :source-identity 'paint-b
(ebox-test-text "paint-b") :bgcolor paint-b))
(ebox-candidate-replace-host-ref
candidate 'paint-c
(ebox-test-box :key 'paint-c :source-identity 'paint-c
(ebox-test-text "paint-c") :color paint-c))
candidate))
(defun ebox-commit-test--mixed-formatting-ownership (scenario &optional inherited-p)
"Check public ownership for specialized or declined formatting SCENARIO.
When INHERITED-P is non-nil, keep ancestor color across an untouched sibling."
(cl-labels
((fixture (left right paint-a paint-b paint-c)
(let ((tree (ebox-commit-test--mixed-owner-root
left right paint-a paint-b paint-c)))
(if inherited-p
(ebox-test-box :key 'inherited-parent :color "#345678" tree)
tree)))
(nodes (state)
(let (result)
(cl-labels ((walk (node path)
(push (cons path node) result)
(cl-loop for child in (ebox-tree-node-children node)
for index from 0
do (walk child (append path (list index))))))
(walk (plist-get state :root-node) '(root)))
(nreverse result)))
(region-paths (state)
(let ((paths (make-hash-table :test #'eql))
(regions (make-hash-table :test #'eql)))
(dolist (entry (nodes state))
(puthash (plist-get (cdr entry) :node-id) (car entry) paths))
(ebox-runtime-index-map (lambda (region node-id)
(puthash region (gethash node-id paths) regions))
(plist-get state :region-node-table))
regions))
(region-path (regions id)
(or (gethash id regions)
(ert-fail (list :unknown-region id))))
(source-ancestry (state)
(let* ((index (plist-get state :source-index))
(subjects (ebox-source--index-node-subjects index)))
(mapcar
(lambda (entry)
(let ((subject
(ebox-source--subject-table-get
subjects (ebox-tree-node-source-handle (cdr entry)))))
(list subject (ecss-subject-parent subject)
(copy-sequence (ecss-subject-children subject)))))
(nodes state))))
(same-source-ancestry-p (before after)
(and (= (length before) (length after))
(cl-every
(lambda (old new)
(and (eq (car old) (car new))
(eq (cadr old) (cadr new))
(= (length (nth 2 old)) (length (nth 2 new)))
(cl-every #'eq (nth 2 old) (nth 2 new))))
before after)))
(contents (buffer)
;; Preserve every property, renaming only buffer-local region ids.
(let* ((text (ebox-commit-test--buffer-string buffer))
(regions (region-paths (ebox--buffer-render-state buffer)))
(properties
(delete-dups
(append (mapcar #'cdr ebox-region-types)
'(ebox-scroll-window
ebox-overflow-foreground-source))))
(position 0))
(while (< position (length text))
(let ((end (or (next-property-change position text) (length text)))
(props (text-properties-at position text)))
(dolist (property properties)
(when-let* ((id (plist-get props property)))
(setq props
(plist-put props property (region-path regions id)))))
(when-let* ((owners (plist-get props 'ebox-content-owners)))
(setq props
(plist-put props 'ebox-content-owners
(mapcar (lambda (id) (region-path regions id))
owners))))
(set-text-properties position end props text)
(setq position end)))
text))
(mounts (state node)
(let ((regions (region-paths state))
(object (gethash (plist-get node :node-id)
(plist-get state :surface-node-object-table))))
;; TP does not require a particular ordering of an owner's mounts.
(sort
(mapcar
(lambda (mount)
(let ((tags (plist-get mount :tags)))
(when-let* ((region (plist-get tags :ebox/region-id)))
(plist-put tags :ebox/region-id (region-path regions region)))
mount))
(tp-object-mounts object))
(lambda (a b)
(string< (prin1-to-string a) (prin1-to-string b)))))))
(let* ((buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-mixed-formatting-fallback*")
(fixture
"left-old" "right-old" "#111111" "#222222" "#333333")))
(fresh nil)
(left "left changed\nleft again")
(right "right changed\nright again")
(before (ebox--buffer-render-state buffer))
(surface (with-current-buffer buffer ebox-surface--buffer-surface))
(revision (tp-surface-revision surface))
(runtime-revision (plist-get before :runtime-revision))
(old-objects (plist-get before :surface-node-object-table))
(old-object-facts
(let (facts)
(maphash (lambda (id object)
(push (list id object (tp-object-mounts object)) facts))
old-objects)
facts))
(old-text (ebox-commit-test--buffer-string buffer))
(old-report (tp-surface-report surface))
(old-mounts (tp--surface-mounts surface))
(old-mount-ids (mapcar #'tp--surface-mount-id old-mounts))
(old-mount-index (tp--surface-mount-index surface))
(old-index (tp--surface-index surface))
(old-ranges (plist-get before :surface-owned-ranges))
(old-range-facts (ebox-surface--snapshot-owned-ranges old-ranges))
(old-fragments (plist-get before :surface-fragments))
(old-fragment-facts (copy-tree old-fragments))
(old-source-index (plist-get before :source-index))
(old-source-ancestry (and inherited-p (source-ancestry before)))
(root-render (symbol-function 'ebox-surface--render-candidate))
(formatting-output
(symbol-function 'ebox-surface--formatting-context-reflow-output))
(mixed-output (symbol-function 'ebox-surface--mixed-owner-output))
(formatting-calls 0)
(mixed-calls 0)
(publication-failures 0)
(root-renders 0)
geometry-owner-id
report)
(unwind-protect
(progn
;; Only the specialized output boundary declines. The real
;; public candidate, planner, mixed projector, and full renderer
;; run normally; no candidate facts or reports are fabricated.
(cl-letf
(((symbol-function
'ebox-surface--formatting-context-reflow-output)
(lambda (target state)
(cl-incf formatting-calls)
(should (eq (plist-get state :projection-kind)
'mixed-owner-reflow))
(let ((proof (plist-get state :mixed-owner-proof)))
(should (eq (plist-get proof :geometry-kind)
'formatting-context-reflow))
(setq geometry-owner-id
(plist-get (plist-get proof :geometry-proof)
:owner-id)))
(when inherited-p
(let* ((index (plist-get state :source-index))
(subjects (ebox-source--index-node-subjects index))
(peer (ebox--host-ref-node buffer 'untouched))
(subject
(ebox-source--subject-table-get
subjects (ebox-tree-node-source-handle peer)))
(parent-id
(ebox-runtime-index-get (plist-get peer :node-id)
(plist-get state :parent-table)))
(parent
(ebox-runtime-index-get parent-id (plist-get state :node-table)))
(parent-subject
(ebox-source--subject-table-get
subjects (ebox-tree-node-source-handle parent))))
(message "Inherited fallback candidate: derived-stale=%S untouched-parent-coherent=%S"
(ebox-source--index-derived-stale-p index)
(eq parent-subject (ecss-subject-parent subject)))))
(unless (memq scenario '(decline rollback))
(let ((output (funcall formatting-output target state)))
(should (stringp output))
output))))
((symbol-function 'ebox-surface--mixed-owner-output)
(lambda (target previous state)
(cl-incf mixed-calls)
(let ((output (funcall mixed-output target previous state)))
(if (eq scenario 'late-decline)
(progn
;; Decline only after the actual projector has
;; produced all three kinds of temporary state.
(should (stringp output))
(should (plist-get state :content-coordinate-patches))
(should (plist-get state :mixed-owner-fragment-data))
(should (plist-get state :paint-property-contributions))
nil)
output))))
((symbol-function 'ebox-surface--render-candidate)
(lambda (state)
(cl-incf root-renders)
(funcall root-render state))))
(when (eq scenario 'rollback)
(let ((tp--surface-publication-step-function
(lambda (step target)
(when (eq step 'client-state)
(should (eq target surface))
(cl-incf publication-failures)
(should (= root-renders 1))
(should (= (tp-surface-revision surface)
(1+ revision)))
(should-not (eq before (tp-surface-client-state surface)))
(should-not
(equal-including-properties
old-text (ebox-commit-test--buffer-string buffer)))
(error "Reject formatting fallback publication")))))
(should
(equal
(should-error
(ebox-commit
buffer
(ebox-commit-test--mixed-owner-candidate
buffer left right "#AAAAAA" "#BBBBBB" "#CCCCCC")))
'(error "Reject formatting fallback publication"))))
(should (= publication-failures 1))
(should (eq before (ebox--buffer-render-state buffer)))
(should (eq before (tp-surface-client-state surface)))
(should (= revision (tp-surface-revision surface)))
(should (= runtime-revision
(plist-get before :runtime-revision)))
(should (equal old-report (tp-surface-report surface)))
(should (equal-including-properties
old-text (ebox-commit-test--buffer-string buffer)))
(should (eq old-mounts (tp--surface-mounts surface)))
(should (eq old-mount-index (tp--surface-mount-index surface)))
(should (eq old-index (tp--surface-index surface)))
(should (equal old-mount-ids
(mapcar #'tp--surface-mount-id old-mounts)))
(should (eq old-objects
(plist-get before :surface-node-object-table)))
(should (= (length old-object-facts) (hash-table-count old-objects)))
(dolist (fact old-object-facts)
(should (eq (nth 1 fact) (gethash (car fact) old-objects)))
(should (equal (nth 2 fact)
(tp-object-mounts (nth 1 fact)))))
(should (eq old-ranges (plist-get before :surface-owned-ranges)))
(should (equal old-range-facts
(ebox-surface--snapshot-owned-ranges old-ranges)))
(should (eq old-fragments (plist-get before :surface-fragments)))
(should (equal-including-properties
old-fragment-facts old-fragments))
(when inherited-p
(should (eq old-source-index (plist-get before :source-index)))
(should (same-source-ancestry-p
old-source-ancestry (source-ancestry before)))))
;; Retry builds a new public candidate from the restored state.
(setq report
(ebox-commit
buffer
(ebox-commit-test--mixed-owner-candidate
buffer left right "#AAAAAA" "#BBBBBB" "#CCCCCC"))))
(should (= formatting-calls (if (eq scenario 'rollback) 2 1)))
(should (= mixed-calls formatting-calls))
(should (= root-renders
(if (eq scenario 'specialized) 0 formatting-calls)))
(should geometry-owner-id)
(message "Formatting ownership scenario=%S specialized-calls=%d root-renders=%d publication-failures=%d"
scenario formatting-calls root-renders publication-failures)
(when (eq scenario 'specialized)
(should (eq (plist-get report :projection-kind) 'mixed-owner-reflow))
(should-not (plist-get report :tp-full-root))
(should-not (plist-get report :tp-scope-fallback)))
(should (= (tp-surface-revision surface) (1+ revision)))
(should (zerop (plist-get report :created-objects)))
(should (zerop (plist-get report :removed-objects)))
(let* ((after (ebox--buffer-render-state buffer))
(objects (plist-get after :surface-node-object-table)))
(should (= (plist-get after :runtime-revision)
(1+ runtime-revision)))
(should (= (length old-object-facts) (hash-table-count old-objects)))
(should (= (hash-table-count old-objects)
(hash-table-count objects)))
(dolist (fact old-object-facts)
(should (eq (nth 1 fact) (gethash (car fact) old-objects)))
(should (eq (nth 1 fact) (gethash (car fact) objects))))
(when (eq scenario 'specialized)
(let ((owner-mounts
(tp-object-mounts (gethash geometry-owner-id objects))))
(should (= (length owner-mounts) 1))
(should (equal (plist-get (plist-get (car owner-mounts) :tags)
:ebox/roles)
'(content-owner content)))))
(setq fresh
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-mixed-formatting-full*")
(fixture
left right "#AAAAAA" "#BBBBBB" "#CCCCCC")))
(when inherited-p
(should (eq old-source-index (plist-get before :source-index)))
(should (same-source-ancestry-p
old-source-ancestry (source-ancestry before)))
(let ((actual-style
(plist-get (ebox--host-ref-node buffer 'untouched)
:ebox-computed-style))
(expected-style
(plist-get (ebox--host-ref-node fresh 'untouched)
:ebox-computed-style)))
(message "Untouched inherited color: actual=%S expected=%S"
(ecss-computed-style-value actual-style :color)
(ecss-computed-style-value expected-style :color))))
(should (equal-including-properties
(contents buffer) (contents fresh)))
(when inherited-p
(let ((actual-style
(plist-get (ebox--host-ref-node buffer 'untouched)
:ebox-computed-style))
(expected-style
(plist-get (ebox--host-ref-node fresh 'untouched)
:ebox-computed-style)))
(should (equal "#345678"
(ecss-computed-style-value expected-style :color)))
(should (equal (ecss-computed-style-values actual-style)
(ecss-computed-style-values expected-style)))))
(let* ((expected (ebox--buffer-render-state fresh))
(actual-nodes (nodes after))
(expected-nodes (nodes expected)))
(should (equal (mapcar #'car actual-nodes)
(mapcar #'car expected-nodes)))
(cl-mapc
(lambda (actual wanted)
(ert-info ((format "public owner mounts at %S" (car actual)))
(let ((actual-mounts (mounts after (cdr actual)))
(expected-mounts (mounts expected (cdr wanted))))
(when (eq scenario 'specialized)
;; Local context ownership deliberately has explicit
;; content-role tags; full output uses descendant tags.
;; Both must publish the same complete coordinates.
(setq actual-mounts
(mapcar (lambda (mount)
(list (plist-get mount :start)
(plist-get mount :end)))
actual-mounts)
expected-mounts
(mapcar (lambda (mount)
(list (plist-get mount :start)
(plist-get mount :end)))
expected-mounts)))
(should (equal actual-mounts expected-mounts)))))
actual-nodes expected-nodes))))
(when (buffer-live-p buffer) (kill-buffer buffer))
(when (buffer-live-p fresh) (kill-buffer fresh))))))
(ert-deftest ebox-commit-mixed-formatting-specialized-preserves-owner-coverage ()
"Successful formatting specialization stays local and owns its full output."
(ebox-commit-test--mixed-formatting-ownership 'specialized))
(ert-deftest ebox-commit-mixed-formatting-fallback-preserves-full-ownership ()
"A declined mixed formatting output must publish full-render ownership."
(ebox-commit-test--mixed-formatting-ownership 'decline))
(ert-deftest ebox-commit-mixed-formatting-fallback-rolls-back-and-retries ()
"Fallback publication failure restores exact ownership before a fresh retry."
(ebox-commit-test--mixed-formatting-ownership 'rollback))
(ert-deftest ebox-commit-mixed-formatting-late-fallback-preserves-full-ownership ()
"A late decline cannot reuse the successful projector's temporary results."
(ebox-commit-test--mixed-formatting-ownership 'late-decline))
(ert-deftest ebox-commit-mixed-formatting-fallback-preserves-untouched-inheritance ()
"Full fallback preserves inherited color through copied ancestor subjects."
(ebox-commit-test--mixed-formatting-ownership 'decline t))
(ert-deftest ebox-commit-mixed-formatting-inheritance-rolls-back-and-retries ()
"Inherited fallback preserves the old source ancestry on rollback and retry."
(ebox-commit-test--mixed-formatting-ownership 'rollback t))
(ert-deftest ebox-surface-owned-range-index-rebases-exact-boundaries ()
"Rebase retained ownership exactly and reject ambiguous inner boundaries."
(let* ((patches '((:old-start 5 :old-end 10
:new-start 5 :new-end 12)))
(ranges '((:object before :start 0 :end 5 :tags (:before t))
(:object changed :start 5 :end 10 :tags (:changed t))
(:object parent :start 0 :end 20 :tags (:parent t))
(:object after :start 10 :end 20 :tags (:after t))))
(rebased (cdr (ebox-surface--rebase-owned-ranges
ranges patches 22))))
(should
(equal (mapcar (lambda (range)
(list (plist-get range :object)
(plist-get range :start)
(plist-get range :end)))
rebased)
'((before 0 5) (changed 5 12) (parent 0 22) (after 12 22))))
(should-not
(ebox-surface--rebase-owned-ranges
'((:object ambiguous :start 6 :end 9)) patches 22))))
(ert-deftest ebox-commit-structure-skips-inapplicable-paint-span-proofs ()
"A structural transaction must not run proofs whose domain excludes it."
(let* ((buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-structure-proof-domain* ")
(ebox-test-column
(ebox-test-box
:key 'target :source-identity 'target
(ebox-test-column (ebox-test-box :key 'first (ebox-test-text "first")))))))
(span-calls 0)
(mixed-calls 0)
(old-span
(symbol-function 'ebox-incremental--span-patch-projection-proof))
(old-mixed
(symbol-function 'ebox-incremental--mixed-owner-proof)))
(unwind-protect
(let ((candidate (ebox-candidate-begin buffer)))
(ebox-candidate-replace-host-ref
candidate 'target
(ebox-test-box
:key 'target :source-identity 'target
(ebox-test-column (ebox-test-box :key 'first (ebox-test-text "first"))
(ebox-test-box :key 'second (ebox-test-text "second")))))
(cl-letf
(((symbol-function 'ebox-incremental--span-patch-projection-proof)
(lambda (&rest arguments)
(cl-incf span-calls)
(apply old-span arguments)))
((symbol-function 'ebox-incremental--mixed-owner-proof)
(lambda (&rest arguments)
(cl-incf mixed-calls)
(apply old-mixed arguments))))
(ebox-commit buffer candidate))
(should (zerop span-calls))
(should (zerop mixed-calls))
(should (string-match-p "second"
(ebox-commit-test--buffer-string buffer))))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-candidate-range-structure-stops-at-range-parent ()
"A Range child identity change must not mark copied ancestors structural."
(let* ((buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-range-dirty-boundary* ")
(ebox-test-column
(ebox-test-child-range
'rows (ebox-test-box :key 'old (ebox-test-text "old"))))))
(state (ebox--buffer-render-state buffer))
(parent-id
(plist-get (gethash 'rows (plist-get state :range-ref-table))
:parent-node-id))
captured)
(unwind-protect
(let ((candidate (ebox-candidate-begin buffer))
(next-input (ebox-test-box :key 'new (ebox-test-text "new")))
(original
(symbol-function 'ebox-incremental--surface-commit-input)))
(ebox-candidate-replace-range-ref
candidate 'rows next-input)
(cl-letf
(((symbol-function 'ebox-incremental--surface-commit-input)
(lambda (target old-state prepared)
(setq captured (copy-tree (plist-get prepared :dirty-set)))
(funcall original target old-state prepared))))
(ebox-commit buffer candidate))
(should
(equal
(mapcar (lambda (entry)
(list (plist-get entry :node-id)
(plist-get entry :dirty-kind)
(plist-get entry :changed-keys)))
captured)
(list (list parent-id 'structure '(:children)))))
(should (string-match-p "new"
(ebox-commit-test--buffer-string buffer))))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-commit-range-splice-paint-preserves-kept-identities-and-faces ()
"Range object replacement falls back with current paint and kept peers."
(with-temp-buffer
(ebox-render-to-buffer
(current-buffer)
(ebox-test-column :width '(120)
(ebox-test-box :key 'keep :source-identity 'keep :height 1
(ebox-test-text "keep"))
(ebox-test-box :width '(80) :height 1
(ebox-test-column :key 'rows :source-identity 'rows
(ebox-test-child-range
'items
(ebox-test-box :key 'old :source-identity 'old :height 1
(ebox-test-text "old")))))
(ebox-test-box :key 'paint :source-identity 'paint :color "#123456"
(ebox-test-text "paint"))))
(let* ((state (ebox--buffer-render-state (current-buffer)))
(keep-id (plist-get (ebox--host-ref-node (current-buffer) 'keep) :node-id))
(old-id (plist-get (ebox--host-ref-node (current-buffer) 'old) :node-id))
(paint-id (plist-get (ebox--host-ref-node (current-buffer) 'paint) :node-id))
(objects (plist-get state :surface-node-object-table))
(keep-object (gethash keep-id objects))
(paint-object (gethash paint-id objects))
(candidate (ebox-candidate-begin (current-buffer)))
(root-render (symbol-function 'ebox-surface--render-candidate))
(root-renders 0)
report)
(ebox-candidate-replace-range-ref
candidate 'items
(ebox-test-box :key 'new :source-identity 'new :height 1
(ebox-test-text "new")))
(ebox-candidate-replace-host-ref
candidate 'paint
(ebox-test-box :key 'paint :source-identity 'paint :color "#0000FF"
(ebox-test-text "paint")))
(cl-letf (((symbol-function 'ebox-surface--render-candidate)
(lambda (candidate-state)
(cl-incf root-renders)
(should (ebox-surface--mixed-range-splice-p candidate-state))
(funcall root-render candidate-state))))
(setq report (ebox-commit (current-buffer) candidate)))
(should (eq (plist-get report :strategy) 'mixed-owner-reflow))
(should-not (plist-get report :projection-kind))
(should (= 1 root-renders))
(should-not (plist-get report :tp-retained-content))
(should (> (plist-get report :created-objects) 0))
(should (> (plist-get report :removed-objects) 0))
(should-not (ebox--host-ref-node (current-buffer) 'old))
(should-not (= old-id (plist-get (ebox--host-ref-node (current-buffer) 'new)
:node-id)))
(ebox-commit-test--assert-scroll-family-output "keep" "new" "#0000FF")
(dolist (color '("#0000FF" "#00FF00"))
(when (equal color "#00FF00")
(let ((paint-report
(ebox-commit
(current-buffer)
(ebox-commit-test--scroll-family-candidate (current-buffer) color))))
(should (eq (plist-get paint-report :projection-kind) 'paint))))
(ebox-commit-test--assert-scroll-family-output "keep" "new" color)
(let* ((next (ebox--buffer-render-state (current-buffer)))
(next-objects (plist-get next :surface-node-object-table))
(contents (buffer-string))
(start (string-match "paint" contents)))
(should (= keep-id (plist-get (ebox--host-ref-node (current-buffer) 'keep)
:node-id)))
(should (= paint-id (plist-get (ebox--host-ref-node (current-buffer) 'paint)
:node-id)))
(should (eq keep-object (gethash keep-id next-objects)))
(should (eq paint-object (gethash paint-id next-objects)))
(dotimes (offset (length "paint"))
(should (equal (get-text-property (+ start offset) 'face contents)
(list :foreground color)))))))))
(defun ebox-commit-test--allocation-closure-root
(toast paint-a paint-b &optional width footer-overflow root-overflow)
"Return a generic whole-line Flex allocation-closure fixture."
(let* ((footer
(apply
#'ebox-test-flex
(append
(list :key 'footer :width (list (or width 800))
:flex-wrap 'wrap :gap '(1 (4)))
(when footer-overflow (list :overflow footer-overflow))
(list
(ebox-test-box
:key 'toast-slot :width 'stretch :min-width 0
:flex-grow 1 :flex-shrink 1 :flex-basis '(0)
(ebox-test-column
(ebox-test-box :key 'toast :source-identity 'toast
(ebox-test-text toast))))
(ebox-test-box :key 'peer
(ebox-test-text "database.sqlite"))))))
(content
(ebox-test-column
(ebox-test-box :key 'status :source-identity 'status
(ebox-test-text "Theme: Light") :width '(200))
(ebox-test-box :key 'paint-a :source-identity 'paint-a
(ebox-test-text "paint-a") :color paint-a)
(ebox-test-box :key 'paint-b :source-identity 'paint-b
(ebox-test-text "paint-b") :bgcolor paint-b)
(ebox-test-box
:key 'footer-owner :width (list (or width 800))
(ebox-test-column footer)))))
(apply
#'ebox-test-box
(append
(list :key 'root :width (list (or width 800)))
(when root-overflow (list :height 1 :overflow root-overflow))
(list content)))))
(defun ebox-commit-test--allocation-closure-candidate
(buffer toast paint-a paint-b)
"Return BUFFER candidate changing one Flex content and two paints."
(let ((candidate (ebox-candidate-begin buffer)))
(ebox-candidate-replace-host-ref
candidate 'toast
(ebox-test-box :key 'toast :source-identity 'toast (ebox-test-text toast)))
(ebox-candidate-replace-host-ref
candidate 'paint-a
(ebox-test-box :key 'paint-a :source-identity 'paint-a
(ebox-test-text "paint-a") :color paint-a))
(ebox-candidate-replace-host-ref
candidate 'paint-b
(ebox-test-box :key 'paint-b :source-identity 'paint-b
(ebox-test-text "paint-b") :bgcolor paint-b))
candidate))
(defun ebox-commit-test--two-geometry-allocation-candidate
(buffer status toast paint-a paint-b)
"Return BUFFER candidate with one span and one allocation geometry owner."
(let ((candidate
(ebox-commit-test--allocation-closure-candidate
buffer toast paint-a paint-b)))
(ebox-candidate-replace-host-ref
candidate 'status
(ebox-test-box :key 'status :source-identity 'status
(ebox-test-text status) :width '(200)))
candidate))
(ert-deftest ebox-allocation-closure-allows-recomposable-ancestor-paint ()
"Allow ancestor paint but reject paint at/below an allocation owner."
(let ((parents (make-hash-table :test #'eql)))
;; 1(root) -> 2(paint ancestor) -> 3(geometry) -> 4(paint descendant)
(puthash 2 1 parents)
(puthash 3 2 parents)
(puthash 4 3 parents)
(let ((state (list :parent-table parents)))
(should
(ebox-incremental--allocation-closure-paint-disjoint-p
state '(3) '(2)))
(should-not
(ebox-incremental--allocation-closure-paint-disjoint-p
state '(3) '(3)))
(should-not
(ebox-incremental--allocation-closure-paint-disjoint-p
state '(3) '(4))))))
(ert-deftest ebox-commit-allocation-closure-proof-misses-fallback ()
"Topology, selector, cascade, and role misses reject allocation closure."
(dolist (kind '(topology selector cascade))
(ebox-style-reset-rules)
(when (eq kind 'selector)
(ebox-style-add-rule "box:has(.changed)" '(:color "#EF4444")))
(let ((buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-allocation-proof-miss* ")
(ebox-commit-test--allocation-closure-root
"Light" "#111111" "#222222"))))
(unwind-protect
(let ((candidate (ebox-candidate-begin buffer)))
(ebox-candidate-replace-host-ref
candidate 'toast
(if (eq kind 'topology)
(ebox-test-box
:key 'toast :source-identity 'toast
(ebox-test-column
(ebox-test-box :key 'nested-toast
(ebox-test-text "A longer notification"))))
(ebox-test-box :key 'toast :source-identity 'toast
:class (and (eq kind 'selector) "changed")
(ebox-test-text "A longer notification"))))
(ebox-candidate-replace-host-ref
candidate 'paint-a
(ebox-test-box :key 'paint-a :source-identity 'paint-a
(ebox-test-text "paint-a") :color "#AAAAAA"))
(let ((report
(if (eq kind 'cascade)
(cl-letf
(((symbol-function 'ebox-style-cascade-active-p)
(lambda () t))
((symbol-function
'ebox-surface--cascade-local-owner-proof-p)
(lambda (&rest _) nil)))
(ebox-commit buffer candidate))
(ebox-commit buffer candidate))))
(ert-info ((format "proof miss kind: %S" kind))
(should-not (eq (plist-get report :projection-kind)
'mixed-owner-reflow)))))
(when (buffer-live-p buffer) (kill-buffer buffer))
(ebox-style-reset-rules))))
(let* ((buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-allocation-role-miss* ")
(ebox-commit-test--allocation-closure-root
"Light" "#111111" "#222222")))
(original-output
(symbol-function 'ebox-surface--mixed-owner-output))
mixed-output)
(unwind-protect
(progn
(ebox--refresh-buffer-layout-snapshots buffer t)
(cl-letf
(((symbol-function
'ebox-surface--rendered-role-topology-signature)
(lambda (&rest _) '(:roles (mismatched))))
((symbol-function 'ebox-surface--mixed-owner-output)
(lambda (&rest arguments)
(setq mixed-output (apply original-output arguments)))))
(ebox-commit
buffer
(ebox-commit-test--allocation-closure-candidate
buffer "A longer notification" "#AAAAAA" "#BBBBBB"))
(should-not mixed-output)))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-native-inherited-dirty-domain-is-schema-owned ()
"Native invalidation derives inherited propagation from the style schema."
(should
(equal '(7)
(ebox-native-commit-inherited-dirty-node-ids
'(:dirty-set
((:node-id 7 :dirty-kind paint :changed-keys (:color)))))))
(should-not
(ebox-native-commit-inherited-dirty-node-ids
'(:dirty-set
((:node-id 7 :dirty-kind paint
:changed-keys (:background-color)))))))
(ert-deftest ebox-native-retained-compiler-refreshes-inherited-descendants ()
"An inherited parent paint change cannot reuse a stale child fragment."
(require 'ebox-native-reflow)
(let* ((input
(ebox-test-box
:color "#111111"
(ebox-test-text "Paint" :color "#111111")))
(root (ebox-test-root input))
(_ids (ebox--runtime-node-ids root))
(source-index (ebox-test-source-index input))
(session
(ebox-native-reflow--make-session
:handle 'test :generation 0 :styles nil :layout-package nil
:layout-fragment-cache (make-hash-table :test 'equal)
:layout-fragment-revision 0))
(initial-state
(list :native-node-postorder
(ebox-native-reflow--retained-layout-postorder root)
:native-topology-stable-p nil
:source-index source-index))
(initial-package
(ebox-native-reflow--compile-retained-layout-package
session initial-state root))
(next (copy-tree root))
(next-child (car (ebox-tree-node-children next))))
(let ((bootstrap-root
(plist-get (plist-get initial-package :document) :root)))
(should (= (plist-get root :node-id)
(plist-get bootstrap-root :node-id)))
(should (integerp (plist-get bootstrap-root :node-revision)))
;; The Text is fused into its owner and therefore has no addressable
;; child entry in the full wire document.
(should (eq :null (plist-get bootstrap-root :child))))
(setf (ebox-native-reflow-session-styles session)
(plist-get initial-package :styles)
(ebox-native-reflow-session-layout-package session)
initial-package)
;; Model a candidate computed-style projection: the child source record is
;; unchanged, while its inherited runtime color follows the parent.
(plist-put next :color "#222222")
(plist-put next-child :color "#222222")
(let* ((root-id (plist-get next :node-id))
(next-state
(list :native-node-postorder
(ebox-native-reflow--retained-layout-postorder next)
:native-topology-stable-p t
:native-touched-node-ids (list root-id)
:native-inherited-dirty-node-ids (list root-id)
:source-index source-index))
(package
(ebox-native-reflow--compile-retained-layout-package
session next-state next))
(document-root (plist-get (plist-get package :document) :root))
(style-id (plist-get document-root :content-foreground-style))
(styles (plist-get package :styles)))
(should (integerp style-id))
(should
(equal '(:foreground "#222222")
(plist-get (aref styles style-id) :face))))))
(ert-deftest ebox-native-retained-package-reuse-requires-exact-ir-identity ()
"Only an identity-preserving compile may reuse the confirmed package."
(let* ((root (list :type "row" :children []))
(style (list :mode 'face :face '(:foreground "red")))
(template (list :mouse-face 'highlight))
(old
(list :document
(list :version 2 :space-width 8 :style-count 1
:property-template-count 1
:styles (vector style) :root root)
:document-revision 7
:styles (vector style)
:property-templates (vector template)))
(same
(list :document
(list :version 2 :space-width 8 :style-count 1
:property-template-count 1
:styles (vector style) :root root)
:styles (vector style)
:property-templates (vector template))))
(should (eq old
(ebox-native-reflow--reuse-exact-layout-package old same)))
(dolist (candidate
(list
(copy-tree same)
(let ((copy (copy-tree same)))
(plist-put (plist-get copy :document) :space-width 9)
copy)
(let ((copy (copy-tree same)))
(plist-put (plist-get copy :document) :root (copy-tree root))
copy)
(let ((copy (copy-tree same)))
(plist-put copy :styles
(vector (copy-tree style)))
copy)
(let ((copy (copy-tree same)))
(plist-put copy :property-templates
(vector (copy-tree template)))
copy)))
;; COPY-TREE deliberately destroys the required root/style/template
;; object identity even when values remain equal.
(should-not
(eq old (ebox-native-reflow--reuse-exact-layout-package old candidate))))))
(ert-deftest ebox-native-retained-sync-omits-an-exactly-reused-document ()
"A retained frame sends only revisions and context for unchanged IR."
(let* ((document (list :version 2 :space-width 8 :style-count 0
:property-template-count 0 :styles []
:root (list :type "row" :children [])))
(package (list :document document :document-revision 4
:styles [] :property-templates []))
(session
(ebox-native-reflow--make-session
:handle 'test :generation 3 :styles [] :layout-package package
:layout-fragment-cache (make-hash-table :test 'equal)
:layout-fragment-revision 0))
control)
(cl-letf (((symbol-function
'ebox-native-reflow--compile-retained-layout-package)
(lambda (&rest _) package))
((symbol-function 'ebox-native--module-render-session-frame)
(lambda (_handle _generation payload)
(setq control
(json-parse-string payload :object-type 'plist
:array-type 'array))
'native-frame))
((symbol-function 'ebox-native-reflow--materialize-module-frame)
(lambda (&rest _) '(:rendered "ok"))))
(should
(equal
'(:rendered "ok")
(ebox-native-reflow-execute-session-sync
session 'node
'(:key 1 :viewport-width 80 :viewport-height 10
:runtime-revision 9)
nil 'state)))
(should-not (plist-member control :document))
(should (= (plist-get control :document-base-revision) 4))
(should (= (plist-get control :document-target-revision) 4)))))
(ert-deftest ebox-native-session-input-normalizes-every-replacement-revision ()
"Compiled and explicit replacement packages both advance at the boundary."
(let* ((styles [])
(templates [])
(old
(list :document
(list :version 2 :space-width 8 :style-count 0
:property-template-count 0 :styles []
:root (list :type "row" :children []))
:document-revision 4
:styles styles :property-templates templates))
(compiled
(list :document
(list :version 2 :space-width 8 :style-count 0
:property-template-count 0 :styles []
:root (list :type "column" :children []))
:document-revision 1
:styles styles :property-templates templates))
(explicit
(list :document
(list :version 2 :space-width 8 :style-count 0
:property-template-count 0 :styles []
:root (list :type "box"))
:document-revision 1
:styles styles :property-templates templates))
(session
(ebox-native-reflow--make-session
:handle 'test :generation 0 :styles styles :layout-package old
:layout-fragment-cache (make-hash-table :test 'equal)
:layout-fragment-revision 0))
(other-old (copy-tree old))
(other-session
(progn
(plist-put other-old :document-revision 10)
(ebox-native-reflow--make-session
:handle 'other :generation 0 :styles styles
:layout-package other-old
:layout-fragment-cache (make-hash-table :test 'equal)
:layout-fragment-revision 0)))
controls)
(cl-letf (((symbol-function 'ebox-native-reflow--compile-layout-package)
(lambda (&rest _) compiled))
((symbol-function 'ebox-native--module-render-session-frame)
(lambda (_handle _generation payload)
(push (json-parse-string payload :object-type 'plist
:array-type 'array)
controls)
'native-frame))
((symbol-function 'ebox-native-reflow--materialize-module-frame)
(lambda (&rest _) '(:rendered "ok"))))
(ebox-native-reflow-execute-session-sync
session 'node
'(:key 1 :viewport-width 80 :viewport-height 10
:runtime-revision 9))
(should (= (plist-get (ebox-native-reflow-session-layout-package session)
:document-revision)
5))
(ebox-native-reflow-execute-session-sync
session 'node
'(:key 1 :viewport-width 90 :viewport-height 10
:runtime-revision 10)
explicit)
(setq controls (nreverse controls))
(should (plist-member (car controls) :document))
(should (= (plist-get (car controls) :document-base-revision) 4))
(should (= (plist-get (car controls) :document-target-revision) 5))
(should (plist-member (cadr controls) :document))
(should (= (plist-get (cadr controls) :document-base-revision) 5))
(should (= (plist-get (cadr controls) :document-target-revision) 6))
(should (= (plist-get (ebox-native-reflow-session-layout-package session)
:document-revision)
6))
(ebox-native-reflow-execute-session-sync
other-session 'node
'(:key 1 :viewport-width 100 :viewport-height 10
:runtime-revision 20)
explicit)
(should (= (plist-get explicit :document-revision) 1))
(should (= (plist-get (ebox-native-reflow-session-layout-package session)
:document-revision)
6))
(should (= (plist-get
(ebox-native-reflow-session-layout-package other-session)
:document-revision)
11))
(should (= (plist-get (car controls) :document-base-revision) 10))
(should (= (plist-get (car controls) :document-target-revision) 11)))))
(ert-deftest ebox-native-persistent-index-path-copies-without-changing-base ()
"A retained index update shares the base and leaves its values immutable."
(require 'ebox-native-reflow)
(let* ((base (ebox-native-reflow--persistent-index-put nil 1 'one))
(next (ebox-native-reflow--persistent-index-put base 17 'seventeen)))
(should (eq 'one (ebox-native-reflow--persistent-index-get base 1)))
(should-not (ebox-native-reflow--persistent-index-get base 17))
(should (eq 'one (ebox-native-reflow--persistent-index-get next 1)))
(should (eq 'seventeen
(ebox-native-reflow--persistent-index-get next 17)))
(should-not (eq base next))))
(ert-deftest ebox-logical-candidate-path-copies-runtime-indexes-only ()
"A local logical commit shares its base and never copies a complete core map."
(let* ((input
(ebox-test-column
(ebox-test-box :key 'message :source-identity 'message
(ebox-test-text "old"))
(ebox-test-box :key 'tail (ebox-test-text "tail"))))
(buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-runtime-index-local*") input))
(old-state (ebox--buffer-render-state buffer))
(old-nodes (plist-get old-state :node-table))
(old-parents (plist-get old-state :parent-table))
(old-regions (plist-get old-state :region-node-table))
(old-postorder (plist-get old-state :native-node-postorder))
(old-message (ebox--host-ref-node buffer 'message))
(original-copy (symbol-function 'copy-hash-table))
copied-core)
(unwind-protect
(let ((candidate (ebox-candidate-begin buffer)))
(ebox-candidate-replace-host-ref
candidate 'message
(ebox-test-box :key 'message :source-identity 'message
(ebox-test-text "new")))
(cl-letf (((symbol-function 'copy-hash-table)
(lambda (table)
(when (memq table
(list old-nodes old-parents old-regions))
(setq copied-core t))
(funcall original-copy table))))
(ebox-commit buffer candidate))
(let* ((state (ebox--buffer-render-state buffer))
(nodes (plist-get state :node-table))
(parents (plist-get state :parent-table))
(regions (plist-get state :region-node-table)))
(should-not copied-core)
(should (ebox-runtime-index-p nodes))
(should (ebox-runtime-index-p parents))
(should (ebox-runtime-index-p regions))
(should-not (eq nodes old-nodes))
(should (eq regions old-regions))
(should (eq (plist-get state :native-node-postorder)
old-postorder))
(should (eq (plist-get state :native-node-postorder-ids)
old-postorder))
(should (eq (ebox-runtime-index-get
(plist-get old-message :node-id) old-nodes)
old-message))
(should
(cl-every
(lambda (node-id)
(ebox-runtime-index-get node-id nodes))
old-postorder))))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-logical-candidate-converts-legacy-native-postorder ()
"Legacy and mixed vectors resolve every entry against candidate nodes."
(let* ((old-leaf '(:ebox-type text :node-id 1 :content "old"))
(old-root (list :ebox-type 'column :node-id 2
:children (list old-leaf)))
(new-leaf '(:ebox-type text :node-id 1 :content "new"))
(new-root (list :ebox-type 'column :node-id 2
:children (list new-leaf))))
(dolist (table (list (ebox-runtime-index-empty)
(make-hash-table :test 'equal)))
(setq table (ebox-runtime-index-put 1 new-leaf table)
table (ebox-runtime-index-put 2 new-root table))
(dolist (legacy (list (vector old-leaf old-root)
(vector 1 old-root)
(vector old-leaf 2)))
(let* ((before (copy-sequence legacy))
(state (list :native-node-postorder legacy
:native-node-postorder-ids (vector 1 2)))
(postorder
(ebox-incremental--candidate-retain-native-postorder
state table)))
(should (equal postorder [1 2]))
(should-not (eq postorder legacy))
(should (equal legacy before))
(should (eq (ebox-native-reflow--postorder-node
(aref postorder 0) table)
new-leaf))
(should (eq (ebox-native-reflow--postorder-node
(aref postorder 1) table)
new-root)))))))
(ert-deftest ebox-logical-candidate-native-postorder-validates-legacy-membership ()
"Unmarked retained entries reject missing candidate nodes; empty is valid."
(let* ((node '(:ebox-type text :node-id 1 :content "old"))
(table (ebox-runtime-index-empty)))
(should-error
(ebox-incremental--candidate-retain-native-postorder
(list :native-node-postorder (vector node)) table)
:type 'error)
(should (equal
(ebox-incremental--candidate-retain-native-postorder
(list :native-node-postorder []) table)
[]))
(should-not
(ebox-incremental--candidate-retain-native-postorder nil table))))
(ert-deftest ebox-logical-candidate-retains-native-id-postorder-without-lookups ()
"Generated ID vectors retain their exact identity without walking nodes."
(let* ((input (ebox-test-column (ebox-test-text "retained")))
(root (ebox-test-root input))
(index (ebox--runtime-index root nil (ebox-test-source-index input)))
(postorder (plist-get index :native-node-postorder)))
(should (eq postorder (plist-get index :native-node-postorder-ids)))
(cl-letf (((symbol-function 'ebox-runtime-index-get)
(lambda (&rest _arguments)
(ert-fail "Generated native ID postorder was remapped"))))
(should (eq postorder
(ebox-incremental--candidate-retain-native-postorder
index (plist-get index :node-table)))))))
(defun ebox-test--native-topology-full-gate-fixture ()
"Return `(BUFFER OLD-STATE CANDIDATE-STATE PREPARED TAIL)' for a paint edit."
(let* ((previous-message
(ebox-test-box :key 'message :source-identity 'message
:background-color "#111111"
(ebox-test-text "message")))
(previous
(ebox-test-column
previous-message
(ebox-test-box :key 'tail :source-identity 'tail
(ebox-test-text "tail"))))
(next
(ebox-test-box :key 'message :source-identity 'message
:background-color "#222222"
(ebox-test-text "message")))
(buffer
(ebox-render-to-buffer
(generate-new-buffer-name " *ebox-topology-authority*") previous))
(old-state (ebox--buffer-render-state buffer))
(candidate (ebox-candidate-begin buffer)))
(unless (ebox-candidate-patch-host-paint
candidate 'message
previous-message next)
(error "Topology authority fixture paint patch was rejected"))
(let* ((prepared
(ebox-incremental--prepare-logical-candidate
buffer old-state candidate))
(candidate-state
(ebox-incremental--candidate-state
old-state (plist-get prepared :root)
(plist-get prepared :index) prepared)))
(list buffer old-state candidate-state prepared
(ebox--host-ref-node buffer 'tail)))))
(ert-deftest ebox-native-topology-full-gate-rejects-untouched-object-loss ()
"The full topology gate rejects a missing untouched surface object."
(pcase-let ((`(,buffer ,old-state ,candidate-state ,prepared ,tail)
(ebox-test--native-topology-full-gate-fixture)))
(unwind-protect
(progn
(should (ebox-native-commit-topology-stable-p
old-state candidate-state prepared))
(remhash (plist-get tail :node-id)
(plist-get old-state :surface-node-object-table))
(should-not (ebox-native-commit-topology-stable-p
old-state candidate-state prepared)))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-native-topology-full-gate-rejects-untouched-source-key-change ()
"The full topology gate rejects an untouched source key change."
(pcase-let ((`(,buffer ,old-state ,candidate-state ,prepared ,tail)
(ebox-test--native-topology-full-gate-fixture)))
(unwind-protect
(progn
(should (ebox-native-commit-topology-stable-p
old-state candidate-state prepared))
(let* ((source-index (plist-get candidate-state :source-index))
(binding
(ebox-source-index-rebind
source-index (ebox-tree-node-source-handle tail)
:key 'tampered-tail)))
(plist-put candidate-state :source-index (car binding)))
(should-not (ebox-native-commit-topology-stable-p
old-state candidate-state prepared)))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest ebox-native-session-fork-shares-immutable-compiler-roots ()
"Forking does not clone the retained fragment map or persistent indexes."
(require 'ebox-native-reflow)
(let* ((cache (make-hash-table :test 'equal))
(index (ebox-native-reflow--persistent-index-put nil 1 'entry))
(edge-index
(ebox-native-reflow--persistent-index-put
nil '(rule . 1) '(:kind direct-axis)))
(styles (vector 'style))
(session
(ebox-native-reflow--make-session
:handle 'parent :generation 4 :styles styles
:layout-package 'package :layout-fragment-cache cache
:layout-fragment-index index :layout-fragment-revision 8
:layout-style-index index :layout-property-template-index index
:layout-edge-index edge-index)))
(cl-letf (((symbol-function 'ebox-native--module-fork-confirmed)
(lambda (_handle) 'child)))
(let ((fork (ebox-native-reflow-fork-session session)))
(should (eq cache
(ebox-native-reflow-session-layout-fragment-cache fork)))
(should (eq index
(ebox-native-reflow-session-layout-fragment-index fork)))
(should (eq edge-index
(ebox-native-reflow-session-layout-edge-index fork)))
(should (eq styles (ebox-native-reflow-session-styles fork)))
(should (= 8
(ebox-native-reflow-session-layout-fragment-revision
fork)))))))
(ert-deftest ebox-native-failed-delta-keeps-fork-and-parent-indexes-unchanged ()
"A rejected candidate cannot publish its path-copied compiler index."
(require 'ebox-native-reflow)
(let* ((cache (make-hash-table :test 'equal))
(base-index (ebox-native-reflow--persistent-index-put nil 1 'old))
(next-index
(ebox-native-reflow--persistent-index-put base-index 1 'new))
(edge-index
(ebox-native-reflow--persistent-index-put
nil '(child . 1) '(:parent-id 9)))
(old (list :document '(:version 2) :document-revision 4
:styles [] :property-templates []))
(next (copy-sequence old))
(parent
(ebox-native-reflow--make-session
:handle 'parent :layout-package old :styles []
:layout-fragment-cache cache :layout-fragment-index base-index
:layout-edge-index edge-index)))
(plist-put next :document-revision 5)
(plist-put next :document-delta
'(:style-base-count 0 :styles-append []
:property-template-base-count 0
:property-template-target-count 0 :entries []))
(plist-put next :native-fragment-index next-index)
(cl-letf (((symbol-function 'ebox-native--module-fork-confirmed)
(lambda (_handle) 'child)))
(let ((fork (ebox-native-reflow-fork-session parent)))
(cl-letf (((symbol-function
'ebox-native-reflow--compile-retained-layout-package)
(lambda (&rest _) next))
((symbol-function 'ebox-native--module-render-session-frame)
(lambda (&rest _) (error "reject delta"))))
(should-error
(ebox-native-reflow-execute-session-sync
fork 'node '(:key 1 :viewport-width 80 :viewport-height 10)
nil 'state))
(should (eq base-index
(ebox-native-reflow-session-layout-fragment-index fork)))
(should (eq base-index
(ebox-native-reflow-session-layout-fragment-index parent)))
(should (eq edge-index
(ebox-native-reflow-session-layout-edge-index fork)))
(should (eq edge-index
(ebox-native-reflow-session-layout-edge-index parent)))
(should (eq cache
(ebox-native-reflow-session-layout-fragment-cache fork))))))))
(ert-deftest ebox-native-accepted-delta-invalidates-stale-full-cache ()
"A later full fallback cannot resurrect pre-delta legacy fragments."
(require 'ebox-native-reflow)
(let* ((cache (make-hash-table :test 'equal))
(base-index (ebox-native-reflow--persistent-index-put nil 1 'old))
(next-index
(ebox-native-reflow--persistent-index-put base-index 1 'new))
(old (list :document '(:version 2) :document-revision 4
:styles [] :property-templates []))
(next (copy-sequence old))
(session
(ebox-native-reflow--make-session
:handle 'test :generation 0 :layout-package old :styles []
:layout-fragment-cache cache :layout-fragment-index base-index)))
(puthash 1 'stale-fragment cache)
(plist-put next :document-revision 5)
(plist-put next :document-delta
'(:style-base-count 0 :styles-append []
:property-template-base-count 0
:property-template-target-count 0 :entries []))
(plist-put next :native-fragment-index next-index)
(plist-put next :native-fragment-revision 9)
(cl-letf (((symbol-function
'ebox-native-reflow--compile-retained-layout-package)
(lambda (&rest _) next))
((symbol-function 'ebox-native--module-render-session-frame)
(lambda (&rest _) 'native-frame))
((symbol-function 'ebox-native-reflow--materialize-module-frame)
(lambda (&rest _) '(:rendered "ok"))))
(ebox-native-reflow-execute-session-sync
session 'node '(:key 1 :viewport-width 80 :viewport-height 10)
nil 'state)
(should-not
(ebox-native-reflow-session-layout-fragment-cache session))
(should (eq next-index
(ebox-native-reflow-session-layout-fragment-index session)))
(should (= 9
(ebox-native-reflow-session-layout-fragment-revision
session)))
;; Model the next unsupported B update. The current source contains A's
;; accepted value while the persistent index is deliberately stale; the
;; invalidated legacy cache forces a complete compile from current state.
(let* ((input
(ebox-test-box (ebox-test-text "A") :bgcolor "#00ff00"))
(root (ebox-test-root input))
(_ids (ebox--runtime-node-ids root))
(full
(ebox-native-reflow--compile-retained-layout-package-full
session
(list :native-node-postorder
(ebox-native-reflow--retained-layout-postorder root)
:native-topology-stable-p nil
:source-index (ebox-test-source-index input))
root))
(document-root (plist-get (plist-get full :document) :root))
(style-id (plist-get document-root :background-style)))
(should
(equal '(:background "#00ff00")
(plist-get (aref (plist-get full :styles) style-id)
:face)))))))
(ert-deftest ebox-native-node-delta-is-local-and-bumps-ancestors ()
"A local change patches one owner and only revises its retained ancestor."
(require 'ebox-native-reflow)
(let* ((leaf-fragment
'(:type "box" :background-style :null :child :null
:node-id 2 :node-revision 3))
(root-fragment
(list :type "box" :background-style :null :child leaf-fragment
:node-id 1 :node-revision 4))
(leaf-entry (list :fragment leaf-fragment :revision 3))
(root-entry (list :fragment root-fragment :revision 4))
(index (ebox-native-reflow--persistent-index-put nil 1 root-entry))
(_index (setq index
(ebox-native-reflow--persistent-index-put
index 2 leaf-entry)))
(style-index
(ebox-native-reflow--persistent-index-put
nil '(:mode add :face (:background "red")) 0))
(package
(list :document '(:version 2) :document-revision 7
:styles [] :property-templates []))
(session
(ebox-native-reflow--make-session
:handle 'test :generation 0 :styles [] :layout-package package
:layout-fragment-index index :layout-fragment-revision 4
:layout-style-index style-index))
(nodes (make-hash-table :test 'equal))
(parents (make-hash-table :test 'equal))
(state
(list :node-table nodes :parent-table parents
:native-topology-stable-p t
:native-touched-node-ids '(2 1)
:native-local-dirty-entries
'((:node-id 2 :dirty-kind paint
:changed-keys (:background-color))))))
(puthash 1 '(:node-id 1) nodes)
(puthash 2 '(:node-id 2) nodes)
(puthash 2 1 parents)
(cl-letf (((symbol-function 'ebox--current-display-signature)
(lambda () 'display))
((symbol-function 'ebox-native-reflow--compile-delta-slots)
(lambda (_node _old)
(vector
'(:type "box" :background-style 0 :child :null)))))
(let* ((next
(ebox-native-reflow--compile-retained-layout-delta
session state 'root))
(delta (plist-get next :document-delta))
(entries (plist-get delta :entries))
(leaf (aref entries 0))
(root (aref entries 1)))
(should (= 8 (plist-get next :document-revision)))
(should (= 0 (plist-get delta :style-base-count)))
(should (= 2 (length entries)))
(should (equal [(:slot 0 :local (:background-style 0))]
(plist-get leaf :slot-patches)))
(should-not (plist-member root :slot-patches))
(should (= 5 (plist-get leaf :target-revision)))
(should (= 6 (plist-get root :target-revision)))))))
(ert-deftest ebox-native-node-delta-deduplicates-multiple-leaf-closures ()
"Multiple changed leaves produce one entry each and one shared ancestor."
(require 'ebox-native-reflow)
(let ((index nil)
(nodes (make-hash-table :test 'equal))
(parents (make-hash-table :test 'equal)))
(dolist (pair '((1 . 3) (2 . 1) (3 . 2)))
(setq index
(ebox-native-reflow--persistent-index-put
index (car pair)
(list :fragment
'(:type "box" :background-style :null :child :null)
:revision (cdr pair))))
(puthash (car pair) (list :node-id (car pair)) nodes))
(puthash 2 1 parents)
(puthash 3 1 parents)
(let* ((package (list :document '(:version 2) :document-revision 2
:styles [] :property-templates []))
(session
(ebox-native-reflow--make-session
:handle 'test :layout-package package
:layout-fragment-index index :layout-fragment-revision 3))
(state
(list :node-table nodes :parent-table parents
:native-topology-stable-p t
:native-touched-node-ids '(2 1 3 1)
:native-local-dirty-entries
'((:node-id 2 :changed-keys (:background-color))
(:node-id 3 :changed-keys (:background-color))))))
(cl-letf (((symbol-function 'ebox--current-display-signature)
(lambda () 'display))
((symbol-function 'ebox-native-reflow--compile-delta-slots)
(lambda (node _old)
(vector
(list :type "box" :background-style
(plist-get node :node-id) :child :null)))))
(let* ((next
(ebox-native-reflow--compile-retained-layout-delta
session state 'root))
(entries
(plist-get (plist-get next :document-delta) :entries)))
(should (= 3 (length entries)))
(should (equal '(2 1 3)
(mapcar (lambda (entry)
(plist-get entry :node-id))
(append entries nil))))
(should (plist-member (aref entries 0) :slot-patches))
(should-not (plist-member (aref entries 1) :slot-patches))
(should (plist-member (aref entries 2) :slot-patches)))))))
(ert-deftest ebox-native-fused-text-delta-resolves-to-box-owner ()
"A fused text id addresses its containing Box rather than a hidden node."
(require 'ebox-native-reflow)
(let ((nodes (make-hash-table :test 'equal))
(parents (make-hash-table :test 'equal))
(index (ebox-native-reflow--persistent-index-put nil 10 'owner)))
(puthash 10
(list :node-id 10 :ebox-kind 'box
:ebox-layout-config
(ebox-normal-layout-create))
nodes)
(puthash 11 '(:node-id 11 :ebox-kind text) nodes)
(puthash 11 10 parents)
(should (= 10
(ebox-native-reflow--delta-owner-id
(list :node-table nodes :parent-table parents) 11 index)))))
(ert-deftest ebox-native-flex-item-metadata-change-uses-full-input ()
"N1 does not misrepresent Flex item metadata as a local scalar patch."
(require 'ebox-native-reflow)
(let ((session
(ebox-native-reflow--make-session
:handle 'test :layout-package 'old
:layout-fragment-index
(ebox-native-reflow--persistent-index-put
nil 1 '(:fragment (:type "box" :child :null) :revision 1))))
(state
'(:native-topology-stable-p t :native-touched-node-ids (1)
:native-local-dirty-entries
((:node-id 1 :dirty-kind geometry
:changed-keys (:flex-grow)))))
full-called)
(cl-letf (((symbol-function
'ebox-native-reflow--compile-retained-layout-package-full)
(lambda (&rest _)
(setq full-called t)
'full))
((symbol-function 'ebox-native-reflow--compile-delta-slots)
(lambda (&rest _)
(ert-fail "Flex item metadata reached local delta"))))
(should (eq 'full
(ebox-native-reflow--compile-retained-layout-package
session state 'node)))
(should full-called))))
(ert-deftest ebox-native-flex-child-content-change-uses-full-input ()
"Child content may alter retained Flex edge measurement in N1."
(require 'ebox-native-reflow)
(let ((nodes (make-hash-table :test 'equal))
(parents (make-hash-table :test 'equal))
(index
(ebox-native-reflow--persistent-index-put
nil 2 '(:fragment (:type "box" :content [] :child :null)
:revision 3)))
full-called)
(puthash 1 '(:node-id 1 :ebox-type flex) nodes)
(puthash 2
(list :node-id 2 :ebox-type 'box :ebox-kind 'box
:ebox-layout-config (ebox-normal-layout-create))
nodes)
(puthash 3 '(:node-id 3 :ebox-type box :ebox-kind text) nodes)
(puthash 2 1 parents)
(puthash 3 2 parents)
(let ((session
(ebox-native-reflow--make-session
:handle 'test :layout-package 'old
:layout-fragment-index index))
(state
(list :node-table nodes :parent-table parents
:native-topology-stable-p t
:native-touched-node-ids '(3 2 1)
:native-local-dirty-entries
'((:node-id 3 :dirty-kind content
:changed-keys (:content))))))
(cl-letf (((symbol-function
'ebox-native-reflow--compile-retained-layout-package-full)
(lambda (&rest _)
(setq full-called t)
'full))
((symbol-function 'ebox-native-reflow--compile-delta-slots)
(lambda (&rest _)
(ert-fail "Flex child content reached local delta"))))
(should (eq 'full
(ebox-native-reflow--compile-retained-layout-package
session state 'node)))
(should full-called)))))
(ert-deftest ebox-native-default-axis-child-change-keeps-local-input ()
"Default Row/Column edges carry no derived Flex item metadata."
(require 'ebox-native-reflow)
(let ((nodes (make-hash-table :test 'equal))
(parents (make-hash-table :test 'equal))
(index (ebox-native-reflow--persistent-index-put nil 2 'owner)))
(puthash 1
(list :node-id 1 :ebox-type 'box :ebox-kind 'box
:ebox-layout-config (ebox-column-layout-create))
nodes)
(puthash 2
(list :node-id 2 :ebox-type 'box :ebox-kind 'box
:ebox-layout-config (ebox-normal-layout-create))
nodes)
(puthash 3 '(:node-id 3 :ebox-type box :ebox-kind text) nodes)
(puthash 2 1 parents)
(puthash 3 2 parents)
(should-not
(ebox-native-reflow--delta-edge-change-p
(ebox-native-reflow--make-session
:layout-edge-index
(ebox-native-reflow--persistent-index-put
nil '(rule . 1)
'(:parent-id 1 :slot 1 :kind direct-axis :axis column)))
(list :node-table nodes :parent-table parents
:native-local-dirty-entries
'((:node-id 3 :dirty-kind geometry
:changed-keys (:content))))
index))))
(ert-deftest ebox-native-flex-fused-paint-proves-retained-edge-unchanged ()
"A fused paint edit under Flex uses its exact retained item fact."
(require 'ebox-native-reflow)
(let* ((text '(:node-id 3 :ebox-type box :ebox-kind text))
(owner
(list :node-id 2 :ebox-type 'box :ebox-kind 'box
:ebox-layout-config (ebox-normal-layout-create)
:children (list text)))
(parent
(list :node-id 1 :ebox-type 'box :ebox-kind 'box
:ebox-layout-config (ebox-flex-layout-create)
:children (list owner)))
(item (ebox-native-reflow--compile-flex-item
owner 'row '(:type "box") t 17 t))
(fragment
(list :type "box"
:child (list :type "flex" :items (vector item))))
(cache (make-hash-table :test 'equal))
(nodes (make-hash-table :test 'equal))
(parents (make-hash-table :test 'equal))
(widths (make-hash-table :test 'eq))
(owner-fragment
'(:type "box" :background-style :null :child :null
:node-id 2 :node-revision 1))
(index
(ebox-native-reflow--persistent-index-put
nil 2 (list :fragment owner-fragment :revision 1)))
(_index
(setq index
(ebox-native-reflow--persistent-index-put
index 1 (list :fragment fragment :revision 2)))))
(puthash 1 (list :fragment fragment :revision 1) cache)
(puthash 1 parent nodes)
(puthash 2 owner nodes)
(puthash 3 text nodes)
(puthash 2 1 parents)
(puthash 3 2 parents)
(puthash owner 17 widths)
(let* ((session
(ebox-native-reflow--make-session
:layout-package
'(:document (:version 2) :document-revision 1
:styles [] :property-templates [])
:layout-fragment-index index :layout-fragment-revision 2
:layout-edge-index
(ebox-native-reflow--retained-edge-index
(vector owner parent) cache)))
(state
(list :node-table nodes :parent-table parents
:flex-content-min-widths widths
:native-topology-stable-p t
:native-touched-node-ids '(3 2 1)
:native-local-dirty-entries
'((:node-id 3 :dirty-kind paint
:changed-keys (:background-color))))))
(cl-letf (((symbol-function 'ebox-tree-node-children)
(lambda (&rest _)
(ert-fail "delta edge proof enumerated siblings")))
((symbol-function 'ebox--current-display-signature)
(lambda () 'display))
((symbol-function 'ebox-native-reflow--compile-delta-slots)
(lambda (_node _old)
(vector
'(:type "box" :background-style 0 :child :null)))))
(should-not
(ebox-native-reflow--delta-edge-change-p
session state index))
(let ((package
(ebox-native-reflow--compile-retained-layout-delta
session state parent)))
(should (plist-get package :document-delta))
(should (= 2 (length
(plist-get (plist-get package :document-delta)
:entries)))))))))
(ert-deftest ebox-native-flex-measurement-change-keeps-full-fallback ()
"A changed exact Flex measurement still requires the future edge protocol."
(require 'ebox-native-reflow)
(let* ((owner
(list :node-id 2 :ebox-type 'box :ebox-kind 'box
:ebox-layout-config (ebox-normal-layout-create)
:wrap-mode 'word))
(parent
(list :node-id 1 :ebox-type 'box :ebox-kind 'box
:ebox-layout-config (ebox-flex-layout-create)
:children (list owner)))
(item (ebox-native-reflow--compile-flex-item
owner 'row '(:type "box") t 17 t))
(fragment
(list :type "box"
:child (list :type "flex" :items (vector item))))
(cache (make-hash-table :test 'equal))
(nodes (make-hash-table :test 'equal))
(parents (make-hash-table :test 'equal))
(widths (make-hash-table :test 'eq))
(index (ebox-native-reflow--persistent-index-put nil 2 'owner)))
(puthash 1 (list :fragment fragment :revision 1) cache)
(puthash 1 parent nodes)
(puthash 2 owner nodes)
(puthash 2 1 parents)
(puthash owner 23 widths)
(should
(ebox-native-reflow--delta-edge-change-p
(ebox-native-reflow--make-session
:layout-edge-index
(ebox-native-reflow--retained-edge-index
(vector owner parent) cache))
(list :node-table nodes :parent-table parents
:flex-content-min-widths widths
:native-local-dirty-entries
'((:node-id 2 :dirty-kind content :changed-keys (:content))))
index))))
(ert-deftest ebox-native-nondefault-axis-fused-edit-uses-exact-edge-fact ()
"A fused edit under nondefault Row reuses an unchanged align-self fact."
(require 'ebox-native-reflow)
(let* ((text '(:node-id 3 :ebox-type box :ebox-kind text))
(owner
(list :node-id 2 :ebox-type 'box :ebox-kind 'box
:ebox-layout-config (ebox-normal-layout-create)
:children (list text)))
(parent
(list :node-id 1 :ebox-type 'box :ebox-kind 'box
:ebox-layout-config
(ebox-row-layout-create :item-gap 2 :cross-align 'stretch)
:children (list owner)))
(item
(list :node '(:type "box") :order 0 :grow 0 :shrink 0
:basis '(:kind "auto") :align-self "stretch"))
(fragment
(list :type "box"
:child (list :type "flex" :items (vector item))))
(cache (make-hash-table :test 'equal))
(nodes (make-hash-table :test 'equal))
(parents (make-hash-table :test 'equal))
(index (ebox-native-reflow--persistent-index-put nil 2 'owner)))
(puthash 1 (list :fragment fragment :revision 1) cache)
(puthash 1 parent nodes)
(puthash 2 owner nodes)
(puthash 3 text nodes)
(puthash 2 1 parents)
(puthash 3 2 parents)
(should-not
(ebox-native-reflow--delta-edge-change-p
(ebox-native-reflow--make-session
:layout-edge-index
(ebox-native-reflow--retained-edge-index
(vector owner parent) cache))
(list :node-table nodes :parent-table parents
:native-local-dirty-entries
'((:node-id 3 :dirty-kind content :changed-keys (:content))))
index))))
(ert-deftest ebox-native-surface-overrides-carry-local-dirty-entries ()
"The incremental producer preserves exact local dirtiness to native input."
(let* ((dirty '((:node-id 7 :dirty-kind paint
:changed-keys (:background-color))))
(candidate (list :runtime-revision 3
:native-topology-stable-p t
:native-touched-node-ids '(7 1)
:native-local-dirty-entries dirty))
(overrides
(ebox-incremental--surface-state-overrides
nil '(:display-signature display) candidate 'native-frame)))
(should (equal dirty
(plist-get overrides :native-local-dirty-entries)))))
(ert-deftest ebox-native-wide-owner-local-compile-does-not-enumerate-children ()
"A scalar slot update never walks a stable owner's unchanged children."
(require 'ebox-native-reflow)
(let ((node (list :ebox-type 'box :ebox-kind 'box
:ebox-layout-config (ebox-flex-layout-create)))
(old '(:type "box" :child (:type "flex" :items [a b c]))))
(cl-letf (((symbol-function 'ebox-tree-node-children)
(lambda (&rest _)
(ert-fail "stable delta enumerated unchanged children")))
((symbol-function 'ebox-native-reflow--compile-flex-inner)
(lambda (_props items &rest _)
(should-not items)
'(:type "flex" :items [])))
((symbol-function 'ebox-native-reflow--compile-box)
(lambda (_box child &rest _)
(list :type "box" :child child))))
(let ((slots (ebox-native-reflow--compile-delta-slots node old)))
(should (= 2 (length slots)))
(should (equal [] (plist-get (aref slots 1) :items)))))))
(ert-deftest ebox-native-retained-sync-sends-document-delta-without-document ()
"A supported retained compile sends only its node delta and revisions."
(require 'ebox-native-reflow)
(let* ((old (list :document '(:version 2) :document-revision 4
:styles [] :property-templates []))
(delta '(:style-base-count 0 :styles-append []
:property-template-base-count 0
:property-template-target-count 0 :entries []))
(next (copy-sequence old))
(session
(ebox-native-reflow--make-session
:handle 'test :generation 0 :styles [] :layout-package old))
control)
(plist-put next :document-revision 5)
(plist-put next :document-delta delta)
(cl-letf (((symbol-function
'ebox-native-reflow--compile-retained-layout-package)
(lambda (&rest _) next))
((symbol-function 'ebox-native--module-render-session-frame)
(lambda (_handle _generation payload)
(setq control
(json-parse-string payload :object-type 'plist
:array-type 'array))
'native-frame))
((symbol-function 'ebox-native-reflow--materialize-module-frame)
(lambda (&rest _) '(:rendered "ok"))))
(ebox-native-reflow-execute-session-sync
session 'node
'(:key 1 :viewport-width 80 :viewport-height 10) nil 'state)
(should-not (plist-member control :document))
(should (equal delta (plist-get control :document-delta)))
(should (= 4 (plist-get control :document-base-revision)))
(should (= 5 (plist-get control :document-target-revision)))
(should-not
(plist-member
(ebox-native-reflow-session-layout-package session)
:document-delta)))))
(provide 'ebox-commit-tests)
;;; ebox-commit-tests.el ends here