654c824630
Make TP the sole owner of live-buffer text-property publication, mount spans, scoped diff execution, and transaction rollback. Ebox now computes layout owners and retained surface plans, publishes handle/viewport/theme/scroll changes through TP, and keeps its mirrored runtime state transactionally consistent. Remove the former Ebox marker/index/patch executor instead of preserving a second mutation path.\n\nVerification:\n- make ci EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs\n- make package-lint-install EMACS=/Applications/Emacs.app/Contents/MacOS/Emacs\n- strict byte compilation passed for 16 files\n- Ebox production has no tp-- private calls or marker writers\n- TP production has no Ebox dependency
886 lines
40 KiB
EmacsLisp
886 lines
40 KiB
EmacsLisp
;;; ebox-surface-tests.el --- TP surface projection tests -*- lexical-binding: t; -*-
|
|
|
|
(require 'cl-lib)
|
|
(require 'ert)
|
|
|
|
(unless load-file-name
|
|
(error "This test file must be loaded from disk, not eval'ed directly"))
|
|
|
|
(setq load-prefer-newer t)
|
|
|
|
(load-file (expand-file-name "../ebox.el"
|
|
(file-name-directory load-file-name)))
|
|
(require 'tp-surface)
|
|
|
|
(defun ebox-surface-test--reset-render-state ()
|
|
"Reset render identities and side tables used by projection tests."
|
|
(setq ebox--region-id-counter 0
|
|
ebox--runtime-node-id-counter 0)
|
|
(dolist (table (list ebox--region-box-table
|
|
ebox--scroll-global-state))
|
|
(clrhash table)))
|
|
|
|
(defun ebox-surface-test--interactive-content ()
|
|
"Return fresh interactive propertized content for projection tests."
|
|
(let ((map (make-sparse-keymap)))
|
|
(define-key map [mouse-1] #'ignore)
|
|
(propertize "Open" 'keymap map 'mouse-face 'highlight
|
|
'help-echo "Open this item")))
|
|
|
|
(defun ebox-surface-test--fixtures ()
|
|
"Return named fresh layout builders covering active Ebox layout kinds."
|
|
(list
|
|
(cons 'box
|
|
(lambda ()
|
|
(ebox-create :key 'box :content (ebox-surface-test--interactive-content)
|
|
:width '(120) :padding '(1 (4))
|
|
:border "#334155" :bgcolor "#E2E8F0"
|
|
:color "#0F172A")))
|
|
(cons 'row-column
|
|
(lambda ()
|
|
(ebox-column
|
|
(ebox-row
|
|
(ebox-create :key 'left :content "Left" :width '(70)
|
|
:bgcolor "#DBEAFE" :color "#172554")
|
|
(ebox-create :key 'right :content "Right\nDetail" :width '(90)
|
|
:bgcolor "#DCFCE7" :color "#14532D"))
|
|
(ebox-create :key 'footer :content "Footer" :width '(160)
|
|
:bgcolor "#F1F5F9" :color "#0F172A"))))
|
|
(cons 'flex
|
|
(lambda ()
|
|
(ebox-flex
|
|
:width '(210) :flex-wrap 'wrap :column-gap '(10)
|
|
(ebox-flex-item
|
|
(ebox-create :key 'grow :content "Grow" :width '(80)
|
|
:bgcolor "#EDE9FE" :color "#2E1065")
|
|
:flex-grow 1 :flex-basis '(80))
|
|
(ebox-flex-item
|
|
(ebox-create :key 'fixed :content "Fixed" :width '(120)
|
|
:bgcolor "#FFEDD5" :color "#7C2D12")))))
|
|
(cons 'grid
|
|
(lambda ()
|
|
(ebox-grid
|
|
:width '(220) :grid-template-columns '((70) 1fr)
|
|
:grid-template-rows '(2) :gap '(1 (8))
|
|
:border "#475569"
|
|
(ebox-create :key 'grid-left :content "A\nAA"
|
|
:bgcolor "#E0F2FE" :color "#0C4A6E")
|
|
(ebox-create :key 'grid-right :content "B\nBB"
|
|
:bgcolor "#FCE7F3" :color "#831843"))))
|
|
(cons 'overflow-scroll
|
|
(lambda ()
|
|
(ebox-create :key 'scroll :content "zero\none\ntwo\nthree"
|
|
:width '(100) :height 2 :overflow 'scroll
|
|
:bgcolor "#1E293B" :color "#F8FAFC")))))
|
|
|
|
(defun ebox-surface-test--render-fresh (builder projector-p)
|
|
"Render BUILDER after a reset, using the TP projector when PROJECTOR-P."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let ((ebox-viewport-width 240)
|
|
(ebox-viewport-height 12)
|
|
(node (funcall builder)))
|
|
(if projector-p
|
|
(tp-surface-materialize-string
|
|
(ebox-surface-producer node))
|
|
(ebox-render node))))
|
|
|
|
(defun ebox-surface-test--walk-runtime (node function)
|
|
"Call FUNCTION for every runtime NODE in preorder."
|
|
(funcall function node)
|
|
(dolist (child (ebox-tree-node-children node))
|
|
(ebox-surface-test--walk-runtime child function)))
|
|
|
|
(defun ebox-surface-test--plan-runtime-value-p (value)
|
|
"Return non-nil when VALUE is forbidden runtime state in a pure plan."
|
|
(cond
|
|
((or (markerp value) (bufferp value) (tp-object-p value)
|
|
(tp-binding-p value) (tp-surface-p value))
|
|
t)
|
|
((consp value)
|
|
(or (ebox-surface-test--plan-runtime-value-p (car value))
|
|
(ebox-surface-test--plan-runtime-value-p (cdr value))))
|
|
((vectorp value)
|
|
(cl-some #'ebox-surface-test--plan-runtime-value-p value))
|
|
(t nil)))
|
|
|
|
(defun ebox-surface-test--plan-pure-p (plan)
|
|
"Return non-nil when PLAN contains only pure projection data."
|
|
(and
|
|
(not (cl-some
|
|
#'ebox-surface-test--plan-runtime-value-p
|
|
(list (tp-surface-plan-key plan)
|
|
(tp-surface-plan-kind plan)
|
|
(tp-surface-plan-text plan)
|
|
(tp-surface-plan-props plan)
|
|
(tp-surface-plan-tags plan))))
|
|
(cl-every #'ebox-surface-test--plan-pure-p
|
|
(tp-surface-plan-children plan))))
|
|
|
|
(defun ebox-surface-test--object-by-key (state key)
|
|
"Return the candidate surface object for Ebox node KEY in STATE."
|
|
(let (object)
|
|
(maphash
|
|
(lambda (_node-id node)
|
|
(when (equal (plist-get node :key) key)
|
|
(setq object (plist-get node :surface-object))))
|
|
(plist-get state :node-table))
|
|
object))
|
|
|
|
(ert-deftest ebox-surface-projects-every-layout-with-exact-equivalence ()
|
|
"TP projection should preserve every character and text property interval."
|
|
(dolist (fixture (ebox-surface-test--fixtures))
|
|
(let* ((builder (cdr fixture))
|
|
(expected (ebox-surface-test--render-fresh builder nil))
|
|
(actual (ebox-surface-test--render-fresh builder t)))
|
|
(should (equal-including-properties actual expected))
|
|
(should (equal (mapcar #'ebox--string-pixel-width
|
|
(ebox-string-lines actual))
|
|
(mapcar #'ebox--string-pixel-width
|
|
(ebox-string-lines expected)))))))
|
|
|
|
(ert-deftest ebox-surface-assigns-object-identity-before-layout ()
|
|
"Every candidate runtime node should own a TP object before layout starts."
|
|
(let ((original (symbol-function 'ebox--render-layout))
|
|
checked captured)
|
|
(cl-letf (((symbol-function 'ebox--render-layout)
|
|
(lambda (node)
|
|
(unless checked
|
|
(setq checked t)
|
|
(ebox-surface-test--walk-runtime
|
|
node
|
|
(lambda (runtime-node)
|
|
(let ((object (plist-get runtime-node :surface-object)))
|
|
(should (tp-object-p object))
|
|
(push object captured)))))
|
|
(funcall original node))))
|
|
(ebox-surface-test--render-fresh
|
|
(cdr (assq 'grid (ebox-surface-test--fixtures))) t))
|
|
(should checked)
|
|
(should captured)
|
|
(dolist (object captured)
|
|
(should-not (tp-object-live-p object)))))
|
|
|
|
(ert-deftest ebox-surface-plan-stays-free-of-runtime-state ()
|
|
"The generic surface plan should not contain markers or runtime handles."
|
|
(let ((original (symbol-function 'tp-surface-result-create))
|
|
captured)
|
|
(cl-letf (((symbol-function 'tp-surface-result-create)
|
|
(lambda (plan &optional client-state)
|
|
(setq captured plan)
|
|
(funcall original plan client-state))))
|
|
(ebox-surface-test--render-fresh
|
|
(cdr (assq 'box (ebox-surface-test--fixtures))) t))
|
|
(should (tp-surface-plan-p captured))
|
|
(should (ebox-surface-test--plan-pure-p captured))))
|
|
|
|
(ert-deftest ebox-surface-projection-does-not-mutate-a-buffer ()
|
|
"Pure projection should not call any final buffer mutation primitive."
|
|
(cl-letf (((symbol-function 'insert)
|
|
(lambda (&rest _) (error "Unexpected buffer insertion")))
|
|
((symbol-function 'erase-buffer)
|
|
(lambda (&rest _) (error "Unexpected buffer erase")))
|
|
((symbol-function 'delete-region)
|
|
(lambda (&rest _) (error "Unexpected buffer deletion")))
|
|
((symbol-function 'replace-region-contents)
|
|
(lambda (&rest _) (error "Unexpected buffer replacement"))))
|
|
(should
|
|
(stringp
|
|
(ebox-surface-test--render-fresh
|
|
(cdr (assq 'row-column (ebox-surface-test--fixtures))) t)))))
|
|
|
|
(ert-deftest ebox-surface-logical-box-owns-disjoint-render-fragments ()
|
|
"One logical Ebox box should resolve all of its separated painted regions."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let ((buffer (generate-new-buffer " *ebox-surface-fragments*"))
|
|
surface)
|
|
(unwind-protect
|
|
(progn
|
|
(setq surface
|
|
(tp-surface-mount
|
|
buffer
|
|
(ebox-surface-producer
|
|
(funcall (cdr (assq 'box (ebox-surface-test--fixtures)))))
|
|
'(:capability content)))
|
|
(let* ((state (tp-surface-client-state surface))
|
|
(objects (plist-get state :region-surface-object-table))
|
|
logical)
|
|
(maphash (lambda (_region-id object)
|
|
(unless logical (setq logical object)))
|
|
objects)
|
|
(should (tp-object-live-p logical))
|
|
(should (> (length (tp-object-mounts logical)) 1))))
|
|
(when (and surface (tp-surface-live-p surface))
|
|
(tp-surface-unmount surface))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer)))))
|
|
|
|
(ert-deftest ebox-surface-reuses-one-source-with-isolated-runtime-state ()
|
|
"One source description should mount into two independent TP surfaces."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let* ((source
|
|
(ebox-create :key 'shared :content "Shared" :width '(100)
|
|
:bgcolor "#E2E8F0" :color "#0F172A"))
|
|
(first-buffer (generate-new-buffer " *ebox-surface-first*"))
|
|
(second-buffer (generate-new-buffer " *ebox-surface-second*"))
|
|
first second)
|
|
(unwind-protect
|
|
(progn
|
|
(setq first
|
|
(tp-surface-mount
|
|
first-buffer (ebox-surface-producer source)
|
|
'(:capability content)))
|
|
(setq second
|
|
(tp-surface-mount
|
|
second-buffer (ebox-surface-producer source)
|
|
'(:capability content)))
|
|
(let* ((first-state (tp-surface-client-state first))
|
|
(second-state (tp-surface-client-state second))
|
|
(first-root (plist-get first-state :root-node))
|
|
(second-root (plist-get second-state :root-node)))
|
|
(should-not (eq first-root second-root))
|
|
(should-not (eq (plist-get first-root :surface-object)
|
|
(plist-get second-root :surface-object)))
|
|
(should-not (plist-member source :node-id))
|
|
(should-not (plist-member source :region-id))
|
|
(should-not (plist-member source :surface-object))))
|
|
(dolist (surface (list first second))
|
|
(when (and surface (tp-surface-live-p surface))
|
|
(tp-surface-unmount surface)))
|
|
(dolist (buffer (list first-buffer second-buffer))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer))))))
|
|
|
|
(ert-deftest ebox-surface-keyed-reorder-retains-logical-objects ()
|
|
"A keyed child reorder should retain TP objects through a new Ebox runtime."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let ((buffer (generate-new-buffer " *ebox-surface-reorder*"))
|
|
surface)
|
|
(unwind-protect
|
|
(let* ((first-source
|
|
(ebox-row
|
|
(ebox-create :key 'left :content "Left" :width '(60))
|
|
(ebox-create :key 'right :content "Right" :width '(60))))
|
|
(_mount
|
|
(setq surface
|
|
(tp-surface-mount
|
|
buffer (ebox-surface-producer first-source)
|
|
'(:capability content))))
|
|
(first-state (tp-surface-client-state surface))
|
|
(left (ebox-surface-test--object-by-key first-state 'left))
|
|
(right (ebox-surface-test--object-by-key first-state 'right))
|
|
(next-source
|
|
(ebox-row
|
|
(ebox-create :key 'right :content "Right!" :width '(60))
|
|
(ebox-create :key 'left :content "Left!" :width '(60)))))
|
|
(tp-surface-update
|
|
surface (ebox-surface-producer next-source first-state))
|
|
(let ((next-state (tp-surface-client-state surface)))
|
|
(should (eq left
|
|
(ebox-surface-test--object-by-key next-state 'left)))
|
|
(should (eq right
|
|
(ebox-surface-test--object-by-key next-state 'right)))
|
|
(should (string-match-p
|
|
"Right!.*Left!"
|
|
(substring-no-properties
|
|
(with-current-buffer buffer (buffer-string)))))))
|
|
(when (and surface (tp-surface-live-p surface))
|
|
(tp-surface-unmount surface))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer)))))
|
|
|
|
(ert-deftest ebox-render-materializes-through-tp-surface ()
|
|
"The public string renderer should materialize one ephemeral TP surface."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let ((original (symbol-function 'tp-surface-materialize-string))
|
|
(calls 0))
|
|
(cl-letf (((symbol-function 'tp-surface-materialize-string)
|
|
(lambda (producer)
|
|
(cl-incf calls)
|
|
(funcall original producer))))
|
|
(should (stringp
|
|
(ebox-render
|
|
(ebox-create :content "Materialized" :width '(100))))))
|
|
(should (= calls 1))))
|
|
|
|
(ert-deftest ebox-render-is-repeatable-without-consuming-runtime-identities ()
|
|
"Ephemeral rendering should be exact and leave live identity counters alone."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let* ((source (ebox-create :content "Repeatable" :width '(100)))
|
|
(first (ebox-render source))
|
|
(second (ebox-render source)))
|
|
(should (equal-including-properties first second))
|
|
(should (= ebox--region-id-counter 0))
|
|
(should (= ebox--runtime-node-id-counter 0))
|
|
(should-not (plist-member source :region-id))
|
|
(should-not (plist-member source :node-id))))
|
|
|
|
(ert-deftest ebox-render-to-buffer-mounts-one-tp-surface ()
|
|
"The public buffer renderer should expose TP's committed client state."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let ((buffer (generate-new-buffer " *ebox-public-surface*"))
|
|
surface)
|
|
(unwind-protect
|
|
(progn
|
|
(ebox-render-to-buffer
|
|
buffer
|
|
(ebox-create :content "Mounted" :width '(100)))
|
|
(setq surface
|
|
(with-current-buffer buffer ebox-surface--buffer-surface))
|
|
(should (tp-surface-live-p surface))
|
|
(should (eq (ebox--buffer-render-state buffer)
|
|
(tp-surface-client-state surface))))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer)))
|
|
(should-not (tp-surface-live-p surface))))
|
|
|
|
(ert-deftest ebox-viewport-rerender-publishes-only-through-tp ()
|
|
"A mounted viewport update should advance its TP surface."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let ((buffer (generate-new-buffer " *ebox-surface-viewport*")))
|
|
(unwind-protect
|
|
(let ((ebox-viewport-width 120)
|
|
(ebox-viewport-height 4)
|
|
(ebox-runtime-idle-prewarm nil)
|
|
(ebox-runtime-idle-reflow-cache-prewarm nil))
|
|
(ebox-render-to-buffer
|
|
buffer
|
|
(ebox-create :content "Viewport" :width '(viewport)))
|
|
(let* ((surface
|
|
(with-current-buffer buffer ebox-surface--buffer-surface))
|
|
(signals
|
|
(with-current-buffer buffer
|
|
ebox-surface--context-signals))
|
|
(revision (tp-surface-revision surface)))
|
|
(should (= (tp-signal-peek
|
|
(ebox-surface--signals-viewport-width signals))
|
|
120))
|
|
(ebox-rerender-buffer-with-context buffer 180 4)
|
|
(should (= (tp-surface-revision surface) (1+ revision)))
|
|
(should (= (tp-signal-peek
|
|
(ebox-surface--signals-viewport-width signals))
|
|
180))
|
|
(should (eq (ebox--buffer-render-state buffer)
|
|
(tp-surface-client-state surface)))
|
|
(should (= (with-current-buffer buffer
|
|
(ebox--string-pixel-width
|
|
(buffer-substring (line-beginning-position)
|
|
(line-end-position))))
|
|
180))
|
|
(let ((report (ebox-buffer-update-report buffer)))
|
|
(should (eq (plist-get report :constraint-source) 'viewport))
|
|
(should (plist-get report :runtime-published)))))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer)))))
|
|
|
|
(ert-deftest ebox-surface-context-signals-track-exact-layout-dependencies ()
|
|
"A mounted producer should subscribe only to context it can consume."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let ((responsive (generate-new-buffer " *ebox-responsive-signals*"))
|
|
(static (generate-new-buffer " *ebox-static-signals*"))
|
|
responsive-signals static-signals)
|
|
(unwind-protect
|
|
(let ((ebox-viewport-width 160)
|
|
(ebox-viewport-height 2))
|
|
(ebox-render-to-buffer
|
|
responsive
|
|
(ebox-create :content "zero\none\ntwo\nthree"
|
|
:width '(viewport)
|
|
:height '(viewport-height)
|
|
:overflow 'scroll))
|
|
(setq responsive-signals
|
|
(with-current-buffer responsive
|
|
ebox-surface--context-signals))
|
|
(dolist (signal
|
|
(list
|
|
(ebox-surface--signals-viewport-width
|
|
responsive-signals)
|
|
(ebox-surface--signals-viewport-height
|
|
responsive-signals)
|
|
(ebox-surface--signals-display responsive-signals)
|
|
(ebox-surface--signals-scroll responsive-signals)))
|
|
(should (tp-signal-live-p signal))
|
|
(should (= (tp-signal-subscriber-count signal) 1)))
|
|
(ebox-render-to-buffer
|
|
static
|
|
(ebox-create :content "Static" :width '(100)))
|
|
(setq static-signals
|
|
(with-current-buffer static ebox-surface--context-signals))
|
|
(should (= (tp-signal-subscriber-count
|
|
(ebox-surface--signals-viewport-width static-signals))
|
|
0))
|
|
(should (= (tp-signal-subscriber-count
|
|
(ebox-surface--signals-viewport-height static-signals))
|
|
0))
|
|
(should (= (tp-signal-subscriber-count
|
|
(ebox-surface--signals-display static-signals))
|
|
1))
|
|
(should (= (tp-signal-subscriber-count
|
|
(ebox-surface--signals-scroll static-signals))
|
|
0)))
|
|
(dolist (buffer (list responsive static))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer))))
|
|
(dolist (signals (list responsive-signals static-signals))
|
|
(when signals
|
|
(dolist (signal
|
|
(list (ebox-surface--signals-viewport-width signals)
|
|
(ebox-surface--signals-viewport-height signals)
|
|
(ebox-surface--signals-display signals)
|
|
(ebox-surface--signals-scroll signals)))
|
|
(should-not (tp-signal-live-p signal)))))))
|
|
|
|
(ert-deftest ebox-static-viewport-change-updates-context-without-rendering ()
|
|
"Unused viewport state should change without publishing the surface."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let ((buffer (generate-new-buffer " *ebox-static-viewport*")))
|
|
(unwind-protect
|
|
(let ((ebox-viewport-width 120)
|
|
(ebox-viewport-height 4)
|
|
(ebox-runtime-idle-prewarm nil)
|
|
(ebox-runtime-idle-reflow-cache-prewarm nil))
|
|
(ebox-render-to-buffer
|
|
buffer
|
|
(ebox-create :content "Static" :width '(100)))
|
|
(let* ((surface
|
|
(with-current-buffer buffer ebox-surface--buffer-surface))
|
|
(signals
|
|
(with-current-buffer buffer
|
|
ebox-surface--context-signals))
|
|
(revision (tp-surface-revision surface))
|
|
(renders 0)
|
|
(original
|
|
(symbol-function 'ebox-surface--render-candidate)))
|
|
(cl-letf (((symbol-function 'ebox-surface--render-candidate)
|
|
(lambda (state)
|
|
(cl-incf renders)
|
|
(funcall original state))))
|
|
(ebox-rerender-buffer-with-context buffer 180 4))
|
|
(should (= renders 0))
|
|
(should (= (tp-surface-revision surface) revision))
|
|
(should (= (plist-get (tp-surface-client-state surface)
|
|
:viewport-width)
|
|
180))
|
|
(should (= (tp-signal-peek
|
|
(ebox-surface--signals-viewport-width signals))
|
|
180))
|
|
(should (eq (plist-get (ebox-buffer-update-report buffer)
|
|
:strategy)
|
|
'no-op))))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer)))))
|
|
|
|
(ert-deftest ebox-theme-change-rerenders-with-an-unchanged-viewport ()
|
|
"A changed display signature should invalidate a fixed-width surface."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let ((buffer (generate-new-buffer " *ebox-theme-context*")))
|
|
(unwind-protect
|
|
(let ((ebox-viewport-width 120)
|
|
(ebox-viewport-height 4)
|
|
(ebox-runtime-idle-prewarm nil)
|
|
(ebox-runtime-idle-reflow-cache-prewarm nil))
|
|
(ebox-render-to-buffer
|
|
buffer
|
|
(ebox-create :content "Theme" :width '(100)))
|
|
(let* ((surface
|
|
(with-current-buffer buffer ebox-surface--buffer-surface))
|
|
(signals
|
|
(with-current-buffer buffer
|
|
ebox-surface--context-signals))
|
|
(revision (tp-surface-revision surface))
|
|
(next-signature '(ebox-test-theme dark)))
|
|
(cl-letf (((symbol-function 'ebox--display-signature)
|
|
(lambda () next-signature)))
|
|
(ebox-rerender-buffer-with-context buffer 120 4))
|
|
(should (= (tp-surface-revision surface) (1+ revision)))
|
|
(should (equal
|
|
(tp-signal-peek
|
|
(ebox-surface--signals-display signals))
|
|
next-signature))
|
|
(should (equal (plist-get (tp-surface-client-state surface)
|
|
:display-signature)
|
|
next-signature))
|
|
(let ((report (ebox-buffer-update-report buffer)))
|
|
(should (plist-get report :host-context-changed))
|
|
(should (memq :display-signature
|
|
(plist-get report :dirty-keys))))))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer)))))
|
|
|
|
(ert-deftest ebox-render-to-buffer-reuses-one-source-across-buffers ()
|
|
"The public mount path should never transfer ownership of its source tree."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let* ((source
|
|
(ebox-create :key 'shared :content "Shared" :width '(100)))
|
|
(first (generate-new-buffer " *ebox-public-first*"))
|
|
(second (generate-new-buffer " *ebox-public-second*")))
|
|
(unwind-protect
|
|
(progn
|
|
(ebox-render-to-buffer first source)
|
|
(ebox-render-to-buffer second source)
|
|
(should (equal
|
|
(with-current-buffer first
|
|
(substring-no-properties (buffer-string)))
|
|
(with-current-buffer second
|
|
(substring-no-properties (buffer-string)))))
|
|
(should-not
|
|
(equal (ebox-region-ids (ebox--buffer-root-node first))
|
|
(ebox-region-ids (ebox--buffer-root-node second))))
|
|
(should-not
|
|
(eq (plist-get (ebox--buffer-root-node first) :surface-object)
|
|
(plist-get (ebox--buffer-root-node second) :surface-object)))
|
|
(should-not (plist-member source :node-id))
|
|
(should-not (plist-member source :region-id))
|
|
(should-not (plist-member source :surface-object)))
|
|
(dolist (buffer (list first second))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer))))))
|
|
|
|
(ert-deftest ebox-commit-publishes-through-the-mounted-tp-surface ()
|
|
"Declarative commits should publish through the mounted TP surface."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let ((buffer (generate-new-buffer " *ebox-surface-commit*")))
|
|
(unwind-protect
|
|
(progn
|
|
(ebox-render-to-buffer
|
|
buffer
|
|
(ebox-create :key 'root :content "Before" :width '(100)))
|
|
(let* ((surface (with-current-buffer
|
|
buffer ebox-surface--buffer-surface))
|
|
(revision (tp-surface-revision surface))
|
|
report)
|
|
(setq report
|
|
(ebox-commit
|
|
buffer
|
|
(ebox-create :key 'root :content "After"
|
|
:width '(100))))
|
|
(should (= (tp-surface-revision surface) (1+ revision)))
|
|
(should (plist-get report :runtime-published))
|
|
(should (equal report (ebox-buffer-update-report buffer)))
|
|
(should (string-match-p "After" (with-current-buffer
|
|
buffer (buffer-string))))))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer)))))
|
|
|
|
(ert-deftest ebox-commit-callback-failure-rolls-back-tp-and-ebox-state ()
|
|
"A failed publication callback should restore one shared old generation."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let ((buffer (generate-new-buffer " *ebox-surface-rollback*")))
|
|
(unwind-protect
|
|
(progn
|
|
(ebox-render-to-buffer
|
|
buffer
|
|
(ebox-create :key 'root :content "Stable" :width '(100)))
|
|
(let* ((surface (with-current-buffer
|
|
buffer ebox-surface--buffer-surface))
|
|
(state (tp-surface-client-state surface))
|
|
(revision (tp-surface-revision surface))
|
|
(contents (with-current-buffer
|
|
buffer
|
|
(buffer-substring (point-min) (point-max)))))
|
|
(should-error
|
|
(ebox-commit
|
|
buffer
|
|
(ebox-create :key 'root :content "Rejected" :width '(100))
|
|
(lambda (_report) (error "Reject publication"))))
|
|
(should (= (tp-surface-revision surface) revision))
|
|
(should (eq (tp-surface-client-state surface) state))
|
|
(should (equal-including-properties
|
|
(with-current-buffer
|
|
buffer
|
|
(buffer-substring (point-min) (point-max)))
|
|
contents))))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer)))))
|
|
|
|
(ert-deftest ebox-context-signal-rolls-back-with-failed-publication ()
|
|
"A failed Ebox publication should restore its TP context source."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let ((buffer (generate-new-buffer " *ebox-context-rollback*")))
|
|
(unwind-protect
|
|
(let ((ebox-viewport-width 120)
|
|
(ebox-viewport-height 4))
|
|
(ebox-render-to-buffer
|
|
buffer
|
|
(ebox-create :key 'root :content "Stable"
|
|
:width '(viewport)))
|
|
(let* ((surface
|
|
(with-current-buffer buffer ebox-surface--buffer-surface))
|
|
(signals
|
|
(with-current-buffer buffer
|
|
ebox-surface--context-signals))
|
|
(width-signal
|
|
(ebox-surface--signals-viewport-width signals))
|
|
(state (tp-surface-client-state surface))
|
|
(revision (tp-surface-revision surface))
|
|
(contents
|
|
(with-current-buffer buffer
|
|
(buffer-substring (point-min) (point-max)))))
|
|
(should-error
|
|
(ebox-surface-mount-buffer
|
|
buffer
|
|
(ebox-create :key 'root :content "Rejected"
|
|
:width '(viewport))
|
|
(ebox--update-report nil 'root-rerender)
|
|
(lambda (_report) (error "Reject context publication"))
|
|
nil
|
|
'(:viewport-width 180 :viewport-height 4)))
|
|
(should (= (tp-signal-peek width-signal) 120))
|
|
(should (= (tp-surface-revision surface) revision))
|
|
(should (eq (tp-surface-client-state surface) state))
|
|
(should (equal-including-properties
|
|
(with-current-buffer buffer
|
|
(buffer-substring (point-min) (point-max)))
|
|
contents))))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer)))))
|
|
|
|
(ert-deftest ebox-commit-killed-buffer-rollback-does-not-revive-runtime ()
|
|
"A failed commit must not restore runtime state for a killed buffer."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let ((buffer (generate-new-buffer " *ebox-surface-killed-rollback*")))
|
|
(unwind-protect
|
|
(progn
|
|
(ebox-render-to-buffer
|
|
buffer
|
|
(ebox-create :key 'root :content "Stable" :width '(100)))
|
|
(should (gethash buffer ebox--buffer-render-state-table))
|
|
(should-error
|
|
(ebox-commit
|
|
buffer
|
|
(ebox-create :key 'root :content "Rejected" :width '(100))
|
|
(lambda (_report)
|
|
(kill-buffer buffer)
|
|
(error "Reject publication after teardown"))))
|
|
(should-not (buffer-live-p buffer))
|
|
(should-not (gethash buffer ebox--buffer-render-state-table)))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer)))))
|
|
|
|
(ert-deftest ebox-logical-candidate-report-is-the-published-client-report ()
|
|
"Logical candidates should publish one report through TP client state."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let ((buffer (generate-new-buffer " *ebox-surface-candidate*")))
|
|
(unwind-protect
|
|
(progn
|
|
(ebox-render-to-buffer
|
|
buffer
|
|
(ebox-create :key 'root :host-ref 'root
|
|
:content "Before" :width '(100)))
|
|
(let ((candidate (ebox-candidate-begin buffer)))
|
|
(ebox-candidate-replace-host-ref
|
|
candidate 'root
|
|
(ebox-create :key 'root :host-ref 'root
|
|
:content "After" :width '(100)))
|
|
(let ((report (ebox-commit buffer candidate)))
|
|
(should (equal report (ebox-buffer-update-report buffer)))
|
|
(should (eq (plist-get report :constraint-source)
|
|
'declarative))
|
|
(should (string-match-p "After" (with-current-buffer
|
|
buffer (buffer-string)))))))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer)))))
|
|
|
|
(ert-deftest ebox-region-handles-are-surface-scoped ()
|
|
"One logical id should resolve to distinct handles on independent surfaces."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let* ((source
|
|
(ebox-create :id "status" :content "Ready" :width '(100)))
|
|
(first (generate-new-buffer " *ebox-handle-first*"))
|
|
(second (generate-new-buffer " *ebox-handle-second*")))
|
|
(unwind-protect
|
|
(progn
|
|
(ebox-render-to-buffer first source)
|
|
(ebox-render-to-buffer second source)
|
|
(let ((first-handle (ebox-region-resolve first "status"))
|
|
(second-handle (ebox-region-resolve second 'status)))
|
|
(should (ebox-region-handle-p first-handle))
|
|
(should (ebox-region-handle-p second-handle))
|
|
(should-not (eq first-handle second-handle))
|
|
(ebox-region-update first-handle :content "Changed")
|
|
(should (string-match-p "Changed"
|
|
(with-current-buffer first
|
|
(buffer-string))))
|
|
(should (string-match-p "Ready"
|
|
(with-current-buffer second
|
|
(buffer-string))))))
|
|
(dolist (buffer (list first second))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer))))))
|
|
|
|
(ert-deftest ebox-region-handle-update-uses-scoped-tp-publication ()
|
|
"A handle update should publish a scoped TP plan."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let ((buffer (generate-new-buffer " *ebox-scoped-handle*")))
|
|
(unwind-protect
|
|
(progn
|
|
(ebox-render-to-buffer
|
|
buffer
|
|
(ebox-column
|
|
(ebox-create :id "left" :content "Left" :width '(100))
|
|
(ebox-create :id "right" :content "Right" :width '(100))))
|
|
(let* ((surface (with-current-buffer
|
|
buffer ebox-surface--buffer-surface))
|
|
(revision (tp-surface-revision surface))
|
|
(handle (ebox-region-resolve buffer "left"))
|
|
report)
|
|
(setq report
|
|
(ebox-region-update handle :content "Changed"))
|
|
(should (= (tp-surface-revision surface) (1+ revision)))
|
|
(should-not (plist-get (tp-surface-report surface) :full-root))
|
|
(should (> (plist-get (tp-surface-report surface) :scope-count) 0))
|
|
(should (eq (plist-get report :tp-render-scope) 'objects))
|
|
(should (string-match-p
|
|
"Changed"
|
|
(with-current-buffer buffer (buffer-string))))))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer)))))
|
|
|
|
(ert-deftest ebox-region-update-rejects-process-global-region-ids ()
|
|
"Direct updates should require a surface-scoped region handle."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let ((buffer (generate-new-buffer " *ebox-handle-only-update*")))
|
|
(unwind-protect
|
|
(progn
|
|
(ebox-render-to-buffer
|
|
buffer
|
|
(ebox-create :id "target" :content "Before" :width '(100)))
|
|
(let* ((match (car (ebox-selector-query-buffer buffer "#target")))
|
|
(region-id (plist-get match :region-id)))
|
|
(should-error (ebox-region-update region-id :content "Wrong")
|
|
:type 'wrong-type-argument)
|
|
(ebox-region-update (plist-get match :region-handle)
|
|
:content "After")
|
|
(should (string-match-p
|
|
"After"
|
|
(with-current-buffer buffer (buffer-string))))))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer)))))
|
|
|
|
(ert-deftest ebox-selector-query-returns-an-editable-region-handle ()
|
|
"A live selector match should carry the same handle accepted by updates."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let ((buffer (generate-new-buffer " *ebox-selector-handle*")))
|
|
(unwind-protect
|
|
(progn
|
|
(ebox-render-to-buffer
|
|
buffer
|
|
(ebox-create :id "action" :content "Closed" :width '(100)))
|
|
(let* ((match (car (ebox-selector-query-buffer buffer "#action")))
|
|
(handle (plist-get match :region-handle)))
|
|
(should (ebox-region-handle-p handle))
|
|
(ebox-region-update handle :content "Open")
|
|
(should (string-match-p "Open"
|
|
(with-current-buffer buffer
|
|
(buffer-string))))))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer)))))
|
|
|
|
(ert-deftest ebox-region-handle-becomes-stale-with-its-object ()
|
|
"A handle should fail after a commit removes its retained object."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let ((buffer (generate-new-buffer " *ebox-stale-handle*")))
|
|
(unwind-protect
|
|
(progn
|
|
(ebox-render-to-buffer
|
|
buffer
|
|
(ebox-create :key 'old :id "old"
|
|
:content "Old" :width '(100)))
|
|
(let ((handle (ebox-region-resolve buffer "old")))
|
|
(ebox-commit
|
|
buffer
|
|
(ebox-create :key 'new :id "new"
|
|
:content "New" :width '(100)))
|
|
(should-error (ebox-region-update handle :content "Invalid")
|
|
:type 'user-error)))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer)))))
|
|
|
|
(ert-deftest ebox-scroll-update-publishes-only-through-tp ()
|
|
"A mounted scroll update should advance one TP surface revision."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let ((buffer (generate-new-buffer " *ebox-surface-scroll*")))
|
|
(unwind-protect
|
|
(let ((ebox-viewport-width 240)
|
|
(ebox-viewport-height 2))
|
|
(ebox-render-to-buffer
|
|
buffer
|
|
(ebox-create :id "scroll" :content "zero\none\ntwo\nthree"
|
|
:width '(120) :height 2 :overflow 'scroll))
|
|
(let* ((surface (with-current-buffer
|
|
buffer ebox-surface--buffer-surface))
|
|
(signals
|
|
(with-current-buffer buffer
|
|
ebox-surface--context-signals))
|
|
(revision (tp-surface-revision surface))
|
|
(region-id
|
|
(plist-get
|
|
(car (ebox-selector-query-buffer buffer "#scroll"))
|
|
:region-id)))
|
|
(should (= (ebox--scroll-region-by region-id 1 1) 1))
|
|
(should (= (tp-surface-revision surface) (1+ revision)))
|
|
(should (= (alist-get
|
|
region-id
|
|
(tp-signal-peek
|
|
(ebox-surface--signals-scroll signals)))
|
|
1))
|
|
(let* ((state (tp-surface-client-state surface))
|
|
(root (plist-get state :root-node))
|
|
(text (with-current-buffer buffer
|
|
(buffer-substring-no-properties
|
|
(point-min) (point-max)))))
|
|
(should (= (ebox-get (ebox--root-region-box root region-id)
|
|
:scroll-offset)
|
|
1))
|
|
(should (= (plist-get (ebox-scroll-state region-id)
|
|
:scroll-offset)
|
|
1))
|
|
(should (string-match-p "one" text))
|
|
(should (string-match-p "two" text))
|
|
(should-not (string-match-p "zero" text)))))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer)))))
|
|
|
|
(ert-deftest ebox-scroll-update-rejects-a-runtime-replaced-by-its-hook ()
|
|
"A stale scroll candidate must not overwrite a hook publication."
|
|
(ebox-surface-test--reset-render-state)
|
|
(let ((buffer (generate-new-buffer " *ebox-scroll-hook-race*")))
|
|
(unwind-protect
|
|
(let ((ebox-viewport-width 240)
|
|
(ebox-viewport-height 2))
|
|
(ebox-render-to-buffer
|
|
buffer
|
|
(ebox-create :id "scroll" :content "zero\none\ntwo\nthree"
|
|
:width '(120) :height 2 :overflow 'scroll))
|
|
(let* ((surface (with-current-buffer
|
|
buffer ebox-surface--buffer-surface))
|
|
(revision (tp-surface-revision surface))
|
|
(handle (ebox-region-resolve buffer "scroll"))
|
|
(region-id
|
|
(plist-get
|
|
(car (ebox-selector-query-buffer buffer "#scroll"))
|
|
:region-id))
|
|
(ebox-incremental-before-runtime-mutation-hook
|
|
(list
|
|
(lambda (target kind)
|
|
(when (and (eq target buffer) (eq kind 'scroll))
|
|
(let ((ebox-incremental--runtime-mutation-hooks-inhibited-p
|
|
t))
|
|
(ebox-region-update handle :color "#2563EB")))))))
|
|
(should-error (ebox--scroll-region-by region-id 1 1))
|
|
(should (= (tp-surface-revision surface) (1+ revision)))
|
|
(should (= (plist-get (ebox-scroll-state region-id) :scroll-offset)
|
|
0))
|
|
(should (equal
|
|
(ebox-get
|
|
(ebox--root-region-box
|
|
(plist-get (tp-surface-client-state surface) :root-node)
|
|
region-id)
|
|
:color)
|
|
"#2563EB"))))
|
|
(when (buffer-live-p buffer)
|
|
(kill-buffer buffer)))))
|
|
|
|
(provide 'ebox-surface-tests)
|
|
|
|
;;; ebox-surface-tests.el ends here
|