;;; 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--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--hash-facts (table &optional values)
  "Return sorted TABLE keys, or key/value pairs when VALUES is non-nil."
  (let (facts)
    (maphash (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)))
    (maphash (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)))
    (maphash (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
                                             (gethash 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 (gethash node-id node-table)))
                              (setq key
                                    (ebox-tree-node-key
                                     (plist-get state :source-index) node)))
                            (setq node-id
                                  (and (not key)
                                       (gethash 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)
  "Return a stretched fixed-basis panel containing two selectable rows."
  (let ((panel
         (ebox-test-box
          :key 'selection-panel :width 'stretch :min-width 0 :min-height 24
          :flex-grow 2 :flex-shrink 1 :flex-basis '(340)
          (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))))))
    (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))

(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))




(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)))))


(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))))
    (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))))))

(provide 'ebox-commit-tests)

;;; ebox-commit-tests.el ends here