geekinney/etaf
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity
f69f6889ff
etaf/tests/etaf-tests.el

4818 lines
218 KiB
EmacsLisp
Raw Blame History

;;; etaf-tests.el --- ETAF contract tests -*- lexical-binding: t; -*-
;; SPDX-License-Identifier: GPL-3.0-or-later
;;; Code:
(require 'ert)
(require 'subr-x)
(require 'etaf)
(defvar etaf-test-state-cell nil)
(defvar etaf-test-setup-count 0)
(defvar etaf-test-mounted-count 0)
(defvar etaf-test-unmounted-count 0)
(defvar etaf-test-theme-cell nil)
(defvar etaf-test-event-count 0)
(defvar etaf-test-behavior-cleanups 0)
(defvar etaf-test-behavior-installs 0)
(defvar etaf-test-behavior-runtime nil)
(defvar etaf-test-prop-cell nil)
(defvar etaf-test-updated-count 0)
(defvar etaf-test-lifecycle-failure-p nil)
(defvar etaf-test-branch-page-cell nil)
(defvar etaf-test-branch-late-cell nil)
(defvar etaf-test-branch-mode-cell nil)
(defvar etaf-test-event-batch-source nil)
(defvar etaf-test-event-resource-fail nil)
(defvar etaf-test-retained-render-counts nil)
(defvar etaf-test-next-turn-target nil)
(defvar etaf-test-next-turn-source nil)
(defvar etaf-test-next-turn-sink nil)
(defvar etaf-test-input-render-count 0)
(defvar etaf-test-priority-render-source nil)
(defvar etaf-test-priority-render-count 0)
(defvar etaf-test-local-style-source nil)
(defvar etaf-test-lazy-computed-base nil)
(defvar etaf-test-lazy-computed-value nil)
(defvar etaf-test-wide-parent-source nil)
(defvar etaf-test-wide-parent-cells nil)
(defvar etaf-test-range-source nil)
(defvar etaf-test-range-static-count 10)
(defvar etaf-test-range-evals 0)
(defvar etaf-test-range-component-renders 0)
(defvar etaf-test-range-left-evals 0)
(defvar etaf-test-range-right-evals 0)
(defvar etaf-test-range-host-prop-calls 0)
(defvar etaf-test-unsupported-range-source nil)
(defvar etaf-test-string-range-source nil)
(defvar etaf-test-nested-range-present nil)
(defvar etaf-test-nested-range-source nil)
(defvar etaf-test-nested-range-evals 0)
(defvar etaf-test-inline-a nil)
(defvar etaf-test-inline-b nil)
(defvar etaf-test-inline-a-evals 0)
(defvar etaf-test-inline-b-evals 0)
(defvar etaf-test-inline-component-renders 0)
(defvar etaf-test-inline-updated-count 0)
(defvar etaf-test-inline-shared nil)
(defvar etaf-test-inline-shared-evals 0)
(defvar etaf-test-inline-branch-mode nil)
(defvar etaf-test-inline-branch-left nil)
(defvar etaf-test-inline-branch-right nil)
(defvar etaf-test-inline-branch-evals 0)
(defvar etaf-test-inline-branch-updated 0)
(defvar etaf-test-inline-priority-source nil)
(defvar etaf-test-inline-priority-evals 0)
(defvar etaf-test-inline-priority-renders 0)
(defvar etaf-test-inline-priority-updated 0)
(defvar etaf-test-inline-styled-source nil)
(defvar etaf-test-inline-styled-evals 0)
(defvar etaf-test-inline-host-prop-calls 0)
(defvar etaf-test-slot-parent-renders 0)
(defvar etaf-test-slot-forwarder-renders 0)
(defvar etaf-test-slot-consumer-renders 0)
(defvar etaf-test-slot-source nil)
(defvar etaf-test-slot-range-evals 0)
(defvar etaf-test-fragment-range-evals 0)
(defvar etaf-test-fragment-owner-renders 0)
(defvar etaf-test-fragment-source nil)
(defvar etaf-test-raw-source nil)
(defvar etaf-test-raw-key-source nil)
(defvar etaf-test-raw-evals 0)
(defvar etaf-test-raw-owner-renders 0)
(defvar etaf-test-transparent-source nil)
(defvar etaf-test-transparent-renders 0)
(defvar etaf-test-transparent-parent-renders 0)
(defvar etaf-test-transparent-inner-renders 0)
(defvar etaf-test-transparent-outer-renders 0)
(defvar etaf-test-ancestor-parent-source nil)
(defvar etaf-test-ancestor-child-source nil)
(defvar etaf-test-context-provider-source nil)
(defvar etaf-test-context-provider-renders 0)
(defvar etaf-test-context-consumer-renders 0)
(defvar etaf-test-context-range-evals 0)
(defvar etaf-test-slot-author-updated 0)
(defvar etaf-test-slot-consumer-updated 0)
(defvar etaf-test-slot-branch-left nil)
(defvar etaf-test-slot-branch-right nil)
(defvar etaf-test-detached-list-source nil)
(defvar etaf-test-detached-theme-source nil)
(defvar etaf-test-detached-row-renders 0)
(defun etaf-test--range-items ()
"Return keyed text Views from `etaf-test-range-source'."
(cl-incf etaf-test-range-evals)
(mapcar (lambda (entry)
(etaf--view-call 'text
(list :key (car entry) :class "slot-item")
(list (cdr entry))))
(etaf-value etaf-test-range-source)))
(defun etaf-test--prefixed-range-items (prefix)
"Return current Range items with key and content PREFIX."
(mapcar (lambda (entry)
(let ((key (intern (format "%s-%s" prefix (car entry)))))
(etaf--view-call 'text (list :key key :ref key)
(list (format "%s%s" prefix (cdr entry))))))
(etaf-value etaf-test-range-source)))
(defun etaf-test--unsupported-range-value ()
"Return a Host, Component, or raw value for direct Range rejection tests."
(pcase (etaf-value etaf-test-unsupported-range-source)
('component
(etaf--view-call 'etaf-test-badge (list :label "component") nil))
('raw (etaf--raw-ebox-create
:thunk (lambda () (ebox-create :content "raw"))))
('deep-component
(etaf--view-call
'column (list :key 'outer)
(list (etaf--component-call-create
:spec etaf-test-badge--etaf-component-definition
:props (list :label "deep") :slots nil))))
('deep-raw
(etaf--view-call
'column (list :key 'outer)
(list (etaf--raw-ebox-create
:thunk (lambda () (ebox-create :content "deep-raw"))))))
('deep-expr-component
(etaf--view-call
'column (list :key 'outer)
(list (etaf--expr-create
:token 'etaf-test-deep-unsupported-site
:thunk
(lambda ()
(etaf--component-call-create
:spec etaf-test-badge--etaf-component-definition
:props (list :label "deep-expr") :slots nil))))))
(_ (etaf--view-call 'text (list :key 'safe) (list "safe")))))
(defun etaf-test--nested-range-children ()
"Return keyed nested Hosts from the nested Range source."
(let ((state (etaf-value etaf-test-nested-range-source)))
(append
(and (cdr state)
(list (etaf--view-call 'text (list :key 'sibling)
(list "sibling"))))
(list (etaf--view-call 'text (list :key 'nested)
(list (car state)))))))
(defun etaf-test--nested-range-value ()
"Return one nested Host item or nil for recursive identity tests."
(cl-incf etaf-test-nested-range-evals)
(when (etaf-value etaf-test-nested-range-present)
(etaf--view-call
'column (list :key 'item)
(list (etaf--expr-create
:token 'etaf-test-nested-inner-site
:thunk #'etaf-test--nested-range-children)))))
(defun etaf-test--slot-range-items ()
"Return keyed Host items from the current slot source."
(cl-incf etaf-test-slot-range-evals)
(mapcar (lambda (entry)
(etaf--view-call 'text
(list :key (car entry) :class "slot-item")
(list (cdr entry))))
(etaf-value etaf-test-slot-source)))
(defun etaf-test--fragment-range-items ()
"Return keyed Host items from the current fragment source."
(cl-incf etaf-test-fragment-range-evals)
(mapcar (lambda (entry)
(etaf--view-call 'text (list :key (car entry))
(list (cdr entry))))
(etaf-value etaf-test-fragment-source)))
(defun etaf-test--retained-leaf-value (label cell)
"Record LABEL render and return CELL's current text."
(puthash label (1+ (gethash label etaf-test-retained-render-counts 0))
etaf-test-retained-render-counts)
(format "%s=%s" label (etaf-value cell)))
(etaf-define-component etaf-test-retained-leaf (&key label cell)
"Render one independently reactive retained leaf."
:view
(text (expr :value (etaf-test--retained-leaf-value label cell))))
(etaf-define-component etaf-test-setup-read-owner
(&key setup-source render-source)
"Read SETUP-SOURCE only during setup and render RENDER-SOURCE."
:setup
(progn
(etaf-value setup-source)
(lambda ()
(etaf-view (text (expr :value (etaf-value render-source)))))))
(etaf-define-component etaf-test-dependency-only (&key source)
"Track SOURCE while returning semantically equal output."
:view
(text (expr :value (progn (etaf-value source) "same"))))
(etaf-define-component etaf-test-input-equal (&key label)
"Count renders of a caller-owned semantic input."
:view
(text (expr :value
(progn (cl-incf etaf-test-input-render-count) label))))
(etaf-define-component etaf-test-target-priority (&key label)
"Render LABEL with an independently dirty render dependency."
:view
(text (expr :value
(progn
(cl-incf etaf-test-priority-render-count)
(format "%s/%s" label
(etaf-value etaf-test-priority-render-source))))))
(etaf-define-component etaf-test-local-style-parent ()
"Project a locally reactive caller-owned slot through a styled child."
:styles
(styles (".live" :color "retained-color"))
:view
(etaf-test-styled-slot-child
(text :class "live"
(expr :value (etaf-value etaf-test-local-style-source)))))
(etaf-define-component etaf-test-lazy-computed-owner ()
"Create a lazy computed first evaluated by the render target."
:setup
(let* ((base (etaf-ref 1))
(computed (etaf-computed (lambda () (* 2 (etaf-value base))))))
(setq etaf-test-lazy-computed-base base
etaf-test-lazy-computed-value computed)
(lambda ()
(etaf-view (text (expr :value (number-to-string
(etaf-value computed))))))))
(etaf-define-component etaf-test-wide-parent ()
"Render a wide stable child list around one parent-owned value."
:setup
(lambda ()
(etaf--view-call
'column nil
(cons
(etaf--view-call
'text nil (list (format "parent=%s"
(etaf-value etaf-test-wide-parent-source))))
(cl-loop for cell in etaf-test-wide-parent-cells for index from 0
collect
(etaf--view-call 'etaf-test-retained-leaf
(list :key index :label index :cell cell)
nil))))))
(etaf-define-component etaf-test-direct-range ()
"Render static siblings and one direct retained material-child Range."
:setup
(let ((range (etaf--expr-create
:token 'etaf-test-direct-range-site
:thunk #'etaf-test--range-items))
(color (etaf--expr-create
:token 'etaf-test-range-color-site
:thunk (lambda ()
(cl-incf etaf-test-range-host-prop-calls)
"red"))))
(lambda ()
(cl-incf etaf-test-range-component-renders)
(etaf--view-node-create
:name 'column :props nil
:children
(append
(cl-loop for index below etaf-test-range-static-count
collect (etaf--view-call
'text (append
(list :key (intern (format "static-%s" index)))
(and (zerop index) (list :color color)))
(list (format "S%s" index))))
(list range))))))
(etaf-define-component etaf-test-two-direct-ranges ()
"Render two disjoint direct material Ranges from one source."
:setup
(let ((left (etaf--expr-create
:token 'etaf-test-left-range-site
:thunk (lambda ()
(cl-incf etaf-test-range-left-evals)
(etaf-test--prefixed-range-items "L"))))
(right (etaf--expr-create
:token 'etaf-test-right-range-site
:thunk (lambda ()
(cl-incf etaf-test-range-right-evals)
(etaf-test--prefixed-range-items "R")))))
(lambda ()
(etaf--view-node-create :name 'column :props nil
:children
(list (etaf--view-call 'text
(list :key 'static)
(list "S"))
left right)))))
(etaf-define-component etaf-test-macro-range-token ()
"Expose one macro-compiled direct expr callsite."
:view
(column (expr :value nil)))
(etaf-define-component etaf-test-public-direct-range ()
"Exercise a public macro-compiled direct material-child expr."
:view
(column
(text :key 'public-static "S")
(expr :value (etaf-test--range-items))))
(etaf-define-component etaf-test-counted-direct-range (&key count)
"Render COUNT static siblings before one stable direct Range callsite."
:setup
(let ((range (etaf--expr-create
:token 'etaf-test-counted-range-site
:thunk #'etaf-test--range-items)))
(lambda ()
(cl-incf etaf-test-range-component-renders)
(etaf--view-node-create
:name 'column :props nil
:children
(append
(cl-loop for index below count
collect (etaf--view-call
'text (list :key (intern (format "counted-%s" index)))
(list (format "C%s" index))))
(list range))))))
(etaf-define-component etaf-test-string-sibling-range ()
"Render bare string siblings around one direct Range."
:setup
(let ((range (etaf--expr-create
:token 'etaf-test-string-sibling-range-site
:thunk #'etaf-test--range-items)))
(lambda ()
(etaf--view-node-create :name 'column :props nil
:children (list "prefix" range "suffix")))))
(etaf-define-component etaf-test-unsupported-direct-range ()
"Start with a Host Range whose later unsupported output must fail."
:setup
(let ((range (etaf--expr-create
:token 'etaf-test-unsupported-range-site
:thunk #'etaf-test--unsupported-range-value)))
(lambda ()
(etaf--view-node-create
:name 'column :props nil
:children (list (etaf--view-call 'text (list :key 'static) (list "S"))
range)))))
(etaf-define-component etaf-test-public-string-range ()
"Render one public direct expr whose Range item is a bare string."
:view
(column
(text :key 'static "S")
(expr :value (etaf-value etaf-test-string-range-source))))
(etaf-define-component etaf-test-nested-host-range ()
"Render one Range whose keyed item owns keyed nested Hosts."
:setup
(let ((range (etaf--expr-create
:token 'etaf-test-nested-range-site
:thunk #'etaf-test--nested-range-value)))
(lambda ()
(etaf--view-node-create
:name 'column :props nil
:children (list (etaf--view-call 'text (list :key 'static) (list "S"))
range)))))
(etaf-define-component etaf-test-inline-owner ()
"Render two independently reactive inline expression sites."
:setup
(progn
(etaf-on-updated (lambda () (cl-incf etaf-test-inline-updated-count)))
(lambda ()
(cl-incf etaf-test-inline-component-renders)
(etaf-view
(text "A"
(expr :value
(progn (cl-incf etaf-test-inline-a-evals)
(etaf-value etaf-test-inline-a)))
"B"
(expr :value
(progn (cl-incf etaf-test-inline-b-evals)
(etaf-value etaf-test-inline-b))))))))
(etaf-define-component etaf-test-inline-shared-hosts ()
"Render one shared source in two distinct text Hosts."
:view
(column
(text :key 'left
(expr :value
(progn (cl-incf etaf-test-inline-shared-evals)
(etaf-value etaf-test-inline-shared))))
(text :key 'right
(expr :value
(progn (cl-incf etaf-test-inline-shared-evals)
(etaf-value etaf-test-inline-shared))))))
(etaf-define-component etaf-test-inline-dependency-branch ()
"Return equal inline output while switching its source dependency."
:setup
(progn
(etaf-on-updated (lambda () (cl-incf etaf-test-inline-branch-updated)))
(lambda ()
(etaf-view
(text
(expr :value
(progn
(cl-incf etaf-test-inline-branch-evals)
(if (etaf-value etaf-test-inline-branch-mode)
(etaf-value etaf-test-inline-branch-right)
(etaf-value etaf-test-inline-branch-left))
"same")))))))
(etaf-define-component etaf-test-slot-env-child ()
"Project the caller-owned default slot."
:setup
(lambda ()
(cl-incf etaf-test-slot-consumer-renders)
(etaf-view (column (slot)))))
(etaf-define-component etaf-test-slot-env-parent (&key label)
"Author an inline slot expression from parent LABEL."
:setup
(lambda ()
(cl-incf etaf-test-slot-parent-renders)
(etaf-view
(etaf-test-slot-env-child
(text (expr :value label))))))
(etaf-define-component etaf-test-slot-env-consumer ()
"Project a forwarded named header slot."
:setup
(lambda ()
(cl-incf etaf-test-slot-consumer-renders)
(etaf-view (column (slot :name 'header)))))
(etaf-define-component etaf-test-slot-env-forwarder ()
"Forward the caller-owned named header slot."
:setup
(lambda ()
(cl-incf etaf-test-slot-forwarder-renders)
(etaf--component-call-create
:spec etaf-test-slot-env-consumer--etaf-component-definition
:props nil
:slots (list (assq 'header etaf--current-component-slots)))))
(etaf-define-component etaf-test-slot-env-named-parent (&key label)
"Author a named slot expression from parent LABEL."
:setup
(lambda ()
(cl-incf etaf-test-slot-parent-renders)
(etaf-view
(etaf-test-slot-env-forwarder
(slot :name 'header
(text (expr :value label)))))))
(etaf-define-component etaf-test-slot-range-parent ()
"Author one reactive default slot Range."
:setup
(progn
(etaf-on-updated (lambda () (cl-incf etaf-test-slot-author-updated)))
(lambda ()
(cl-incf etaf-test-slot-parent-renders)
(etaf-view
(etaf-test-slot-env-child
(expr :value (etaf-test--slot-range-items)))))))
(etaf-define-component etaf-test-slot-range-named-parent ()
"Author one reactive named slot through the Forwarder."
:setup
(progn
(etaf-on-updated (lambda () (cl-incf etaf-test-slot-author-updated)))
(lambda ()
(cl-incf etaf-test-slot-parent-renders)
(etaf-view
(etaf-test-slot-env-forwarder
(slot :name 'header
(expr :value (etaf-test--slot-range-items))))))))
(etaf-define-component etaf-test-slot-range-fallback ()
"Own one reactive fallback slot Range."
:styles (styles (".slot-item" :color "fallback-color"))
:setup
(progn
(etaf-on-updated (lambda () (cl-incf etaf-test-slot-consumer-updated)))
(lambda ()
(cl-incf etaf-test-slot-consumer-renders)
(etaf-view
(column
(slot (expr :value (etaf-test--slot-range-items))))))))
(etaf-define-component etaf-test-slot-range-two-sites ()
"Project the same default slot at two material sites."
:view
(column
(column :key 'left-site (slot))
(column :key 'right-site (slot))))
(etaf-define-component etaf-test-slot-range-two-site-parent ()
"Author one reactive slot consumed at two projection sites."
:view
(etaf-test-slot-range-two-sites
(expr :value (etaf-test--slot-range-items))))
(etaf-define-component etaf-test-slot-range-branch-parent (&key mode)
"Retarget slot dependencies from MODE while preserving equal output."
:setup
(lambda ()
(cl-incf etaf-test-slot-parent-renders)
(etaf-view
(etaf-test-slot-env-child
(expr :value
(progn
(if mode
(etaf-value etaf-test-slot-branch-right)
(etaf-value etaf-test-slot-branch-left))
(list (etaf-view (text :key 'same "same")))))))))
(etaf-define-component etaf-test-fragment-range-owner ()
"Own one material fragment Range."
:setup
(lambda ()
(cl-incf etaf-test-fragment-owner-renders)
(etaf-view
(column
(fragment
(expr :value (etaf-test--fragment-range-items)))))))
(etaf-define-component etaf-test-raw-range-owner ()
"Own one material raw Ebox Range."
:setup
(lambda ()
(cl-incf etaf-test-raw-owner-renders)
(etaf-view
(column
(raw-ebox
:value (progn
(cl-incf etaf-test-raw-evals)
(ebox-create :content (etaf-value etaf-test-raw-source)))
:key (etaf-value etaf-test-raw-key-source))))))
(etaf-define-component etaf-test-transparent-owner ()
"Render a transparent fragment sequence."
:setup
(lambda ()
(cl-incf etaf-test-transparent-renders)
(etaf-view
(fragment
(expr :value
(mapcar (lambda (entry)
(etaf--view-call 'text (list :key (car entry))
(list (cdr entry))))
(etaf-value etaf-test-transparent-source)))))))
(etaf-define-component etaf-test-transparent-parent ()
"Own one transparent child beside static material Hosts."
:setup
(lambda ()
(cl-incf etaf-test-transparent-parent-renders)
(etaf-view
(column
(text :key 'before "before")
(etaf-test-transparent-owner)
(text :key 'after "after")))))
(etaf-define-component etaf-test-transparent-inner ()
"Render the inner transparent chain payload."
:setup
(lambda ()
(cl-incf etaf-test-transparent-inner-renders)
(etaf-view
(fragment
(expr :value
(mapcar (lambda (entry)
(etaf--view-call 'text (list :key (car entry))
(list (cdr entry))))
(etaf-value etaf-test-transparent-source)))))))
(etaf-define-component etaf-test-transparent-outer ()
"Forward one transparent Component without a visual adapter."
:setup
(lambda ()
(cl-incf etaf-test-transparent-outer-renders)
(etaf-view (fragment (etaf-test-transparent-inner)))))
(etaf-define-component etaf-test-transparent-chain-parent ()
"Place a transparent Component chain in one material parent."
:view (column (etaf-test-transparent-outer)))
(etaf-define-component etaf-test-ancestor-artifact-child ()
"Render a child whose local update invalidates ancestor artifacts."
:view
(text (expr :value
(if (etaf-value etaf-test-ancestor-child-source)
"detail" "child"))))
(etaf-define-component etaf-test-ancestor-artifact-parent ()
"Render a parent that can update after one descendant-only publication."
:view
(column :bgcolor (etaf-value etaf-test-ancestor-parent-source)
(etaf-test-ancestor-artifact-child)))
(etaf-define-component etaf-test-generation-context-consumer ()
"Render one generation-owned Context dependency."
:setup
(lambda ()
(cl-incf etaf-test-context-consumer-renders)
(etaf-view (text :color (etaf-inject 'generation-label) "context"))))
(etaf-define-component etaf-test-generation-context-provider ()
"Provide a candidate Context value to one retained consumer."
:setup
(lambda ()
(cl-incf etaf-test-context-provider-renders)
(etaf-provide 'generation-label
(etaf-value etaf-test-context-provider-source))
(etaf-view (etaf-test-generation-context-consumer))))
(etaf-define-component etaf-test-generation-context-range-provider ()
"Provide Context directly to a retained child Range effect."
:setup
(lambda ()
(etaf-provide 'generation-label
(etaf-value etaf-test-context-provider-source))
(etaf-view
(column
(expr :value
(progn
(cl-incf etaf-test-context-range-evals)
(list (etaf--view-call
'text (list :key 'context-range)
(list (etaf-inject 'generation-label))))))))))
(etaf-define-component etaf-test-generation-context-slot-consumer ()
"Project one material slot Range for Context ownership tests."
:setup
(lambda ()
(cl-incf etaf-test-slot-consumer-renders)
(etaf-view (column (slot)))))
(etaf-define-component etaf-test-generation-context-slot-provider ()
"Provide Context to an authored slot Range expression."
:setup
(lambda ()
(cl-incf etaf-test-context-provider-renders)
(etaf-provide 'generation-label
(etaf-value etaf-test-context-provider-source))
(etaf-view
(etaf-test-generation-context-slot-consumer
(expr :value
(progn
(cl-incf etaf-test-slot-range-evals)
(list (etaf--view-call
'text (list :key 'context-slot)
(list (etaf-inject 'generation-label))))))))))
(etaf-define-component etaf-test-prop-env-child (&key value)
"Render VALUE received from a parent Component."
:view (text (expr :value value)))
(etaf-define-component etaf-test-prop-env-parent (&key label)
"Forward dynamic parent LABEL into a nested Component prop."
:view (etaf-test-prop-env-child :value label))
(etaf-define-component etaf-test-inline-input-priority (&key label)
"Render candidate LABEL with one independently dirty inline source."
:setup
(progn
(etaf-on-updated (lambda () (cl-incf etaf-test-inline-priority-updated)))
(lambda ()
(cl-incf etaf-test-inline-priority-renders)
(etaf-view
(text
(expr :value
(progn
(cl-incf etaf-test-inline-priority-evals)
(format "%s/%s" label
(etaf-value etaf-test-inline-priority-source)))))))))
(etaf-define-component etaf-test-inline-styled-owner ()
"Render a styled inline expression beside a side-effecting Host prop."
:view
(text :color (progn (cl-incf etaf-test-inline-host-prop-calls) "red")
"P"
(expr :value
(progn
(cl-incf etaf-test-inline-styled-evals)
(etaf-view
(text :face 'bold
(expr :value
(etaf-value etaf-test-inline-styled-source))))))))
(etaf-define-component etaf-test-range-input-priority (&key marker)
"Render fixed Range structure whose item reads MARKER and a reactive source."
:setup
(let ((range
(etaf--expr-create
:token 'etaf-test-range-input-priority-site
:thunk
(lambda ()
(cl-incf etaf-test-range-evals)
(list
(etaf--view-call
'text (list :key 'item :ref 'item)
(list (format "%s/%s" marker
(etaf-value etaf-test-range-source)))))))))
(lambda ()
(cl-incf etaf-test-range-component-renders)
(etaf--view-node-create
:name 'column :props nil
:children (list (etaf--view-call 'text (list :key 'static) (list "S"))
range)))))
(etaf-define-component etaf-test-next-turn ()
"Write TARGET after publishing a SOURCE update."
:setup
(let ((source-cell etaf-test-next-turn-source)
(target-cell etaf-test-next-turn-sink))
(etaf-on-updated
(lambda ()
(when (and etaf-test-next-turn-target
(zerop (etaf-value target-cell)))
(setf (etaf-value target-cell) 1))))
(lambda ()
(etaf-view
(text (expr :value
(format "%s/%s" (etaf-value source-cell)
(etaf-value target-cell))))))))
(defun etaf-test--render-text (view)
"Return plain rendered text for VIEW."
(replace-regexp-in-string
"[[:space:]]+$" ""
(substring-no-properties (ebox-render (etaf-render view)))
nil t))
(defun etaf-test--buffer-text (buffer-name)
"Return normalized plain text from mounted BUFFER-NAME."
(with-current-buffer buffer-name
(string-trim
(replace-regexp-in-string
"[[:space:]]+" " " (substring-no-properties (buffer-string))))))
(etaf-define-component etaf-test-badge (&key label)
"Render LABEL as a small semantic test Component."
:view
(text :face 'bold (expr :value label)))
(etaf-define-component etaf-list (&key label)
"Render LABEL using the collision-safe `list-view' alias."
:view
(text (expr :value label)))
(etaf-define-component etaf-test-slot-card (&key title)
"Render a title with default and named slot projections."
:view
(column
(text (expr :value title))
(slot :name 'header (text :face 'shadow "Default header"))
(slot (text :face 'shadow "Default body"))))
(etaf-define-component etaf-test-named-slot-consumer ()
"Render the named header slot for forwarding tests."
:view
(slot :name 'header))
(etaf-define-component etaf-test-named-slot-forwarder ()
"Forward a named slot through a nested Component call."
:view
(etaf-test-named-slot-consumer
(slot :name 'header (text "Forwarded"))))
(etaf-define-component etaf-test-styled-card ()
"Render style and Theme precedence fixtures."
:styles
(styles
("&" :color "style-root")
(".title" :color "style-title" :bgcolor "title-bg"))
:view
(column
(text :class "title" :color "inline-title" "Title")
(text "Body")))
(etaf-define-component etaf-test-nil-style-host ()
"Allow a Component style to fill an explicit nil Host property."
:styles
(styles
(".fill" :color "style-color"))
:view
(text :class "fill" :color nil "Nil"))
(etaf-define-component etaf-test-style-rule-order (&key color)
"Allow a later matching Component rule to refine an earlier rule."
:styles
(styles
("&" :color "base-color")
("&.accent" :color "accent-color"))
:view
(text :class "accent" :color color "Accent"))
(etaf-define-component etaf-test-styled-child ()
"Render a child Host for nested style scope tests."
:view
(text :class "nested-child" "Nested"))
(etaf-define-component etaf-test-styled-parent ()
"Apply a style rule through a nested Component boundary."
:styles
(styles
(".nested-child" :color "parent-color"))
:view
(etaf-test-styled-child))
(etaf-define-component etaf-test-styled-slot-child ()
"Project caller-owned slot content without adding a style scope."
:view
(slot))
(etaf-define-component etaf-test-styled-slot-parent ()
"Style caller-owned slot content while containing child internals."
:styles
(styles
(".slot-content" :color "parent-color"))
:view
(etaf-test-styled-slot-child
(text :class "slot-content" "Slot")))
(etaf-define-component etaf-test-styled-fallback-child ()
"Style fallback content authored by the child Component."
:styles
(styles
(".fallback-content" :color "child-color"))
:view
(slot
(text :class "fallback-content" "Fallback")))
(etaf-define-component etaf-test-themed-text ()
"Provide Theme defaults to one text Host."
:setup
(progn
(etaf-theme-provide '(:color "theme-color" :bgcolor "theme-bg"))
(lambda () (etaf-view (text :color nil "Themed")))))
(etaf-define-component etaf-test-themed-style-token ()
"Resolve a deferred Theme token from a static Component style."
:styles
(styles ("&" :color (etaf-theme-token :color)))
:setup
(progn
(etaf-theme-provide '(:color "token-color"))
(lambda () (etaf-view (text "Token")))))
(etaf-define-component etaf-test-stateful (&key label)
"Render a retained counter for Runtime tests."
:setup
(let ((cell (etaf-ref 0)))
(setq etaf-test-state-cell cell)
(cl-incf etaf-test-setup-count)
(etaf-on-mounted (lambda () (cl-incf etaf-test-mounted-count)))
(etaf-on-updated (lambda () (cl-incf etaf-test-updated-count)))
(etaf-on-unmounted (lambda () (cl-incf etaf-test-unmounted-count)))
(lambda ()
(etaf-view
(text
(expr :value (format "%s:%d" label (etaf-value cell))))))))
(etaf-define-component etaf-test-provider ()
"Provide a reactive theme to descendants."
:setup
(let ((theme (etaf-ref 'dark)))
(setq etaf-test-theme-cell theme)
(etaf-provide 'theme theme)
(lambda ()
(etaf-view (column (slot))))))
(etaf-define-component etaf-test-consumer ()
"Render the nearest Context theme."
:setup
(let ((theme (etaf-inject 'theme nil t)))
(lambda ()
(etaf-view (text (expr :value (symbol-name (etaf-value theme))))))))
(etaf-define-component etaf-test-prop-stateful (&key label)
"Render a retained label whose prop can change without rerunning setup."
:setup
(progn
(cl-incf etaf-test-setup-count)
(lambda ()
(etaf-view (text (expr :value label))))))
(etaf-define-component etaf-test-lifecycle-failure (&key label)
"Render LABEL and deliberately fail from an update lifecycle hook."
:setup
(progn
(etaf-on-updated
(lambda ()
(when etaf-test-lifecycle-failure-p
(error "test lifecycle failed"))))
(lambda ()
(etaf-view (text (expr :value label))))))
(etaf-define-component etaf-test-rollback (&key fail)
"Render a candidate that can deliberately fail during reconciliation."
:setup
(let ((cell (etaf-ref 0)))
(setq etaf-test-prop-cell cell)
(lambda ()
(when fail
(signal 'etaf-runtime-error (list "test candidate failed")))
(etaf-view
(text
(expr :value (format "stable:%d" (etaf-value cell))))))))
(etaf-define-component etaf-test-late-branch ()
"Read a late reactive ref only after switching render branches."
:setup
(let ((page (etaf-ref "page"))
(late (etaf-ref "late"))
(late-branch (etaf-ref nil)))
(setq etaf-test-branch-page-cell page
etaf-test-branch-late-cell late
etaf-test-branch-mode-cell late-branch)
(lambda ()
(etaf-view
(text
(expr :value
(if (etaf-value late-branch)
(etaf-value late)
(etaf-value page))))))))
(etaf-define-component etaf-test-event-batch-stateful ()
"Render a callback with computed, watch, and effect dependents."
:setup
(let* ((source (etaf-ref 0))
(computed (etaf-computed
(lambda () (* 2 (etaf-value source)))))
(watch-value (etaf-ref "watch:0"))
(effect-value (etaf-ref "effect:0"))
(last-effect "effect:0"))
(setq etaf-test-event-batch-source source)
(etaf-watch
source
(lambda (new _old)
(setf (etaf-value watch-value) (format "watch:%d" new)))
:immediate nil)
(etaf-watch-effect
(lambda ()
(let ((next (format "effect:%d" (etaf-value computed))))
(unless (equal next last-effect)
(setq last-effect next)
(setf (etaf-value effect-value) next)))))
(lambda ()
(etaf-view
(column
(text :ref 'event-batch-trigger
:on-press (lambda () (setf (etaf-value source) 2))
"Update")
(text
(expr :value
(format "source=%d computed=%d %s %s"
(etaf-value source)
(etaf-value computed)
(etaf-value watch-value)
(etaf-value effect-value)))))))))
(etaf-define-component etaf-test-event-batch-noop ()
"Render an event callback that performs no state write."
:view
(text :ref 'event-batch-noop
:on-press (lambda () nil)
"No-op"))
(etaf-define-component etaf-test-event-batch-nested ()
"Render an outer callback that dispatches one nested public event."
:setup
(let ((state (etaf-ref "idle")))
(lambda ()
(etaf-view
(column
(text :ref 'event-batch-nested-outer
:on-press
(lambda ()
(etaf-dispatch-event
(etaf-current-runtime)
'event-batch-nested-inner 'press))
"Outer")
(text :ref 'event-batch-nested-inner
:on-press (lambda () (setf (etaf-value state) "nested"))
"Inner")
(text (expr :value (etaf-value state))))))))
(etaf-define-component etaf-test-event-batch-behavior ()
"Render a toggleable Behavior whose callback writes two refs."
:setup
(let ((left (etaf-ref nil))
(right (etaf-ref nil)))
(lambda ()
(etaf-view
(column
(text :ref 'event-batch-behavior
:use
(list
(etaf-toggleable
:value left
:on-change
(lambda (value)
(setf (etaf-value left) value
(etaf-value right) value))))
"Toggle")
(text
(expr :value
(format "left=%s right=%s"
(if (etaf-value left) "on" "off")
(if (etaf-value right) "on" "off")))))))))
(etaf-define-component etaf-test-event-batch-theme ()
"Render a computed Theme changed by a public event callback."
:setup
(let* ((dark (etaf-ref nil))
(theme (etaf-computed
(lambda ()
(if (etaf-value dark)
'(:color "dark")
'(:color "light"))))))
(etaf-theme-provide theme)
(lambda ()
(etaf-view
(column
(text :ref 'event-batch-theme-toggle
:on-press
(lambda ()
(setf (etaf-value dark) (not (etaf-value dark))))
"Theme")
(text (expr :value
(format "theme=%s" (etaf-theme-value :color)))))))))
(defvar etaf-test-theme-property-render-count 0)
(defvar etaf-test-theme-property-cell nil)
(defun etaf-test--face-value (face property)
"Return PROPERTY from anonymous FACE contributions."
(cond
((symbolp face)
(let* ((remap (assq face face-remapping-alist))
(mapped
(cl-some (lambda (spec)
(and (listp spec) (keywordp (car-safe spec))
(plist-get spec property)))
(cdr remap)))
(attribute
(pcase property
(:foreground :foreground)
(:background :background)
(_ property)))
(value (face-attribute face attribute nil nil)))
(or mapped
(unless (memq value '(unspecified unspecified-fg unspecified-bg))
value))))
((and (listp face) (keywordp (car-safe face)))
(plist-get face property))
((listp face)
(cl-some (lambda (entry)
(etaf-test--face-value entry property))
face))))
(etaf-define-component etaf-test-theme-property-effect ()
"Update a Theme-bound Host property without rerunning this Component."
:setup
(let* ((dark (etaf-ref nil))
(theme
(etaf-computed
(lambda ()
(if (etaf-value dark)
'(:color "#EEEEEE" :bgcolor "#111111")
'(:color "#111111" :bgcolor "#FFFFFF"))))))
(setq etaf-test-theme-property-cell dark)
(etaf-theme-provide theme)
(lambda ()
(cl-incf etaf-test-theme-property-render-count)
(etaf-view
(text :ref 'theme-property-toggle
:color (etaf-theme-token :color)
:bgcolor (etaf-theme-token :bgcolor)
:on-press
(lambda ()
(setf (etaf-value dark) (not (etaf-value dark))))
"Theme property")))))
(etaf-define-component etaf-test-theme-atomic-child (&key label on-press)
"Render Theme paint below a Component whose input also changes."
:view
(column :ref 'theme-atomic-panel
:color (etaf-theme-token :color)
:bgcolor (etaf-theme-token :bgcolor)
(text :ref 'theme-atomic-toggle :on-press on-press
(expr :value label))))
(etaf-define-component etaf-test-theme-atomic-owner ()
"Change Component content and descendant Theme properties in one turn."
:setup
(let* ((dark (etaf-ref nil))
(theme
(etaf-computed
(lambda ()
(if (etaf-value dark)
'(:color "#EEEEEE" :bgcolor "#111111")
'(:color "#111111" :bgcolor "#FFFFFF")))))
(toggle (lambda ()
(setf (etaf-value dark) (not (etaf-value dark))))))
(etaf-theme-provide theme)
(lambda ()
(etaf--view-call
'column (list :ref 'theme-atomic-root
:bgcolor (etaf-theme-token :bgcolor))
(list
(etaf--view-call
'etaf-test-theme-atomic-child
(list :label (if (etaf-value dark) "Dark" "Light")
:on-press toggle)
nil))))))
(etaf-define-component etaf-test-detached-theme-row (&key row-ref label)
"Render one keyed Theme-bound row used by detached-subtree tests."
:setup
(lambda ()
(cl-incf etaf-test-detached-row-renders)
(etaf--view-call
'row
(list :ref (etaf-current-prop :row-ref)
:color (etaf-theme-token :color))
(list (etaf--view-call
'text nil (list (etaf-current-prop :label)))))))
(etaf-define-component etaf-test-detached-theme-list ()
"Render keyed Components below stable nested Host containers."
:setup
(progn
(etaf-theme-provide etaf-test-detached-theme-source)
(lambda ()
(etaf--view-call
'column (list :key 'shell)
(list
(etaf--view-call
'column (list :key 'body)
(mapcar
(lambda (entry)
(etaf--view-call
'etaf-test-detached-theme-row
(list :key (car entry) :row-ref (car entry) :label (cdr entry))
nil))
(etaf-value etaf-test-detached-list-source))))))))
(etaf-define-component etaf-test-event-batch-resource (&key resource fail)
"Render synchronous Resource success and error state transitions."
:setup
(let ((instance-resource resource)
(instance-fail fail))
(lambda ()
(etaf-view
(column
(text :ref 'event-batch-resource-success
:on-press
(lambda ()
(setf (etaf-value instance-fail) nil)
(etaf-resource-load instance-resource))
"Load success")
(text :ref 'event-batch-resource-error
:on-press
(lambda ()
(setf (etaf-value instance-fail) t)
(etaf-resource-load instance-resource))
"Load error")
(text
(expr :value
(format "status=%s value=%s error=%s"
(etaf-resource-status instance-resource)
(or (etaf-resource-value instance-resource) "none")
(if (etaf-resource-error instance-resource)
"yes"
"no")))))))))
(etaf-define-behavior etaf-test-cleanup-behavior (&rest attributes)
"Construct a Behavior whose disposal is visible to tests."
(apply #'etaf-behavior-create
'etaf-test-cleanup-behavior
(append attributes
(list :install
(lambda ()
(cl-incf etaf-test-behavior-installs)
(setq etaf-test-behavior-runtime
(etaf-behavior-context-runtime
(etaf-current-behavior-context)))
(lambda () (cl-incf etaf-test-behavior-cleanups)))))))
(etaf-action-define etaf-test-action (runtime)
"Increment the event counter through a named Action."
(ignore runtime)
(cl-incf etaf-test-event-count))
(ert-deftest etaf-view-property-region-precedes-children ()
"Reject a property that appears after a structural child."
(should-error
(macroexpand '(etaf-view (text "Hello" :face 'bold)))
:type 'etaf-view-syntax-error))
(ert-deftest etaf-view-ordinary-control-flow-belongs-in-expr ()
"Reject ordinary Elisp control flow in the child region."
(should-error
(macroexpand '(etaf-view (text (if checked "yes" "no"))))
:type 'etaf-view-syntax-error))
(ert-deftest etaf-view-quote-is-not-needed-for-structure ()
"Construct an unquoted structural View and preserve quoted data values."
(let ((view (etaf-view (text :face 'bold "Hello"))))
(should (etaf--view-node-p view))
(should (equal 'bold (plist-get (etaf--view-node-props view) :face)))
(should (equal "Hello" (etaf-test--render-text view)))))
(ert-deftest etaf-view-attribute-values-are-ordinary-elisp ()
"Evaluate an attribute expression without an extra evaluation wrapper."
(let ((face 'bold)
(label "Ready"))
(let ((view (etaf-view (text :face face (expr :value label)))))
(should (equal "Ready" (etaf-test--render-text view))))))
(ert-deftest etaf-view-expr-evaluates-control-flow ()
"Use the sole child computation bridge for ordinary control flow."
(let ((checked t))
(should
(equal "yes"
(etaf-test--render-text
(etaf-view
(text (expr :value (if checked "yes" "no")))))))))
(ert-deftest etaf-view-expr-can-return-a-view ()
"Allow an expression to return a dynamically constructed View."
(let ((open t))
(should
(equal "Details"
(etaf-test--render-text
(etaf-view
(column
(expr
:value
(when open
(etaf-view (text "Details")))))))))))
(ert-deftest etaf-view-expr-can-return-a-sequence ()
"Flatten a sequence returned by `expr' into the surrounding Host."
(should
(equal "AB"
(etaf-test--render-text
(etaf-view
(text (expr :value (list "A" "B"))))))))
(ert-deftest etaf-view-expr-rejects-extra-properties ()
"Reject an expr property other than `:value'."
(should-error
(macroexpand '(etaf-view (text (expr :test checked :value "yes"))))
:type 'etaf-view-syntax-error))
(ert-deftest etaf-view-quoted-view-data-is-not-executed ()
"Reject quoted View data when it reaches the executable child boundary."
(should-error
(macroexpand '(etaf-view (text (quote (text "not-a-view")))))
:type 'etaf-view-syntax-error))
(ert-deftest etaf-view-layouts-lower-to-ebox ()
"Lower row and column Hosts through Ebox's public constructors."
(should
(equal "AB"
(etaf-test--render-text
(etaf-view (row (text "A") (text "B"))))))
(should
(equal "A\nB"
(etaf-test--render-text
(etaf-view (column (text "A") (text "B")))))))
(ert-deftest etaf-view-grid-lowers-to-ebox-grid ()
"Lower the Grid Host through Ebox's two-dimensional layout node."
(let ((node (etaf-render
(etaf-view
(grid
:grid-template-columns '((20) (20))
(text "A")
(text "B"))))))
(should (eq (plist-get node :ebox-type) 'grid))
(should (string-match-p "A" (substring-no-properties (ebox-render node))))
(should (string-match-p "B" (substring-no-properties (ebox-render node))))))
(ert-deftest etaf-view-prefixed-host-alias-lowers-to-canonical-host ()
"Resolve an explicit `etaf-' Host spelling to its core Host name."
(should
(equal "Hello"
(etaf-test--render-text
(etaf-view (etaf-text "Hello"))))))
(ert-deftest etaf-component-view-renders-props ()
"Render a stateless Component from its declared props."
(let ((view (etaf-view (etaf-test-badge :label "Ready"))))
(should (etaf--component-call-p view))
(should (equal "Ready" (etaf-test--render-text view)))))
(ert-deftest etaf-component-prefixed-name-has-short-alias ()
"Resolve an `etaf-' Component through its public View alias."
(should
(equal "Ready"
(etaf-test--render-text
(etaf-view (test-badge :label "Ready"))))))
(ert-deftest etaf-component-alias-avoids-elisp-collision ()
"Use a semantic alias when the unprefixed name is an Elisp function."
(should
(equal "Items"
(etaf-test--render-text
(etaf-view (list-view :label "Items"))))))
(ert-deftest etaf-component-rejects-unknown-props ()
"Reject undeclared Component props at the Component boundary."
(should-error
(etaf-view (etaf-test-badge :unknown t))
:type 'etaf-component-call-error))
(ert-deftest etaf-component-definition-keywords-have-one-owner ()
"Accept the two definition modes and reject ambiguous combinations."
(should
(macroexpand
'(etaf-define-component setup-component (&key value)
:setup (lambda () (etaf-view (text (expr :value value)))))))
(should
(macroexpand
'(etaf-define-component styled-component ()
:styles (styles ("&" :color "red"))
:view (text "x"))))
(should-error
(macroexpand
'(etaf-define-component ambiguous-component (&key value)
:setup value
:view (text "x")))
:type 'etaf-component-definition-error)
(should-error
(macroexpand
'(etaf-define-component invalid-component ()
:behavior value))
:type 'etaf-component-definition-error))
(ert-deftest etaf-component-slots-share-one-default-and-named-model ()
"Render default children and explicit named slot contributions."
(should
(equal "Card\nHeader\nBody"
(etaf-test--render-text
(etaf-view
(etaf-test-slot-card :title "Card"
(slot :name 'header (text "Header"))
(text "Body"))))))
(should
(equal "Card\nDefault header\nDefault body"
(etaf-test--render-text
(etaf-view (etaf-test-slot-card :title "Card")))))
(should
(equal "Card\nDefault body"
(etaf-test--render-text
(etaf-view
(etaf-test-slot-card
:title "Card"
(slot :name 'header))))))
(should-error
(macroexpand '(etaf-view (etaf-test-slot-card (slot "bad"))))
:type 'etaf-view-syntax-error)
(should-error
(macroexpand
'(etaf-view
(etaf-test-slot-card (slot :name header (text "bad")))))
:type 'etaf-view-syntax-error)
(should-error
(macroexpand
'(etaf-view
(etaf-test-slot-card (slot :name nil (text "bad")))))
:type 'etaf-view-syntax-error))
(ert-deftest etaf-component-nested-slot-inputs-stay-named ()
"Treat a nested Component's slot child as input, not as projection."
(should
(equal "Forwarded"
(etaf-test--render-text
(etaf-view (etaf-test-named-slot-forwarder))))))
(ert-deftest etaf-styles-have-root-class-and-inline-precedence ()
"Apply component styles only at matching scope and preserve inline props."
(let* ((node (etaf-render (etaf-view (etaf-test-styled-card))))
(content-node (plist-get node :ebox-content-node))
(children (plist-get content-node :children))
(title (car children))
(body (cadr children)))
(should (equal "inline-title" (ebox-get title :color)))
(should (equal "title-bg" (ebox-get title :bgcolor)))
(should (equal "style-root" (ebox-get node :color)))
(should-not (ebox-get body :color))))
(ert-deftest etaf-nil-host-props-allow-component-styles ()
"Treat an explicit nil Host style property as unspecified."
(let ((node (etaf-render (etaf-view (etaf-test-nil-style-host)))))
(should (equal "style-color" (ebox-get node :color)))))
(ert-deftest etaf-style-rules-preserve-first-default-with-inline-protection ()
"Keep the first matching Component default without overriding inline props."
(let ((node (etaf-render (etaf-view (etaf-test-style-rule-order)))))
(should (equal "base-color" (ebox-get node :color))))
(let ((node (etaf-render
(etaf-view
(etaf-test-style-rule-order :color "inline-color")))))
(should (equal "inline-color" (ebox-get node :color)))))
(ert-deftest etaf-styles-stop-at-nested-component-boundaries ()
"Keep a parent Component selector outside nested Component internals."
(let ((node (etaf-render (etaf-view (etaf-test-styled-parent)))))
(should-not (ebox-get node :color))))
(ert-deftest etaf-styles-follow-caller-owned-slot-content ()
"Keep caller styles on slot content projected by a child Component."
(let ((node (etaf-render (etaf-view (etaf-test-styled-slot-parent)))))
(should (equal "parent-color" (ebox-get node :color)))))
(ert-deftest etaf-styles-keep-child-owned-slot-fallback-pure ()
"Keep child styles on fallback content authored by that Component."
(let ((node (etaf-render (etaf-view (etaf-test-styled-fallback-child)))))
(should (equal "child-color" (ebox-get node :color)))))
(ert-deftest etaf-mounted-styles-keep-child-owned-slot-fallback ()
"Keep child styles on fallback content through the Runtime path."
(let ((buffer-name " *etaf-mounted-style-fallback-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-styled-fallback-child)))
(should
(equal "child-color"
(ebox-get
(etaf-runtime-root-node
(etaf-runtime-for-buffer buffer-name))
:color))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-mounted-styles-stop-at-nested-component-boundaries ()
"Keep a parent Component selector outside mounted child internals."
(let ((buffer-name " *etaf-mounted-style-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-styled-parent)))
(should
(null
(ebox-get
(etaf-runtime-root-node
(etaf-runtime-for-buffer buffer-name))
:color))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-theme-defaults-are-inherited-and-overridable ()
"Apply Theme defaults while allowing explicit Host properties to win."
(let ((buffer-name " *etaf-theme-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-themed-text)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(node (etaf-runtime-root-node runtime)))
(should (equal "theme-color" (ebox-get node :color)))
(should (equal "theme-bg" (ebox-get node :bgcolor)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-theme-token-resolves-static-component-style ()
"Resolve a Theme token without turning the Host property inline."
(let ((buffer-name " *etaf-theme-token-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view (etaf-test-themed-style-token)))
(should (equal "token-color"
(ebox-get
(etaf-runtime-root-node
(etaf-runtime-for-buffer buffer-name))
:color))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-theme-token-resolves-nested-fallback-before-transform ()
"Resolve semantic aliases once, then transform the final Theme value."
(let ((token
(etaf-theme-token
:ui-border
(etaf-theme-token :line "#AAAAAA")
(lambda (color) (list (list 1) 'solid color)))))
(should
(equal '((1) solid "#202020")
(etaf--theme-token-resolve-from-theme
token '(:ui-border "#202020" :line "#101010"))))
(should
(equal '((1) solid "#101010")
(etaf--theme-token-resolve-from-theme
token '(:line "#101010"))))
(should
(equal '((1) solid "#AAAAAA")
(etaf--theme-token-resolve-from-theme token nil)))))
(ert-deftest etaf-theme-token-updates-host-property-without-component-render ()
"A reactive Theme token should publish one Host paint update directly."
(let ((buffer-name " *etaf-theme-property-effect-test*")
(etaf-test-theme-property-render-count 0)
(etaf-test-theme-property-cell nil))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view (etaf-test-theme-property-effect)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-generation runtime)))
(should (= etaf-test-theme-property-render-count 1))
(etaf-dispatch-event runtime 'theme-property-toggle 'press)
(should (= etaf-test-theme-property-render-count 1))
(should (= (etaf-runtime-generation runtime) (1+ generation)))
(should (etaf-value etaf-test-theme-property-cell))
(with-current-buffer buffer-name
(let ((face (get-text-property (point-min) 'face)))
(should (equal (etaf-test--face-value face :foreground)
"#EEEEEE"))
(should (equal (etaf-test--face-value face :background)
"#111111"))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-theme-paint-slot-rolls-back-with-generation-failure ()
"A failed generation promotion must restore the committed paint plane."
(let ((buffer-name " *etaf-theme-paint-rollback-test*")
(etaf-test-theme-property-cell nil))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view (etaf-test-theme-property-effect)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-generation runtime))
(slot
(plist-get
(etaf-runtime-host-props-for
runtime 'theme-property-toggle)
:color)))
(should (tp-paint-slot-p slot))
(should (equal "#111111"
(plist-get (tp-paint-slot-spec slot) :foreground)))
(cl-letf (((symbol-function 'etaf--runtime-swap-generation)
(lambda (&rest _)
(error "injected generation promotion failure"))))
(should-error
(etaf-dispatch-event runtime 'theme-property-toggle 'press)))
(should (= generation (etaf-runtime-generation runtime)))
(should (equal "#111111"
(plist-get (tp-paint-slot-spec slot) :foreground)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-theme-and-component-change-publish-one-final-artifact ()
"Publish same-turn content and Theme changes from the final Generation."
(let ((buffer-name " *etaf-theme-atomic-artifact-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view (etaf-test-theme-atomic-owner)))
(let ((runtime (etaf-runtime-for-buffer buffer-name)))
(cl-labels
((ebox-host-node
(host-ref)
(let* ((buffer (get-buffer buffer-name))
(state (ebox--buffer-render-state buffer))
(node-id
(gethash host-ref
(plist-get state :host-ref-table))))
(gethash node-id (plist-get state :node-table))))
(background
(value)
(if (tp-paint-slot-p value)
(plist-get (tp-paint-slot-spec value) :background)
value)))
(let ((slot
(plist-get (ebox-host-node 'theme-atomic-panel)
:bgcolor)))
(should (equal "#FFFFFF" (background slot)))
(etaf-dispatch-event runtime 'theme-atomic-toggle 'press)
(let ((semantic
(plist-get
(etaf-runtime-host-props-for
runtime 'theme-atomic-panel)
:bgcolor))
(backend
(plist-get (ebox-host-node 'theme-atomic-panel)
:bgcolor)))
(should (eq slot semantic))
(should (eq slot backend))
(should (equal "#111111" (background slot))))
(should (string-match-p
"Dark" (etaf-test--buffer-text buffer-name)))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-runtime-detached-component-subtree-retires-host-effects ()
"Retire unreachable Host contributions before a later Theme update."
(let ((buffer-name " *etaf-detached-theme-list-test*")
(etaf-test-detached-list-source
(etaf-ref '((old-a . "A") (old-b . "B"))))
(etaf-test-detached-theme-source
(etaf-ref '(:color "#111111")))
(etaf-test-detached-row-renders 0))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view (etaf-test-detached-theme-list)))
(let ((runtime (etaf-runtime-for-buffer buffer-name)))
(should (etaf-runtime-host-props-for runtime 'old-b))
(setf (etaf-value etaf-test-detached-list-source)
'((old-a . "A2") (new-c . "C")))
(should-not (etaf-runtime-host-props-for runtime 'old-b))
(should-not
(gethash 'old-b
(ebox--buffer-host-ref-table (get-buffer buffer-name))))
(setq etaf-test-detached-row-renders 0)
(setf (etaf-value etaf-test-detached-theme-source)
'(:color "#222222"))
(should (zerop etaf-test-detached-row-renders))
(let ((color
(plist-get
(etaf-runtime-host-props-for runtime 'new-c)
:color)))
(should (tp-paint-slot-p color))
(should
(equal "#222222"
(plist-get (tp-paint-slot-spec color) :foreground))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-theme-resolves-explicit-light-dark-palette ()
"Resolve semantic palette pairs without coupling Theme to a renderer."
(should
(equal '(:ink "#172033" :paper "#F7F3EA")
(etaf-theme-resolve-palette
'(:ink ("#172033" . "#F4F7FF")
:paper (:light "#F7F3EA" :dark "#111827"))
'light)))
(should
(equal '(:ink "#F4F7FF" :paper "#111827")
(etaf-theme-resolve-palette
'(:ink ("#172033" . "#F4F7FF")
:paper (:light "#F7F3EA" :dark "#111827"))
'dark)))
(should-error
(etaf-theme-resolve-palette '(:ink "red") 'sepia)
:type 'etaf-context-error))
(ert-deftest etaf-text-supports-inline-propertized-runs ()
"Lower nested text Hosts to one Ebox content surface with text properties."
(let* ((node (etaf-render
(etaf-view
(text "Hello " (text :face 'bold "world") "!"))))
(content (ebox-get node :content)))
(should (equal "Hello world!" (substring-no-properties content)))
(should (eq 'bold (get-text-property 6 'face content)))
(should-not (get-text-property 0 'face content))))
(ert-deftest etaf-runtime-retains-setup-and-reactively-commits ()
"Run setup once, update through a ref, and dispose on unmount."
(let ((buffer-name " *etaf-runtime-test*"))
(setq etaf-test-state-cell nil
etaf-test-setup-count 0
etaf-test-mounted-count 0
etaf-test-unmounted-count 0
etaf-test-updated-count 0)
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view (etaf-test-stateful :label "Count")))
(should (equal "Count:0" (etaf-test--render-text
(etaf-view (text "Count:0")))))
(with-current-buffer buffer-name
(should (equal "Count:0" (buffer-string))))
(should (= etaf-test-setup-count 1))
(should (= etaf-test-mounted-count 1))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime))
(effect-id (car (etaf--generation-source-effects
generation etaf-test-state-cell))))
(should (eq 'inline
(etaf--generation-effect-kind
(etaf--generation-effect generation effect-id)))))
(setf (etaf-value etaf-test-state-cell) 1)
(with-current-buffer buffer-name
(should (equal "Count:1" (buffer-string))))
(should (= etaf-test-setup-count 1))
(should (= etaf-test-updated-count 1))
(etaf-unmount (etaf-runtime-for-buffer buffer-name))
(should (= etaf-test-unmounted-count 1)))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-runtime-recollects-late-branch-dependencies ()
"Recollect refs introduced by a branch after the initial mount."
(let ((buffer-name " *etaf-runtime-late-branch-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-late-branch)))
(with-current-buffer buffer-name
(should (equal "page" (buffer-string))))
(setf (etaf-value etaf-test-branch-mode-cell) t)
(with-current-buffer buffer-name
(should (equal "late" (buffer-string))))
(setf (etaf-value etaf-test-branch-late-cell) "late-updated")
(with-current-buffer buffer-name
(should (equal "late-updated" (buffer-string)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-runtime-branch-switch-keeps-equal-sources-distinct ()
"Index equal-valued reactive sources by identity across a branch switch."
(let ((buffer-name " *etaf-runtime-equal-source-branch-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-late-branch)))
(setf (etaf-value etaf-test-branch-page-cell) "same")
(setf (etaf-value etaf-test-branch-late-cell) "same")
(setf (etaf-value etaf-test-branch-mode-cell) t)
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime))
(before (etaf-runtime-generation runtime)))
(should-not (etaf--generation-source-effects
generation etaf-test-branch-page-cell))
(should (etaf--generation-source-effects
generation etaf-test-branch-late-cell))
(setf (etaf-value etaf-test-branch-page-cell) "old-only")
(should (= before (etaf-runtime-generation runtime)))
(setf (etaf-value etaf-test-branch-late-cell) "new-only")
(should (= (1+ before) (etaf-runtime-generation runtime)))
(should (equal "new-only" (etaf-test--buffer-text buffer-name)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-theme-validation-snapshot-is-shared-across-contexts ()
"Validate one immutable Theme value once for all inheriting Context frames."
(let* ((theme (list :color "ink" :bgcolor "paper" :border "line"))
(provider (etaf--context-create))
(left (etaf--context-create :parent provider))
(right (etaf--context-create :parent provider))
(etaf--theme-value-cache
(make-hash-table :test #'eq :weakness 'key))
left-value right-value)
(puthash 'theme theme (etaf-context-values provider))
(let ((etaf--current-context left))
(setq left-value (etaf-theme-defaults)))
(let ((etaf--current-context right))
(setq right-value (etaf-theme-defaults)))
(should (eq left-value right-value))
(should-not (eq left-value theme))
(should (equal theme left-value))))
(ert-deftest etaf-context-provide-inject-follows-component-tree ()
"Resolve the nearest Context and react to its provided ref."
(let ((buffer-name " *etaf-context-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view
(etaf-test-provider
(etaf-test-consumer))))
(with-current-buffer buffer-name
(should (equal "dark" (buffer-string))))
(setf (etaf-value etaf-test-theme-cell) 'light)
(with-current-buffer buffer-name
(should (equal "light" (buffer-string)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-behavior-event-and-action-share-runtime-boundary ()
"Install a Behavior, dispatch its Host callback, and dispose it."
(let ((buffer-name " *etaf-event-test*"))
(setq etaf-test-event-count 0
etaf-test-behavior-cleanups 0)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(text
:ref 'interactive
:use (list (etaf-test-cleanup-behavior))
:on-press (lambda () (etaf-dispatch 'etaf-test-action))
"Press")))
(let ((runtime (etaf-runtime-for-buffer buffer-name)))
(let* ((generation (etaf-runtime-current-generation runtime))
(entry (car (etaf--generation-index-entries
generation 'behaviors)))
(resource-key (cdr entry)))
(should entry)
(should (consp resource-key))
(should (gethash resource-key
(etaf-runtime-resource-registry runtime))))
(etaf-dispatch-event runtime 'interactive 'press)
(should (= etaf-test-event-count 1))
(should (equal '(press)
(mapcar #'car
(gethash 'interactive
(etaf-runtime-handlers runtime)))))
(etaf-unmount runtime))
(should (= etaf-test-behavior-cleanups 1)))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-runtime-composes-host-and-behavior-events-in-order ()
"Run an explicit Host callback before its Behavior callback.
Event composition is a Runtime contract, not a UI-library helper contract."
(let ((buffer-name " *etaf-event-composition-test*")
(order nil))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(text
:ref 'composed
:use (list
(etaf-test-cleanup-behavior
:on-press (lambda () (setq order (append order '(behavior))))))
:on-press (lambda () (setq order (append order '(host))))
"Press")))
(etaf-dispatch-event (etaf-runtime-for-buffer buffer-name)
'composed 'press)
(should (equal order '(host behavior))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-behavior-replacement-disposes-previous-installer ()
"Dispose a replaced Behavior while retaining the public installer path."
(let ((buffer-name " *etaf-behavior-replace-test*")
(marker (etaf-ref 0))
(trigger (etaf-ref 0)))
(setq etaf-test-behavior-cleanups 0
etaf-test-behavior-installs 0
etaf-test-behavior-runtime nil)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(text
:ref 'behavior-host
:aria-label (progn (etaf-value trigger) "behavior")
:use (list (etaf-test-cleanup-behavior
:class (format "mode-%d" (etaf-value marker))))
"Behavior")))
(should (etaf-runtime-p etaf-test-behavior-runtime))
(should (= 1 etaf-test-behavior-installs))
(setf (etaf-value trigger) 1)
;; The render creates a fresh installer closure. Function identity
;; is part of Behavior equality, so the old installer is disposed
;; before the new one is staged.
(should (= 2 etaf-test-behavior-installs))
(should (= 1 etaf-test-behavior-cleanups))
(should (etaf--generation-index-entries
(etaf-runtime-current-generation
(etaf-runtime-for-buffer buffer-name))
'behaviors))
(setf (etaf-value marker) 1)
(should (= 3 etaf-test-behavior-installs))
(should (= 2 etaf-test-behavior-cleanups)))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-behavior-rollback-cleanups-continue-and-diagnose ()
"Run candidate Behavior cleanup in reverse order despite error and quit."
(let* ((runtime (etaf--runtime-create
:behaviors (make-hash-table :test #'equal)
:candidate-behaviors (make-hash-table :test #'equal)))
(trace nil)
(first (etaf-behavior-create 'first))
(second (etaf-behavior-create 'second)))
(puthash '(a first)
(cons first (lambda () (push 'first trace) (error "first")))
(etaf-runtime-candidate-behaviors runtime))
(puthash '(b second)
(cons second (lambda () (push 'second trace) (signal 'quit nil)))
(etaf-runtime-candidate-behaviors runtime))
(etaf--runtime-rollback-behaviors runtime)
(should (equal '(first second) trace))
(should (= 2 (length (etaf-runtime-diagnostics runtime))))
(should (equal '(behavior-rollback behavior-rollback)
(mapcar (lambda (entry) (plist-get entry :phase))
(reverse (etaf-runtime-diagnostics runtime)))))))
(ert-deftest etaf-runtime-target-equality-keeps-function-and-reactive-identity ()
"Use EQ for function/reactive leaves while comparing scalar structure."
(let* ((source (etaf-ref 1))
(callback (lambda () 1))
(left (list :value source :callback callback :count 1))
(same (list :value source :callback callback :count 1))
(new (list :value source :callback (lambda () 1) :count 1)))
(should (etaf--runtime-target-value-equal-p left same))
(should-not (etaf--runtime-target-value-equal-p left new))
(should (etaf--runtime-behavior-spec-equal-p
(etaf-behavior-create 'stable :value source :install callback)
(etaf-behavior-create 'stable :value source :install callback)))
(should-not (etaf--runtime-behavior-spec-equal-p
(etaf-behavior-create 'stable :value source
:install (lambda () nil))
(etaf-behavior-create 'stable :value source
:install (lambda () nil))))))
(ert-deftest etaf-toggleable-reads-reactive-value-at-event-time ()
"Use the current reactive value when a toggleable Behavior is pressed."
(let ((value (etaf-ref nil)) received)
(let ((behavior
(etaf-toggleable
:value value
:on-change (lambda (next) (setq received next))
:class "toggle")))
(should (equal "toggle"
(plist-get (etaf-behavior-spec-attributes behavior)
:class)))
(funcall (plist-get (etaf-behavior-spec-attributes behavior) :on-press))
(should (eq t received))
(setf (etaf-value value) t)
(funcall (plist-get (etaf-behavior-spec-attributes behavior) :on-press))
(should (eq nil received)))))
(ert-deftest etaf-focusable-supplies-default-tab-stop ()
"Give a focusable Behavior the standard tab index unless overridden."
(should (= 0 (plist-get (etaf-behavior-spec-attributes (etaf-focusable))
:tab-index)))
(should-not (plist-get
(etaf-behavior-spec-attributes
(etaf-focusable :tab-index nil))
:tab-index)))
(ert-deftest etaf-reactive-computed-watch-and-cleanup-share-one-model ()
"Compute values, watch changes, and dispose watch cleanup deterministically."
(let* ((source (etaf-ref 1))
(computed (etaf-computed (lambda () (* 2 (etaf-value source)))))
(watch-values nil)
(cleanup-count 0)
(stop-watch
(etaf-watch source
(lambda (new old)
(push (list new old) watch-values))
:immediate t))
(stop-effect
(etaf-watch-effect
(lambda ()
(etaf-value source)
(lambda () (cl-incf cleanup-count))))))
(unwind-protect
(progn
(should (= 2 (etaf-value computed)))
(setf (etaf-value source) 2)
(should (= 4 (etaf-value computed)))
(should (equal '((2 1) (1 nil)) watch-values))
(should (= 1 cleanup-count))
(funcall stop-watch)
(funcall stop-effect)
(should (= 2 cleanup-count))
(setf (etaf-value source) 3)
(should (equal '((2 1) (1 nil)) watch-values)))
(funcall stop-watch)
(funcall stop-effect))))
(ert-deftest etaf-reactive-effect-restores-dependencies-after-failure ()
"Keep the previous dependency set when an effect run fails."
(let* ((source (etaf-ref 0))
(runs 0)
(fail-p nil)
(effect (etaf-reactive-effect-create
(lambda ()
(etaf-value source)
(cl-incf runs)
(when fail-p
(error "expected effect failure"))))))
(etaf-reactive-effect-run effect)
(setq fail-p t)
(should-error (setf (etaf-value source) 1))
(should (= 2 runs))
(setq fail-p nil)
(setf (etaf-value source) 2)
(should (= 3 runs))
(etaf--stop-effect effect)))
(ert-deftest etaf-runtime-root-owner-is-only-full-rebuild-entry ()
"Keep complete-root publication isolated to Root-owner control flow."
(let ((file (expand-file-name
"etaf-runtime.el"
(file-name-directory (or (locate-library "etaf")
default-directory))))
source)
(with-temp-buffer
(insert-file-contents file)
(setq source (buffer-string)))
;; Mounted non-root invalidations set only their effect queue. Root-owned
;; rebuilds are centralized behind one marker and are requested only by a
;; Root effect route or by an explicit local-proof miss.
(should (= 1 (let ((start 0) count)
(while (string-match
"(setf (etaf-runtime-root-dirty-p runtime) t)"
source start)
(setq count (1+ (or count 0))
start (match-end 0)))
count)))
(should (= 2 (let ((start 0) count)
(while (string-match
"(etaf--runtime-mark-root-dirty runtime)"
source start)
(setq count (1+ (or count 0))
start (match-end 0)))
count)))
(let* ((start (string-match
"(defun etaf--runtime-component-overlay"
source))
(end (string-match
"(defun etaf--runtime-render-effect"
source start))
(overlay (substring source start end)))
(should-not (string-match-p "etaf--runtime-render-effect" overlay))
(should-not (string-match-p "etaf--runtime-evaluate-root-candidate"
overlay)))
;; Flush has one mutually exclusive Root branch and one local overlay
;; branch; this guards against accidentally routing all mounted effects
;; through the Root adapter again.
(should (string-match-p
"(if (etaf-runtime-root-dirty-p runtime)"
source))))
(ert-deftest etaf-runtime-fixed-point-tuple-detects-repeated-input ()
"Reject a repeated Runtime effect tuple only within one flush."
(let* ((runtime (etaf--runtime-create :mount-epoch 77))
(source (etaf-ref nil))
(effect (etaf--generation-effect-create
:effect-id 3 :kind 'range :deps (list source)))
(generation (etaf--generation-create
:generation-id 1
:effect-map (etaf--pvec-put nil 3 effect)))
(etaf--runtime-fixed-point-stamps
(make-hash-table :test #'equal)))
(should (etaf--runtime-record-effect-input-version
runtime generation 3))
(should-error
(etaf--runtime-record-effect-input-version runtime generation 3)
:type 'etaf-runtime-error)
(setf (etaf-ref-version source) 1)
(should (etaf--runtime-record-effect-input-version
runtime generation 3))))
(ert-deftest etaf-reactive-dispatch-fifos-append-in-constant-time-order ()
"Keep source and Runtime dispatch order with explicit FIFO tails."
(let ((etaf--dispatch-depth 1)
(etaf--dispatch-source-queue nil)
(etaf--dispatch-source-queue-tail nil)
(etaf--dispatch-source-set (make-hash-table :test #'eq))
(etaf--dispatch-runtime-queue nil)
(etaf--dispatch-runtime-queue-tail nil)
(etaf--dispatch-runtime-set (make-hash-table :test #'eq))
(sources (cl-loop repeat 100 collect (etaf-ref nil))))
(dolist (source sources)
(etaf--dispatch-source source))
(etaf--dispatch-source (car sources))
(etaf-reactive-enqueue-runtime-flush 'first #'ignore)
(etaf-reactive-enqueue-runtime-flush 'second #'ignore)
(etaf-reactive-enqueue-runtime-flush 'first #'ignore)
(should (equal sources etaf--dispatch-source-queue))
(should (eq (car etaf--dispatch-source-queue-tail) (car (last sources))))
(should (equal '(first second) etaf--dispatch-runtime-queue))
(should (eq 'second (car etaf--dispatch-runtime-queue-tail)))))
(ert-deftest etaf-runtime-dirty-effect-fifo-and-priority-stay-stable ()
"Append dirty effects in O(1) and sort each immutable effect only once."
(let* ((runtime
(etaf--runtime-create
:dirty-effect-ids (make-hash-table :test #'eql)))
(generation
(etaf--generation-create
:effect-map
(etaf--pvec-put-many
nil
(list
(cons 5 (etaf--generation-effect-create
:effect-id 5 :kind 'component-render))
(cons 2 (etaf--generation-effect-create
:effect-id 2 :kind 'inline))
(cons 3 (etaf--generation-effect-create
:effect-id 3 :kind 'component-input))
(cons 1 (etaf--generation-effect-create
:effect-id 1 :kind 'root)))))))
(dolist (effect-id '(5 2 3 1 2))
(etaf--runtime-enqueue-effect runtime effect-id))
(should (equal '(5 2 3 1)
(etaf-runtime-dirty-effect-queue runtime)))
(should (= 1 (car (etaf-runtime-dirty-effect-queue-tail runtime))))
(should (equal '(1 3 2 5)
(etaf--runtime-sort-dirty-effects
generation (etaf-runtime-dirty-effect-queue runtime))))
(let (popped)
(while (etaf-runtime-dirty-effect-queue runtime)
(push (etaf--runtime-pop-effect runtime) popped))
(should (equal '(5 2 3 1) (nreverse popped)))
(should-not (etaf-runtime-dirty-effect-queue-tail runtime)))))
(ert-deftest etaf-runtime-fixed-point-step-bound-stops-monotonic-cycle ()
"Stop a cycle whose source version changes on every evaluation."
(let* ((runtime (etaf--runtime-create :mount-epoch 78))
(source (etaf-ref nil))
(effect (etaf--generation-effect-create
:effect-id 4 :kind 'range :deps (list source)))
(generation (etaf--generation-create
:generation-id 1
:effect-map (etaf--pvec-put nil 4 effect)))
(etaf--runtime-fixed-point-stamps (make-hash-table :test #'equal))
(etaf--runtime-fixed-point-steps 0)
(etaf--runtime-fixed-point-step-bound 2))
(etaf--runtime-record-effect-input-version runtime generation 4)
(setf (etaf-ref-version source) 1)
(etaf--runtime-record-effect-input-version runtime generation 4)
(setf (etaf-ref-version source) 2)
(should-error
(etaf--runtime-record-effect-input-version runtime generation 4)
:type 'etaf-runtime-error)))
(ert-deftest etaf-runtime-fixed-point-long-acyclic-chain-fits-bound ()
"Allow a long chain of distinct effect tuples within the graph bound."
(let ((runtime (etaf--runtime-create :mount-epoch 79))
(etaf--runtime-fixed-point-stamps (make-hash-table :test #'equal))
(etaf--runtime-fixed-point-steps 0)
(etaf--runtime-fixed-point-step-bound 164)
(generation (etaf--generation-create :generation-id 1
:effect-map nil)))
(dotimes (index 40)
(let* ((source (etaf-ref nil))
(effect-id (1+ index))
(effect (etaf--generation-effect-create
:effect-id effect-id :kind 'range :deps (list source))))
(setf (etaf-generation-effect-map generation)
(etaf--pvec-put (etaf-generation-effect-map generation)
effect-id effect))
(etaf--runtime-record-effect-input-version runtime generation effect-id)))
(should (= 40 etaf--runtime-fixed-point-steps))))
(ert-deftest etaf-runtime-fixed-point-tuple-includes-candidate-facts-and-path ()
"Detect candidate semantic cycles and retain an effect/edge path."
(let* ((source (etaf-ref nil))
(runtime
(etaf--runtime-create
:mount-epoch 80 :next-effect-id 2
:candidate-effects (make-hash-table :test #'eql)
:candidate-graph-nodes (make-hash-table :test #'eql)
:route-sources (make-hash-table :test #'eq)))
(effect
(etaf--generation-effect-create
:effect-id 1 :kind 'range :semantic-id 11 :deps (list source)))
(generation
(etaf--generation-create
:generation-id 1
:effect-map (etaf--pvec-put nil 1 effect)))
(semantic
(etaf--semantic-range-create
:semantic-id 11 :identity '(candidate-range)
:effect-id 1 :kind 'range :composition-version 1
:output-signature '("A") :context-deps nil)))
(puthash 1 effect (etaf-runtime-candidate-effects runtime))
(puthash 11 semantic (etaf-runtime-candidate-graph-nodes runtime))
(let ((etaf--runtime-fixed-point-stamps (make-hash-table :test #'equal))
(etaf--runtime-fixed-point-history nil)
(etaf--runtime-fixed-point-steps 0)
(etaf--runtime-fixed-point-step-bound 8))
(etaf--runtime-record-effect-input-version runtime generation 1)
(setf (etaf--semantic-range-composition-version semantic) 2)
(etaf--runtime-record-effect-input-version runtime generation 1)
(let (condition)
(condition-case err
(etaf--runtime-record-effect-input-version runtime generation 1)
(etaf-runtime-error (setq condition (cdr err))))
(should condition)
(should (plist-get condition :path))
(should (= 3 (length (plist-get condition :path))))))))
(ert-deftest etaf-runtime-skips-descendant-range-under-rendered-component ()
"A freshly rendered Component absorbs its old descendant Range effect."
(let* ((component
(etaf--semantic-component-create
:semantic-id 7 :identity '(parent-component)))
(range
(etaf--semantic-range-create
:semantic-id 8 :effect-id 8 :component-id 7 :parent-id 7))
(generation
(etaf--generation-create
:generation-id 1
:semantic-nodes (etaf--pvec-put
(etaf--pvec-put nil 7 component) 8 range)))
(runtime
(etaf--runtime-create
:candidate-rendered-identities '((parent-component))
:candidate-effects (make-hash-table :test #'eql)
:candidate-graph-nodes (make-hash-table :test #'eql))))
(puthash 8
(etaf--generation-effect-create
:effect-id 8 :kind 'range :semantic-id 8)
(etaf-runtime-candidate-effects runtime))
(puthash 8 range (etaf-runtime-candidate-graph-nodes runtime))
(should (etaf--runtime-range-owned-by-rendered-component-p
runtime generation range))
(setf (etaf-runtime-candidate-rendered-identities runtime) nil)
(should-not (etaf--runtime-range-owned-by-rendered-component-p
runtime generation range))))
(ert-deftest etaf-view-raw-ebox-is-an-explicit-backend-escape ()
"Lower a public Ebox node only through the explicit raw escape."
(let ((node
(etaf-render
(etaf-view
(raw-ebox
:key 7
:value (ebox-create :content "Backend"))))))
(should (equal "Backend" (ebox-get node :content)))
(should (= 7 (ebox-get node :key)))))
(ert-deftest etaf-stateful-props-update-without-rerunning-setup ()
"Track a reactive root prop while retaining one Component setup Scope."
(let ((buffer-name " *etaf-prop-update-test*")
(label (etaf-ref "A")))
(setq etaf-test-setup-count 0)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-test-prop-stateful :label (etaf-value label))))
(with-current-buffer buffer-name
(should (equal "A" (buffer-string))))
(setf (etaf-value label) "B")
(with-current-buffer buffer-name
(should (equal "B" (buffer-string))))
(should (= 1 etaf-test-setup-count)))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-runtime-keeps-last-committed-view-after-render-error ()
"Rollback a failed candidate without losing the last committed buffer."
(let ((buffer-name " *etaf-rollback-test*")
(fail-p (etaf-ref nil)))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view (etaf-test-rollback :fail (etaf-value fail-p))))
(with-current-buffer buffer-name
(should (equal "stable:0" (buffer-string))))
(should-error (setf (etaf-value fail-p) t)
:type 'etaf-runtime-error)
(with-current-buffer buffer-name
(should (equal "stable:0" (buffer-string))))
(setf (etaf-value fail-p) nil)
(with-current-buffer buffer-name
(should (equal "stable:0" (buffer-string)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-runtime-keeps-published-state-when-lifecycle-fails ()
"Keep retained state aligned with the published tree after hook failure."
(let ((buffer-name " *etaf-lifecycle-error-test*")
(label (etaf-ref "A")))
(setq etaf-test-lifecycle-failure-p nil)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-test-lifecycle-failure :label (etaf-value label))))
(setq etaf-test-lifecycle-failure-p t)
(should-error (setf (etaf-value label) "B") :type 'error)
(should (etaf-runtime-mounted-p
(etaf-runtime-for-buffer buffer-name)))
(with-current-buffer buffer-name
(should (equal "B" (buffer-string))))
(setq etaf-test-lifecycle-failure-p nil)
(setf (etaf-value label) "C")
(with-current-buffer buffer-name
(should (equal "C" (buffer-string)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-events-support-payload-and-cyclic-focus ()
"Dispatch a payload and cycle focus through visible tab-index Hosts."
(let ((buffer-name " *etaf-focus-test*")
payload)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(column
(text :ref 'first :tab-index 0 "First")
(text :ref 'second :tab-index 1
:on-input (lambda (value) (setq payload value))
"Second"))))
(let ((runtime (etaf-runtime-for-buffer buffer-name)))
(should (eq 'first (etaf-focus-next runtime)))
(should (eq 'second (etaf-focus-next runtime)))
(should (eq 'first (etaf-focus-next runtime)))
(etaf-dispatch-event runtime 'second 'input "value" t)
(should (equal "value" payload))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-event-dispatch-batches-reactive-publication ()
"Publish one final tree for a callback's reactive dependency chain."
(let ((buffer-name " *etaf-event-batch-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view (etaf-test-event-batch-stateful)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(before (etaf-runtime-generation runtime)))
(etaf-dispatch-event runtime 'event-batch-trigger 'press)
(with-current-buffer buffer-name
(should (string-match-p
"source=2 computed=4 watch:2 effect:4"
(buffer-string))))
(should (= 1 (- (etaf-runtime-generation runtime) before)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-pvec-put-many-preserves-values-and-shares-untouched-branches ()
"Batch persistent-vector updates match sequential puts and share untouched paths."
(let* ((untouched-id (* 31 (expt 2 30)))
(base (etaf--pvec-put
(etaf--pvec-put nil untouched-id 'untouched)
1 'old))
(sequential-metrics (etaf--generation-metrics-create))
(batch-metrics (etaf--generation-metrics-create))
(sequential
(etaf--pvec-put
(etaf--pvec-put
(etaf--pvec-put
(etaf--pvec-put base 1 'new) 2 'two sequential-metrics)
3 'three sequential-metrics)
1 'final sequential-metrics))
(batch
(etaf--pvec-put-many
base '((1 . new) (2 . two) (3 . three) (1 . final))
batch-metrics))
(base-children (etaf--pvec-node-children base))
(batch-children (etaf--pvec-node-children batch))
(untouched-slot (logand 31 (ash untouched-id (* -5 6)))))
(should (equal (etaf--pvec-get batch 1) 'final))
(should (equal (etaf--pvec-get batch 2) 'two))
(should (equal (etaf--pvec-get batch 3) 'three))
(should (equal (etaf--pvec-get batch untouched-id) 'untouched))
(should (equal (etaf--pvec-get batch 1)
(etaf--pvec-get sequential 1)))
(should (eq (aref base-children untouched-slot)
(aref batch-children untouched-slot)))
(should (< (etaf--generation-metrics-node-copies batch-metrics)
(etaf--generation-metrics-node-copies sequential-metrics)))))
(ert-deftest etaf-runtime-component-overlay-does-zero-unrelated-work ()
"Point-update one of 500 retained Components without Root or sibling work."
(let* ((buffer-name " *etaf-persistent-generation-test*")
(cells (cl-loop repeat 500 collect (etaf-ref 0)))
(etaf-test-retained-render-counts (make-hash-table :test #'eql))
(root-calls 0)
(view
(lambda ()
(cl-incf root-calls)
(etaf--view-call
'column nil
(cl-loop for cell in cells for index from 0
collect
(etaf--view-call
'etaf-test-retained-leaf
(list :key index :label index :cell cell) nil))))))
(unwind-protect
(progn
(etaf-mount buffer-name view)
(clrhash etaf-test-retained-render-counts)
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(old (etaf-runtime-current-generation runtime))
(old-index (etaf-generation-identity-index old)))
(setf (etaf-value (nth 247 cells)) 1)
(let ((metrics (etaf-runtime-candidate-generation-metrics runtime))
(new (etaf-runtime-current-generation runtime)))
(should (= 1 root-calls))
(should (= 1 (gethash 247 etaf-test-retained-render-counts 0)))
(should (= 1 (hash-table-count etaf-test-retained-render-counts)))
(should (eq old-index (etaf-generation-identity-index new)))
(should (<= (etaf--generation-metrics-node-copies metrics) 128)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-shared-source-renders-siblings-in-one-commit ()
"Render exactly two subscribing siblings and publish one candidate."
(let* ((buffer-name " *etaf-shared-source-siblings-test*")
(shared (etaf-ref 0)) (unrelated (etaf-ref 0))
(root-calls 0) (commits 0) (replacements 0)
(etaf-test-retained-render-counts (make-hash-table :test #'equal))
(view
(lambda ()
(cl-incf root-calls)
(etaf--view-call
'column nil
(list
(etaf--view-call 'etaf-test-retained-leaf
(list :key 'a :label "A" :cell shared) nil)
(etaf--view-call 'etaf-test-retained-leaf
(list :key 'b :label "B" :cell shared) nil)
(etaf--view-call 'etaf-test-retained-leaf
(list :key 'u :label "U" :cell unrelated) nil))))))
(unwind-protect
(progn
(etaf-mount buffer-name view)
(clrhash etaf-test-retained-render-counts)
(let ((old-commit (symbol-function 'ebox-commit))
(old-replace (symbol-function 'ebox-candidate-replace-host-ref))
(runtime (etaf-runtime-for-buffer buffer-name)))
(cl-letf (((symbol-function 'ebox-commit)
(lambda (&rest args)
(cl-incf commits) (apply old-commit args)))
((symbol-function 'ebox-candidate-replace-host-ref)
(lambda (&rest args)
(cl-incf replacements) (apply old-replace args))))
(let ((before (etaf-runtime-generation runtime)))
(setf (etaf-value shared) 1)
(should (= 1 (- (etaf-runtime-generation runtime) before)))))
(should (= 1 commits))
(should (= 2 replacements))
(should (= 1 (gethash "A" etaf-test-retained-render-counts 0)))
(should (= 1 (gethash "B" etaf-test-retained-render-counts 0)))
(should (zerop (gethash "U" etaf-test-retained-render-counts 0)))
(should (= 1 root-calls))
(should (= 1 (hash-table-count (etaf-ref-subscribers shared))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-root-rebuild-retains-unchanged-sibling-routes ()
"Retain an unchanged sibling semantic subtree across a Root-owned rebuild."
(let* ((buffer-name " *etaf-root-retain-sibling-test*")
(root-source (etaf-ref "A"))
(left-cell (etaf-ref 0)) (right-cell (etaf-ref 0))
(root-calls 0)
(etaf-test-retained-render-counts (make-hash-table :test #'equal))
(view
(lambda ()
(cl-incf root-calls)
(etaf--view-call
'column nil
(list
(etaf--view-call 'etaf-test-retained-leaf
(list :key 'left
:label (etaf-value root-source)
:cell left-cell) nil)
(etaf--view-call 'etaf-test-retained-leaf
(list :key 'right :label "R"
:cell right-cell) nil))))))
(unwind-protect
(progn
(etaf-mount buffer-name view)
(clrhash etaf-test-retained-render-counts)
(setf (etaf-value root-source) "B")
(should (= 1 (gethash "B" etaf-test-retained-render-counts 0)))
(should (zerop (gethash "R" etaf-test-retained-render-counts 0)))
(clrhash etaf-test-retained-render-counts)
(let ((root-before root-calls))
(setf (etaf-value right-cell) 1)
(should (= root-before root-calls))
(should (= 1 (gethash "R" etaf-test-retained-render-counts 0)))
(should (zerop (gethash "B" etaf-test-retained-render-counts 0)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-setup-read-is-not-a-render-dependency ()
"Do not subscribe a Component render owner to setup-only reads."
(let ((buffer-name " *etaf-setup-dependency-test*")
(setup-source (etaf-ref 0)) (render-source (etaf-ref "A")))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf--view-call 'etaf-test-setup-read-owner
(list :setup-source setup-source
:render-source render-source) nil))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(before (etaf-runtime-generation runtime)))
(setf (etaf-value setup-source) 1)
(should (= before (etaf-runtime-generation runtime)))
(setf (etaf-value render-source) "B")
(should (= (1+ before) (etaf-runtime-generation runtime)))
(should (equal "B" (etaf-test--buffer-text buffer-name)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-dependency-only-promotion-skips-ebox-publication ()
"Promote changed dependencies/output inputs without an Ebox commit."
(let ((buffer-name " *etaf-dependency-only-test*")
(source (etaf-ref 0)) (commits 0))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf--view-call 'etaf-test-dependency-only
(list :source source) nil))
(let ((runtime (etaf-runtime-for-buffer buffer-name))
(before-commit (symbol-function 'ebox-commit)))
(cl-letf (((symbol-function 'ebox-commit)
(lambda (&rest args)
(cl-incf commits)
(apply before-commit args))))
(let ((before (etaf-runtime-generation runtime)))
(setf (etaf-value source) 1)
(should (= (1+ before) (etaf-runtime-generation runtime)))
(should (zerop commits))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-equal-component-input-skips-render ()
"Promote an input target dependency change without running its render target."
(let ((buffer-name " *etaf-input-equal-test*") (trigger (etaf-ref 0)))
(setq etaf-test-input-render-count 0)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-test-input-equal
:label (progn (etaf-value trigger) "same"))))
(setq etaf-test-input-render-count 0)
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(before (etaf-runtime-generation runtime)))
(setf (etaf-value trigger) 1)
(should (= (1+ before) (etaf-runtime-generation runtime)))
(should (zerop etaf-test-input-render-count))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-input-target-precedes-render-target ()
"Render once with final inputs regardless of batched source write order."
(dolist (order '((input render) (render input)))
(let ((buffer-name (format " *etaf-target-order-%S*" order))
(input (etaf-ref "A")) (render (etaf-ref 0)))
(setq etaf-test-priority-render-source render
etaf-test-priority-render-count 0)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-test-target-priority :label (etaf-value input))))
(setq etaf-test-priority-render-count 0)
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(before (etaf-runtime-generation runtime)))
(etaf-runtime-event-begin runtime)
(dolist (which order)
(if (eq which 'input)
(setf (etaf-value input) "B")
(setf (etaf-value render) 1)))
(etaf-runtime-event-end runtime)
(should (= 1 etaf-test-priority-render-count))
(should (= 1 (- (etaf-runtime-generation runtime) before)))
(should (equal "B/1" (etaf-test--buffer-text buffer-name)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))))
(ert-deftest etaf-runtime-local-component-retains-caller-style-environment ()
"Preserve caller style/slot environment across a Component-only update."
(let ((buffer-name " *etaf-local-style-environment-test*")
(source (etaf-ref "A")))
(setq etaf-test-local-style-source source)
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-local-style-parent)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime))
(effects (etaf--generation-source-effects generation source))
(parent (etaf--generation-semantic
generation '(etaf-test-local-style-parent (root)))))
(should-not (memq (etaf--semantic-component-effect-id parent)
effects))
(setf (etaf-value source) "B")
(with-current-buffer buffer-name
(let ((text (buffer-string)))
(should (equal "B" (substring-no-properties text)))
(should (equal '(:foreground "retained-color")
(get-text-property 0 'face text)))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-lazy-computed-owns-its-underlying-dependency ()
"Route Component to computed while its ordinary effect owns the base ref."
(let ((buffer-name " *etaf-lazy-computed-owner-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-lazy-computed-owner)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime)))
(should (etaf--generation-source-effects
generation etaf-test-lazy-computed-value))
(should-not (etaf--generation-source-effects
generation etaf-test-lazy-computed-base))
(should (= 1 (hash-table-count
(etaf-ref-subscribers
etaf-test-lazy-computed-base))))
(let ((before (etaf-runtime-generation runtime)))
(setf (etaf-value etaf-test-lazy-computed-base) 3)
(should (= (1+ before) (etaf-runtime-generation runtime)))
(should (equal "6" (etaf-test--buffer-text buffer-name))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-reactive-post-publication-write-runs-next-runtime-turn ()
"Drain a lifecycle source write as a distinct following Runtime turn."
(let ((buffer-name " *etaf-next-turn-test*")
(source (etaf-ref 0)) (target (etaf-ref 0))
(etaf-test-next-turn-target t)
(etaf-test-next-turn-source nil)
(etaf-test-next-turn-sink nil))
(unwind-protect
(progn
(setq etaf-test-next-turn-source source
etaf-test-next-turn-sink target)
(etaf-mount buffer-name
(etaf--view-call 'etaf-test-next-turn nil nil))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(before (etaf-runtime-generation runtime)))
(setf (etaf-value source) 1)
(should (= 2 (- (etaf-runtime-generation runtime) before)))
(should (equal "1/1" (etaf-test--buffer-text buffer-name)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-route-is-opaque-and-unmount-disarms-sources ()
"Keep sources free of Runtime closures and remove route tokens on unmount."
(let ((buffer-name " *etaf-route-lifetime-test*") (source (etaf-ref 0)))
(let ((baseline (hash-table-count (etaf-ref-subscribers source))))
(etaf-mount buffer-name
(etaf--view-call 'etaf-test-dependency-only
(list :source source) nil))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(route (etaf-runtime-route-token runtime)))
(should (symbolp (etaf-runtime-route-scheduler route)))
(should-not (functionp (etaf-runtime-route-runtime-id route)))
(should (gethash route (etaf-ref-subscribers source)))
(etaf-unmount runtime)
(should (= baseline (hash-table-count (etaf-ref-subscribers source)))))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-participant-publish-failure-restores-generation ()
"Restore generation and Ebox state when participant publish fails after swap."
(let ((buffer-name " *etaf-generation-rollback-test*")
(source (etaf-ref 0))
(etaf-test-retained-render-counts (make-hash-table :test #'eql)))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf--view-call 'etaf-test-retained-leaf
(list :label 1 :cell source) nil))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(old-generation (etaf-runtime-current-generation runtime))
(old-swap (symbol-function 'etaf--runtime-swap-generation))
(old-rollback
(symbol-function 'etaf--runtime-participant-rollback))
(resource-count
(hash-table-count (etaf-runtime-resource-registry runtime)))
(artifact-count
(hash-table-count (etaf-runtime-artifact-registry runtime)))
rollback-saw-old)
(cl-letf (((symbol-function 'etaf--runtime-swap-generation)
(lambda (&rest args)
(apply old-swap args)
(error "injected participant publish failure")))
((symbol-function 'etaf--runtime-participant-rollback)
(lambda (participant)
(setq rollback-saw-old
(eq old-generation
(etaf-runtime-current-generation runtime)))
(funcall old-rollback participant))))
(should-error (setf (etaf-value source) 1) :type 'error))
(should rollback-saw-old)
(should (eq old-generation
(etaf-runtime-current-generation runtime)))
(should (equal "1=0" (etaf-test--buffer-text buffer-name)))
(should (= resource-count
(hash-table-count
(etaf-runtime-resource-registry runtime))))
(should (<= (hash-table-count
(etaf-runtime-artifact-registry runtime))
artifact-count))
(etaf-runtime-flush runtime)
(should (equal "1=1" (etaf-test--buffer-text buffer-name)))
(should (= (1+ (etaf-generation-generation-id old-generation))
(etaf-runtime-generation runtime)))
(let ((committed (etaf-runtime-current-generation runtime)))
(cl-letf (((symbol-function 'accept-change-group)
(lambda (&rest _)
(error "injected TP final accept failure"))))
(should-error (setf (etaf-value source) 2) :type 'error))
(should (eq committed (etaf-runtime-current-generation runtime)))
(should (equal "1=1" (etaf-test--buffer-text buffer-name)))
(should (= resource-count
(hash-table-count
(etaf-runtime-resource-registry runtime))))
(should (<= (hash-table-count
(etaf-runtime-artifact-registry runtime))
artifact-count))
(etaf-runtime-flush runtime)
(should (equal "1=2" (etaf-test--buffer-text buffer-name))))
(let ((committed (etaf-runtime-current-generation runtime)))
(cl-letf (((symbol-function 'ebox-commit)
(lambda (&rest _)
(error "injected Ebox pre-publish failure"))))
(should-error (setf (etaf-value source) 3) :type 'error))
(should (eq committed (etaf-runtime-current-generation runtime)))
(should (equal "1=2" (etaf-test--buffer-text buffer-name)))
(etaf-runtime-flush runtime)
(should (equal "1=3" (etaf-test--buffer-text buffer-name))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-artifact-registry-stays-bounded ()
"Discard superseded artifacts after repeated Component publications."
(let ((buffer-name " *etaf-artifact-bound-test*") (source (etaf-ref 0))
(etaf-test-retained-render-counts (make-hash-table :test #'eql)))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf--view-call 'etaf-test-retained-leaf
(list :label 1 :cell source) nil))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(baseline (hash-table-count
(etaf-runtime-artifact-registry runtime))))
(dotimes (index 100)
(setf (etaf-value source) (1+ index)))
(should (<= (hash-table-count
(etaf-runtime-artifact-registry runtime))
baseline))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-prepublication-journals-are-exception-atomic ()
"Rollback partial resource, artifact, and route installation immediately."
(dolist (phase '(resource artifact route))
(let* ((buffer-name (format " *etaf-journal-%S-test*" phase))
(source (etaf-ref 0))
(baseline (hash-table-count (etaf-ref-subscribers source)))
(old-puthash (symbol-function 'puthash))
(etaf-test-retained-render-counts (make-hash-table :test #'eql)))
(cl-letf
(((symbol-function 'puthash)
(lambda (key value table)
(let ((result (funcall old-puthash key value table)))
(when
(pcase phase
('resource
(and (consp key) (integerp (car key))
(integerp (cdr key))
(etaf--component-instance-p value)))
('artifact
(and (consp key) (integerp (car key))
(integerp (cdr key)) (listp value)
(plist-member value :node)))
('route (etaf-runtime-route-p key)))
(error "injected %S journal write" phase))
result))))
(should-error
(etaf-mount buffer-name
(etaf--view-call 'etaf-test-retained-leaf
(list :label 1 :cell source) nil))
:type 'error))
(should-not (etaf-runtime-for-buffer buffer-name))
(should (= baseline (hash-table-count (etaf-ref-subscribers source))))
(etaf-mount buffer-name
(etaf--view-call 'etaf-test-retained-leaf
(list :label 1 :cell source) nil))
(etaf-unmount (etaf-runtime-for-buffer buffer-name))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-route-arm-kth-failure-is-bounded-and-retryable ()
"Rollback each partial route arm and keep repeated failures bounded."
(dolist (failure-index '(1 2))
(let* ((buffer-name (format " *etaf-route-kth-%s-test*" failure-index))
(show (etaf-ref nil)) (left (etaf-ref 0)) (right (etaf-ref 0))
(etaf-test-retained-render-counts (make-hash-table :test #'eql))
(view (lambda ()
(if (etaf-value show)
(etaf--view-call
'column nil
(list
(etaf--view-call 'etaf-test-retained-leaf
(list :key 'left :label 1 :cell left)
nil)
(etaf--view-call 'etaf-test-retained-leaf
(list :key 'right :label 2 :cell right)
nil)))
(etaf--view-call 'text nil (list "empty"))))))
(unwind-protect
(progn
(etaf-mount buffer-name view)
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(old-generation (etaf-runtime-current-generation runtime))
(baseline-routes
(hash-table-count (etaf-runtime-route-sources runtime)))
(old-puthash (symbol-function 'puthash))
(writes 0))
(cl-letf
(((symbol-function 'puthash)
(lambda (key value table)
(let ((result (funcall old-puthash key value table)))
(when (and (etaf-runtime-route-p key)
(memq table (list (etaf-ref-subscribers left)
(etaf-ref-subscribers right))))
(cl-incf writes)
(when (= writes failure-index)
(error "injected kth route arm")))
result))))
(should-error (setf (etaf-value show) t) :type 'error))
(should (eq old-generation
(etaf-runtime-current-generation runtime)))
(should (zerop (hash-table-count (etaf-ref-subscribers left))))
(should (zerop (hash-table-count (etaf-ref-subscribers right))))
(should (= baseline-routes
(hash-table-count
(etaf-runtime-route-sources runtime))))
(etaf-runtime-flush runtime)
(should (string-match-p "1=0"
(etaf-test--buffer-text buffer-name)))
(etaf-unmount runtime)
(should (zerop (hash-table-count (etaf-ref-subscribers left))))
(should (zerop (hash-table-count
(etaf-ref-subscribers right))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))))
(ert-deftest etaf-runtime-published-generation-resolves-new-resource ()
"Make every newly published resource membership immediately resolvable."
(let* ((buffer-name " *etaf-publish-resource-visibility-test*")
(show (etaf-ref nil)) (cell (etaf-ref 0)) (checked 0)
(etaf-test-retained-render-counts (make-hash-table :test #'eql))
(view
(lambda ()
(if (etaf-value show)
(etaf--view-call 'etaf-test-retained-leaf
(list :key 'new :label 1 :cell cell) nil)
(etaf--view-call 'text nil (list "empty"))))))
(unwind-protect
(progn
(etaf-mount buffer-name view)
(let ((old-publish
(symbol-function 'etaf--runtime-participant-publish)))
(cl-letf
(((symbol-function 'etaf--runtime-participant-publish)
(lambda (participant)
(prog1 (funcall old-publish participant)
(let* ((runtime
(etaf--generation-participant-runtime participant))
(generation
(etaf-runtime-current-generation runtime)))
(maphash
(lambda (_identity semantic-id)
(let ((semantic
(etaf--pvec-get
(etaf-generation-semantic-nodes generation)
semantic-id)))
(when (etaf--semantic-component-p semantic)
(should
(gethash
(etaf--semantic-component-resource-key semantic)
(etaf-runtime-resource-registry runtime)))
(cl-incf checked))))
(etaf-generation-identity-index generation)))))))
(setf (etaf-value show) t)))
(should (= 1 checked)))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-local-parent-does-not-carry-unchanged-descendants ()
"Avoid generation subtree carry for 500 unchanged children of a dirty parent."
(let ((buffer-name " *etaf-wide-parent-local-test*")
(etaf-test-retained-render-counts (make-hash-table :test #'eql)))
(setq etaf-test-wide-parent-source (etaf-ref 0)
etaf-test-wide-parent-cells
(cl-loop repeat 500 collect (etaf-ref 0)))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-wide-parent)))
(clrhash etaf-test-retained-render-counts)
(let ((runtime (etaf-runtime-for-buffer buffer-name)))
(cl-letf (((symbol-function 'etaf--runtime-carry-committed-subtree)
(lambda (&rest _)
(error "local path attempted committed subtree carry"))))
(setf (etaf-value etaf-test-wide-parent-source) 1))
(should (zerop (hash-table-count
etaf-test-retained-render-counts)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-direct-expr-publishes-child-range-only ()
"Publish a direct material-child expr without running its Component owner."
(let ((buffer-name " *etaf-direct-range-test*")
(etaf-test-range-source (etaf-ref nil))
(etaf-test-range-static-count 10)
(etaf-test-range-evals 0)
(etaf-test-range-component-renders 0)
(range-replaces 0) (host-replaces 0) (commits 0))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-public-direct-range)))
(setq etaf-test-range-evals 0
etaf-test-range-component-renders 0)
(let ((old-range (symbol-function 'ebox-candidate-replace-range-ref))
(old-host (symbol-function 'ebox-candidate-replace-host-ref))
(old-commit (symbol-function 'ebox-commit))
(runtime (etaf-runtime-for-buffer buffer-name)))
(cl-letf (((symbol-function 'ebox-candidate-replace-range-ref)
(lambda (&rest args)
(cl-incf range-replaces) (apply old-range args)))
((symbol-function 'ebox-candidate-replace-host-ref)
(lambda (&rest args)
(cl-incf host-replaces) (apply old-host args)))
((symbol-function 'ebox-commit)
(lambda (&rest args)
(cl-incf commits) (apply old-commit args)))
((symbol-function 'etaf--runtime-render-dirty-component)
(lambda (&rest _)
(error "Public Range entered Component owner")))
((symbol-function 'etaf--runtime-evaluate-root-candidate)
(lambda (&rest _)
(error "Public Range entered Root owner"))))
(let ((before (etaf-runtime-generation runtime)))
(setf (etaf-value etaf-test-range-source) '((item . "I")))
(should (= 1 (- (etaf-runtime-generation runtime) before)))))
(should (= 1 etaf-test-range-evals))
(should (zerop etaf-test-range-component-renders))
(should (= 1 range-replaces))
(should (zerop host-replaces))
(should (= 1 commits))
(should (string-match-p "I" (etaf-test--buffer-text buffer-name)))
(let* ((generation (etaf-runtime-current-generation runtime))
(range-id
(cl-loop for identity being the hash-keys of
(etaf-generation-identity-index generation)
using (hash-values semantic-id)
when (eq (car-safe identity) 'range)
return semantic-id))
(range (etaf--pvec-get
(etaf-generation-semantic-nodes generation) range-id)))
(should (integerp range-id))
(should (etaf--semantic-range-p range))
(should (integerp (etaf--semantic-range-parent-id range)))
(should (= 1 (length (etaf--semantic-range-item-host-ids range))))
(should
(equal '(range)
(mapcar
(lambda (effect-id)
(etaf--generation-effect-kind
(etaf--generation-effect generation effect-id)))
(etaf--generation-source-effects
generation etaf-test-range-source))))
(cl-labels
((walk (parent-id)
(dolist (child-id
(etaf--pvec-get
(etaf-generation-children-table generation)
parent-id))
(should (integerp child-id))
(should (= parent-id
(etaf--pvec-get
(etaf-generation-parent-table generation)
child-id)))
(walk child-id))))
(walk 0)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-view-expr-callsite-token-is-stable ()
"Give repeated values from one compiled expr site the same opaque token."
(let* ((spec etaf-test-macro-range-token--etaf-component-definition)
(render (etaf--component-spec-render spec))
(left (funcall render nil nil))
(right (funcall render nil nil))
(left-expr (car (etaf--view-node-children left)))
(right-expr (car (etaf--view-node-children right))))
(should (etaf--expr-token left-expr))
(should (eq (etaf--expr-token left-expr)
(etaf--expr-token right-expr)))))
(ert-deftest etaf-runtime-public-expr-token-addresses-one-range-across-mounts ()
"Carry one macro-generated expr token into exactly one mounted Range site."
(let ((etaf-test-range-source (etaf-ref nil)) tokens)
(dolist (buffer-name '(" *etaf-public-range-token-a*"
" *etaf-public-range-token-b*"))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-public-direct-range)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime))
ranges)
(maphash
(lambda (identity semantic-id)
(when (eq (car-safe identity) 'range)
(push (etaf--pvec-get
(etaf-generation-semantic-nodes generation)
semantic-id)
ranges)))
(etaf-generation-identity-index generation))
(should (= 1 (length ranges)))
(push (etaf--semantic-range-token (car ranges)) tokens)))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))
(should (eq (car tokens) (cadr tokens)))))
(ert-deftest etaf-runtime-does-not-encode-ebox-layout-shapes ()
"Keep resolved backend layout construction in the Renderer port."
(let ((source (with-temp-buffer
(insert-file-contents "etaf-runtime.el")
(buffer-string))))
(should-not (string-match-p ":ebox-type" source))))
(ert-deftest etaf-runtime-direct-range-gate-a-transitions ()
"Meet direct Range bounds for 10/100/500 static siblings and keyed survival."
(dolist (fixture '((10 . 2) (100 . 3) (500 . 3)))
(let* ((static-count (car fixture)) (bound (cdr fixture))
(buffer-name (format " *etaf-range-gate-%s*" static-count))
(etaf-test-range-source (etaf-ref nil))
(etaf-test-range-static-count static-count)
(etaf-test-range-evals 0)
(etaf-test-range-component-renders 0)
range-id range-ref a-id b-id static-records)
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-direct-range)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime)))
(setq range-id
(cl-loop for identity being the hash-keys of
(etaf-generation-identity-index generation)
using (hash-values semantic-id)
when (eq (car-safe identity) 'range)
return semantic-id))
(setq range-ref
(etaf--semantic-range-range-ref
(etaf--pvec-get
(etaf-generation-semantic-nodes generation) range-id)))
(let* ((range (etaf--pvec-get
(etaf-generation-semantic-nodes generation)
range-id))
(parent-id (etaf--semantic-range-parent-id range)))
(setq static-records
(cl-loop for child-id in
(etaf--pvec-get
(etaf-generation-children-table generation)
parent-id)
unless (= child-id range-id)
collect
(cons child-id
(etaf--pvec-get
(etaf-generation-semantic-nodes generation)
child-id)))))
(dolist (items (list '((a . "A"))
'((a . "A") (b . "B"))
'((b . "B2")) nil))
(setq etaf-test-range-evals 0
etaf-test-range-component-renders 0)
(let ((before (etaf-runtime-generation runtime))
(old-identity-index
(etaf-generation-identity-index
(etaf-runtime-current-generation runtime))))
(cl-letf
(((symbol-function 'etaf--runtime-render-dirty-component)
(lambda (&rest _)
(error "Range update entered Component owner")))
((symbol-function 'etaf--runtime-evaluate-root-candidate)
(lambda (&rest _)
(error "Range update entered Root owner"))))
(setf (etaf-value etaf-test-range-source) items))
(should (= 1 (- (etaf-runtime-generation runtime) before)))
(should (eq old-identity-index
(etaf-generation-identity-index
(etaf-runtime-current-generation runtime)))))
(should (= 1 etaf-test-range-evals))
(should (zerop etaf-test-range-component-renders))
(let* ((generation (etaf-runtime-current-generation runtime))
(range (etaf--pvec-get
(etaf-generation-semantic-nodes generation)
range-id))
(metrics (car (plist-get
(plist-get (ebox-buffer-update-report
buffer-name)
:range-metrics)
:parents))))
(should (eq range-ref (etaf--semantic-range-range-ref range)))
(should (<= (plist-get metrics :segment-visits) bound))
(should (<= (plist-get metrics :segment-copies) bound))
(should (= (plist-get metrics :new-payload-visits)
(length items)))
(should (zerop (plist-get metrics
:unaffected-payload-visits)))
(should (= 1 (plist-get
(plist-get (ebox-buffer-update-report buffer-name)
:range-metrics)
:replacement-count)))
(when (equal items '((b . "B2")))
(should (zerop (plist-get (ebox-buffer-update-report
buffer-name)
:created-objects))))
(dolist (entry static-records)
(should (eq (cdr entry)
(etaf--pvec-get
(etaf-generation-semantic-nodes generation)
(car entry)))))
(when (assoc 'a items)
(let ((id (gethash
(list 'host range-id :key 'a)
(etaf--semantic-range-item-identity-index range))))
(if a-id (should (= a-id id)) (setq a-id id))))
(when (assoc 'b items)
(let ((id (gethash
(list 'host range-id :key 'b)
(etaf--semantic-range-item-identity-index range))))
(if b-id (should (= b-id id)) (setq b-id id))))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))))
(ert-deftest etaf-runtime-two-direct-ranges-batch-one-publication ()
"Evaluate and splice two disjoint Ranges once in one logical commit."
(let ((buffer-name " *etaf-two-range-test*")
(etaf-test-range-source (etaf-ref nil))
(etaf-test-range-left-evals 0) (etaf-test-range-right-evals 0)
(range-replaces 0) (commits 0))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-two-direct-ranges)))
(setq etaf-test-range-left-evals 0 etaf-test-range-right-evals 0)
(let ((old-range (symbol-function 'ebox-candidate-replace-range-ref))
(old-commit (symbol-function 'ebox-commit))
(runtime (etaf-runtime-for-buffer buffer-name)))
(cl-letf (((symbol-function 'ebox-candidate-replace-range-ref)
(lambda (&rest args)
(cl-incf range-replaces) (apply old-range args)))
((symbol-function 'ebox-commit)
(lambda (&rest args)
(cl-incf commits) (apply old-commit args))))
(let ((before (etaf-runtime-generation runtime)))
(setf (etaf-value etaf-test-range-source) '((x . "X")))
(should (= 1 (- (etaf-runtime-generation runtime) before)))))
(should (= 1 etaf-test-range-left-evals))
(should (= 1 etaf-test-range-right-evals))
(should (= 2 range-replaces))
(should (= 1 commits))
(should (= 1 (hash-table-count
(etaf-ref-subscribers etaf-test-range-source))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-range-artifact-survives-root-rebuild ()
"Relower current Range graph after Root change without application thunks."
(let* ((buffer-name " *etaf-range-root-coherence-test*")
(etaf-test-range-source (etaf-ref nil))
(etaf-test-range-static-count 10)
(etaf-test-range-evals 0)
(etaf-test-range-component-renders 0)
(etaf-test-range-host-prop-calls 0)
(root-source (etaf-ref nil))
(root-calls 0)
(view
(lambda ()
(cl-incf root-calls)
(etaf--view-call
'column nil
(append
(list (etaf--view-call 'text (list :key 'head) (list "H")))
(and (etaf-value root-source)
(list (etaf--view-call 'text (list :key 'inserted)
(list "X"))))
(list (etaf--view-call 'etaf-test-direct-range
(list :key 'range-owner) nil)))))))
(unwind-protect
(progn
(etaf-mount buffer-name view)
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime))
(range-id
(cl-loop for identity being the hash-keys of
(etaf-generation-identity-index generation)
using (hash-values semantic-id)
when (eq (car-safe identity) 'range)
return semantic-id))
(range-ref
(etaf--semantic-range-range-ref
(etaf--pvec-get (etaf-generation-semantic-nodes generation)
range-id))))
(setf (etaf-value etaf-test-range-source) '((a . "A")))
(setq etaf-test-range-evals 0
etaf-test-range-component-renders 0)
(let ((prop-calls etaf-test-range-host-prop-calls))
(setf (etaf-value root-source) t)
(should (zerop etaf-test-range-evals))
(should (zerop etaf-test-range-component-renders))
(should (= prop-calls etaf-test-range-host-prop-calls)))
(let* ((generation (etaf-runtime-current-generation runtime))
(range (etaf--pvec-get
(etaf-generation-semantic-nodes generation) range-id)))
(should (eq range-ref (etaf--semantic-range-range-ref range)))
(should (string-match-p "A" (etaf-test--buffer-text buffer-name))))
(setq etaf-test-range-evals 0)
(setf (etaf-value etaf-test-range-source) '((b . "B")))
(should (= 1 etaf-test-range-evals))
(should (string-match-p "B" (etaf-test--buffer-text buffer-name)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-range-address-survives-preceding-static-insert ()
"Keep Range id/ref when its material parent's preceding siblings change."
(let ((buffer-name " *etaf-range-static-insert-test*")
(count (etaf-ref 2))
(etaf-test-range-source (etaf-ref nil))
(etaf-test-range-evals 0))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-test-counted-direct-range :count (etaf-value count))))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime))
(range-id
(cl-loop for identity being the hash-keys of
(etaf-generation-identity-index generation)
using (hash-values semantic-id)
when (eq (car-safe identity) 'range)
return semantic-id))
(range-ref
(etaf--semantic-range-range-ref
(etaf--pvec-get (etaf-generation-semantic-nodes generation)
range-id))))
(setq etaf-test-range-evals 0)
(setf (etaf-value count) 5)
(should (zerop etaf-test-range-evals))
(let* ((generation (etaf-runtime-current-generation runtime))
(range (etaf--pvec-get
(etaf-generation-semantic-nodes generation) range-id)))
(should (eq range-ref (etaf--semantic-range-range-ref range))))
(setf (etaf-value etaf-test-range-source) '((a . "A")))
(should (= 1 etaf-test-range-evals))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-range-rebuild-keeps-bare-string-siblings ()
"Keep mounted synthetic string Hosts through Range invalidation and rebuild."
(let* ((buffer-name " *etaf-range-string-siblings-test*")
(etaf-test-range-source (etaf-ref nil))
(root-source (etaf-ref 0))
(view (lambda ()
(etaf-value root-source)
(etaf--view-call 'etaf-test-string-sibling-range
(list :key 'owner) nil))))
(unwind-protect
(progn
(etaf-mount buffer-name view)
(setf (etaf-value etaf-test-range-source) '((a . "A")))
(setf (etaf-value root-source) 1)
(let ((text (etaf-test--buffer-text buffer-name)))
(should (string-match-p "prefix" text))
(should (string-match-p "A" text))
(should (string-match-p "suffix" text))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-range-failure-rolls-back-and-manual-retries ()
"Restore Range graph/artifacts/buffer for prepublish and final-accept failure."
(let ((buffer-name " *etaf-range-rollback-test*")
(etaf-test-range-source (etaf-ref nil))
(etaf-test-range-static-count 10))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-direct-range)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(old-generation (etaf-runtime-current-generation runtime))
(range-id
(cl-loop for identity being the hash-keys of
(etaf-generation-identity-index old-generation)
using (hash-values semantic-id)
when (eq (car-safe identity) 'range)
return semantic-id))
(old-range
(etaf--pvec-get (etaf-generation-semantic-nodes old-generation)
range-id))
(artifact-count
(hash-table-count (etaf-runtime-range-artifact-registry runtime))))
(cl-letf (((symbol-function 'ebox-candidate-replace-range-ref)
(lambda (&rest _)
(error "injected Range prepublish failure"))))
(should-error
(setf (etaf-value etaf-test-range-source) '((a . "A")))
:type 'error))
(should (eq old-generation (etaf-runtime-current-generation runtime)))
(should (eq old-range
(etaf--pvec-get
(etaf-generation-semantic-nodes
(etaf-runtime-current-generation runtime))
range-id)))
(should (= artifact-count
(hash-table-count
(etaf-runtime-range-artifact-registry runtime))))
(etaf-runtime-flush runtime)
(should (string-match-p "A" (etaf-test--buffer-text buffer-name)))
(let ((committed (etaf-runtime-current-generation runtime)))
(cl-letf (((symbol-function 'accept-change-group)
(lambda (&rest _)
(error "injected Range final accept failure"))))
(should-error
(setf (etaf-value etaf-test-range-source)
'((a . "A") (b . "B")))
:type 'error))
(should (eq committed (etaf-runtime-current-generation runtime)))
(should-not (string-match-p "B"
(etaf-test--buffer-text buffer-name)))
(etaf-runtime-flush runtime)
(should (string-match-p "B"
(etaf-test--buffer-text buffer-name))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-direct-range-rejects-step4b-output-without-reownership ()
"Reject direct Component/raw output while retaining Range-only dependency."
(dolist (unsupported '(component raw deep-component deep-raw
deep-expr-component))
(let ((buffer-name (format " *etaf-range-unsupported-%S*" unsupported))
(etaf-test-unsupported-range-source (etaf-ref 'host)))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view (etaf-test-unsupported-direct-range)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime)))
(should-error
(setf (etaf-value etaf-test-unsupported-range-source)
unsupported)
:type 'etaf-runtime-error)
(should (eq generation (etaf-runtime-current-generation runtime)))
(should
(equal '(range)
(mapcar
(lambda (effect-id)
(etaf--generation-effect-kind
(etaf--generation-effect generation effect-id)))
(etaf--generation-source-effects
generation etaf-test-unsupported-range-source))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))))
(ert-deftest etaf-runtime-direct-range-normalizes-bare-string-item ()
"Represent a bare direct expr string as one synthetic semantic text Host."
(let ((buffer-name " *etaf-string-range-test*")
(etaf-test-string-range-source (etaf-ref nil)))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-public-string-range)))
(setf (etaf-value etaf-test-string-range-source) "hello")
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime))
(range-id
(car (etaf--generation-source-effects
generation etaf-test-string-range-source)))
(effect (etaf--generation-effect generation range-id))
(range (etaf--pvec-get
(etaf-generation-semantic-nodes generation)
(etaf--generation-effect-semantic-id effect))))
(should (eq 'range (etaf--generation-effect-kind effect)))
(should (= 1 (length (etaf--semantic-range-item-host-ids range))))
(should (string-match-p "hello"
(etaf-test--buffer-text buffer-name)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-range-recursively-retains-and-removes-host-subtree ()
"Retain keyed nested Hosts and tombstone their full removed subtree."
(let ((buffer-name " *etaf-nested-range-hosts-test*")
(etaf-test-nested-range-present (etaf-ref t))
(etaf-test-nested-range-source (etaf-ref (cons "A" nil)))
(etaf-test-nested-range-evals 0))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-nested-host-range)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime))
(effect-id (car (etaf--generation-source-effects
generation etaf-test-nested-range-source)))
(effect (etaf--generation-effect generation effect-id))
(range-id (etaf--generation-effect-semantic-id effect))
(range (etaf--pvec-get
(etaf-generation-semantic-nodes generation) range-id))
(nested-id
(cl-loop for identity being the hash-keys of
(etaf--semantic-range-item-identity-index range)
using (hash-values semantic-id)
when (equal (plist-get (cddr identity) :key) 'nested)
return semantic-id)))
(setq etaf-test-nested-range-evals 0)
(cl-letf (((symbol-function 'etaf--runtime-render-dirty-component)
(lambda (&rest _)
(error "Nested Range entered Component owner"))))
(setf (etaf-value etaf-test-nested-range-source)
(cons "B" t)))
(should (= 1 etaf-test-nested-range-evals))
(should (= 1 (plist-get
(plist-get (ebox-buffer-update-report buffer-name)
:range-metrics)
:replacement-count)))
(let* ((generation (etaf-runtime-current-generation runtime))
(range (etaf--pvec-get
(etaf-generation-semantic-nodes generation) range-id)))
(should (= nested-id
(cl-loop for identity being the hash-keys of
(etaf--semantic-range-item-identity-index range)
using (hash-values semantic-id)
when (equal (plist-get (cddr identity) :key)
'nested)
return semantic-id)))
(should
(equal '(range)
(mapcar
(lambda (id)
(etaf--generation-effect-kind
(etaf--generation-effect generation id)))
(etaf--generation-source-effects
generation etaf-test-nested-range-source))))
(let* ((old-generation generation)
(old-range range)
(removed-ids
(etaf--runtime-generation-descendant-ids
old-generation
(etaf--semantic-range-item-host-ids old-range))))
(setf (etaf-value etaf-test-nested-range-present) nil)
(let ((new-generation
(etaf-runtime-current-generation runtime)))
(dolist (semantic-id removed-ids)
(should (etaf--pvec-get
(etaf-generation-semantic-nodes old-generation)
semantic-id))
(should-not (etaf--pvec-get
(etaf-generation-semantic-nodes new-generation)
semantic-id))
(should-not (etaf--pvec-get
(etaf-generation-parent-table new-generation)
semantic-id))
(should-not (etaf--pvec-get
(etaf-generation-children-table new-generation)
semantic-id))))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-inline-effect-replaces-only-containing-host ()
"Update one inline site beside 500 unrelated Components with one Host commit."
(let* ((buffer-name " *etaf-inline-host-update-test*")
(etaf-test-inline-a (etaf-ref "0"))
(etaf-test-inline-b (etaf-ref "0"))
(etaf-test-inline-a-evals 0) (etaf-test-inline-b-evals 0)
(etaf-test-inline-component-renders 0)
(etaf-test-inline-updated-count 0)
(etaf-test-retained-render-counts (make-hash-table :test #'eql))
(cells (cl-loop repeat 500 collect (etaf-ref 0)))
(host-replaces 0) (range-replaces 0) (commits 0)
(view
(etaf--view-call
'column nil
(cons (etaf--view-call 'etaf-test-inline-owner
(list :key 'owner) nil)
(cl-loop for cell in cells for index from 0
collect
(etaf--view-call
'etaf-test-retained-leaf
(list :key index :label index :cell cell) nil))))))
(unwind-protect
(progn
(etaf-mount buffer-name view)
(setq etaf-test-inline-a-evals 0 etaf-test-inline-b-evals 0
etaf-test-inline-component-renders 0
etaf-test-inline-updated-count 0)
(clrhash etaf-test-retained-render-counts)
(let ((old-host (symbol-function 'ebox-candidate-replace-host-ref))
(old-range (symbol-function 'ebox-candidate-replace-range-ref))
(old-commit (symbol-function 'ebox-commit))
(runtime (etaf-runtime-for-buffer buffer-name)))
(cl-letf (((symbol-function 'ebox-candidate-replace-host-ref)
(lambda (&rest args)
(cl-incf host-replaces) (apply old-host args)))
((symbol-function 'ebox-candidate-replace-range-ref)
(lambda (&rest args)
(cl-incf range-replaces) (apply old-range args)))
((symbol-function 'ebox-commit)
(lambda (&rest args)
(cl-incf commits) (apply old-commit args))))
(let ((before (etaf-runtime-generation runtime)))
(setf (etaf-value etaf-test-inline-a) "1")
(should (= 1 (- (etaf-runtime-generation runtime) before)))))
(should (= 1 etaf-test-inline-a-evals))
(should (zerop etaf-test-inline-b-evals))
(should (zerop etaf-test-inline-component-renders))
(should (zerop (hash-table-count etaf-test-retained-render-counts)))
(should (= 1 host-replaces))
(should (zerop range-replaces))
(should (= 1 commits))
(should (= 1 etaf-test-inline-updated-count))
(should (string-match-p "A1B0"
(etaf-test--buffer-text buffer-name)))
(let* ((generation (etaf-runtime-current-generation runtime))
(effect-id (car (etaf--generation-source-effects
generation etaf-test-inline-a)))
(inline (etaf--generation-effect-semantic
generation effect-id))
(host-id (etaf--semantic-inline-range-parent-id inline))
(component-id
(etaf--pvec-get (etaf-generation-parent-table generation)
host-id))
(component
(etaf--pvec-get (etaf-generation-semantic-nodes generation)
component-id)))
(should (eq 'inline
(etaf--generation-effect-kind
(etaf--generation-effect generation effect-id))))
(should (integerp host-id))
(should (etaf--semantic-component-p component))
(should (integerp (etaf--semantic-component-parent-id component)))
(should (= host-id
(etaf--pvec-get
(etaf-generation-parent-table generation)
(etaf--semantic-inline-range-semantic-id inline)))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-inline-effects-coalesce-per-host ()
"Coalesce two inline effects in one Host and split two distinct Hosts."
(let ((buffer-name " *etaf-inline-coalesce-test*")
(etaf-test-inline-a (etaf-ref "0"))
(etaf-test-inline-b (etaf-ref "0"))
(etaf-test-inline-a-evals 0) (etaf-test-inline-b-evals 0)
(etaf-test-inline-updated-count 0)
(host-replaces 0) (commits 0))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-inline-owner)))
(setq etaf-test-inline-a-evals 0 etaf-test-inline-b-evals 0
etaf-test-inline-updated-count 0)
(let ((old-host (symbol-function 'ebox-candidate-replace-host-ref))
(old-commit (symbol-function 'ebox-commit))
(runtime (etaf-runtime-for-buffer buffer-name)))
(cl-letf (((symbol-function 'ebox-candidate-replace-host-ref)
(lambda (&rest args)
(cl-incf host-replaces) (apply old-host args)))
((symbol-function 'ebox-commit)
(lambda (&rest args)
(cl-incf commits) (apply old-commit args))))
(etaf-runtime-event-begin runtime)
(setf (etaf-value etaf-test-inline-a) "1")
(setf (etaf-value etaf-test-inline-b) "2")
(etaf-runtime-event-end runtime))
(should (= 1 etaf-test-inline-a-evals))
(should (= 1 etaf-test-inline-b-evals))
(should (= 1 host-replaces))
(should (= 1 commits))
(should (= 1 etaf-test-inline-updated-count))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))
(let ((buffer-name " *etaf-inline-two-host-test*")
(etaf-test-inline-shared (etaf-ref "0"))
(etaf-test-inline-shared-evals 0)
(host-replaces 0) (commits 0))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-inline-shared-hosts)))
(setq etaf-test-inline-shared-evals 0)
(let ((old-host (symbol-function 'ebox-candidate-replace-host-ref))
(old-commit (symbol-function 'ebox-commit)))
(cl-letf (((symbol-function 'ebox-candidate-replace-host-ref)
(lambda (&rest args)
(cl-incf host-replaces) (apply old-host args)))
((symbol-function 'ebox-commit)
(lambda (&rest args)
(cl-incf commits) (apply old-commit args))))
(setf (etaf-value etaf-test-inline-shared) "1")))
(should (= 2 etaf-test-inline-shared-evals))
(should (= 2 host-replaces))
(should (= 1 commits)))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-inline-output-equal-promotes-dependencies-only ()
"Promote an inline branch dependency change without Ebox publication."
(let ((buffer-name " *etaf-inline-dependency-only-test*")
(etaf-test-inline-branch-mode (etaf-ref nil))
(etaf-test-inline-branch-left (etaf-ref 0))
(etaf-test-inline-branch-right (etaf-ref 0))
(etaf-test-inline-branch-evals 0)
(etaf-test-inline-branch-updated 0)
(commits 0))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-inline-dependency-branch)))
(setq etaf-test-inline-branch-evals 0)
(let ((runtime (etaf-runtime-for-buffer buffer-name))
(old-commit (symbol-function 'ebox-commit)))
(cl-letf (((symbol-function 'ebox-commit)
(lambda (&rest args)
(cl-incf commits) (apply old-commit args))))
(let ((before (etaf-runtime-generation runtime)))
(setf (etaf-value etaf-test-inline-branch-mode) t)
(should (= 1 (- (etaf-runtime-generation runtime) before))))
(should (zerop commits))
(should (zerop etaf-test-inline-branch-updated))
(let* ((generation (etaf-runtime-current-generation runtime))
(before (etaf-runtime-generation runtime)))
(should-not (etaf--generation-source-effects
generation etaf-test-inline-branch-left))
(should (etaf--generation-source-effects
generation etaf-test-inline-branch-right))
(setf (etaf-value etaf-test-inline-branch-left) 1)
(should (= before (etaf-runtime-generation runtime)))
(setf (etaf-value etaf-test-inline-branch-right) 1)
(should (= (1+ before) (etaf-runtime-generation runtime)))
(should (zerop commits))
(should (zerop etaf-test-inline-branch-updated))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-slot-inline-keeps-authoring-component-environment ()
"Read authoring parent props through default and forwarded named slots."
(dolist (component '(etaf-test-slot-env-parent
etaf-test-slot-env-named-parent))
(let ((buffer-name (format " *etaf-slot-env-%S*" component))
(label (etaf-ref "A")))
(setq etaf-test-slot-parent-renders 0
etaf-test-slot-forwarder-renders 0
etaf-test-slot-consumer-renders 0)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf--view-call component
(list :label
(etaf--expr-create
:thunk (lambda () (etaf-value label))))
nil))
(should (equal "A" (etaf-test--buffer-text buffer-name)))
(setq etaf-test-slot-parent-renders 0
etaf-test-slot-forwarder-renders 0
etaf-test-slot-consumer-renders 0)
(setf (etaf-value label) "B")
(should (equal "B" (etaf-test--buffer-text buffer-name)))
(should (= 1 etaf-test-slot-parent-renders))
(should (zerop etaf-test-slot-forwarder-renders))
(should (zerop etaf-test-slot-consumer-renders)))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))))
(ert-deftest etaf-runtime-nested-component-input-reads-caller-candidate-props ()
"Resolve child input thunks from final candidate parent props."
(let ((buffer-name " *etaf-nested-prop-env-test*") (label (etaf-ref "A")))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view (etaf-test-prop-env-parent :label (etaf-value label))))
(should (equal "A" (etaf-test--buffer-text buffer-name)))
(setf (etaf-value label) "B")
(should (equal "B" (etaf-test--buffer-text buffer-name))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-inline-and-input-fixed-point-uses-final-props-once ()
"Run input, inline, and Component render once for either source write order."
(dolist (order '((input inline) (inline input)))
(let ((buffer-name (format " *etaf-inline-input-%S*" order))
(label (etaf-ref "A"))
(etaf-test-inline-priority-source (etaf-ref 0))
(etaf-test-inline-priority-evals 0)
(etaf-test-inline-priority-renders 0)
(etaf-test-inline-priority-updated 0))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-test-inline-input-priority :label (etaf-value label))))
(setq etaf-test-inline-priority-evals 0
etaf-test-inline-priority-renders 0
etaf-test-inline-priority-updated 0)
(let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-runtime-event-begin runtime)
(dolist (which order)
(if (eq which 'input)
(setf (etaf-value label) "B")
(setf (etaf-value etaf-test-inline-priority-source) 1)))
(etaf-runtime-event-end runtime)
(should (= 1 etaf-test-inline-priority-evals))
(should (= 1 etaf-test-inline-priority-renders))
(should (= 1 etaf-test-inline-priority-updated))
(should (equal "B/1" (etaf-test--buffer-text buffer-name)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))))
(ert-deftest etaf-runtime-range-and-input-fixed-point-reuses-range-candidate ()
"Evaluate direct Range once when Component input changes in the same turn."
(dolist (order '((input range) (range input)))
(let ((buffer-name (format " *etaf-range-input-%S*" order))
(marker (etaf-ref "A"))
(etaf-test-range-source (etaf-ref 0))
(etaf-test-range-evals 0)
(etaf-test-range-component-renders 0))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-test-range-input-priority :marker (etaf-value marker))))
(setq etaf-test-range-evals 0 etaf-test-range-component-renders 0)
(let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-runtime-event-begin runtime)
(dolist (which order)
(if (eq which 'input)
(setf (etaf-value marker) "B")
(setf (etaf-value etaf-test-range-source) 1)))
(etaf-runtime-event-end runtime)
(should (= 1 etaf-test-range-evals))
(should (= 1 etaf-test-range-component-renders))
(should (string-match-p "B/1"
(etaf-test--buffer-text buffer-name)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))))
(ert-deftest etaf-runtime-slot-range-direct-source-skips-component-renders ()
"Update default, forwarded named, and fallback slot Ranges directly."
(dolist (component '(etaf-test-slot-range-parent
etaf-test-slot-range-named-parent
etaf-test-slot-range-fallback))
(let ((buffer-name (format " *etaf-slot-range-%S*" component))
(etaf-test-slot-source (etaf-ref nil))
(range-replaces 0) (host-replaces 0) (commits 0))
(setq etaf-test-slot-range-evals 0
etaf-test-slot-parent-renders 0
etaf-test-slot-forwarder-renders 0
etaf-test-slot-consumer-renders 0
etaf-test-slot-author-updated 0
etaf-test-slot-consumer-updated 0)
(unwind-protect
(progn
(etaf-mount buffer-name (etaf--view-call component nil nil))
(setq etaf-test-slot-range-evals 0
etaf-test-slot-parent-renders 0
etaf-test-slot-forwarder-renders 0
etaf-test-slot-consumer-renders 0)
(let ((old-range (symbol-function 'ebox-candidate-replace-range-ref))
(old-host (symbol-function 'ebox-candidate-replace-host-ref))
(old-commit (symbol-function 'ebox-commit)))
(cl-letf (((symbol-function 'ebox-candidate-replace-range-ref)
(lambda (&rest args)
(cl-incf range-replaces) (apply old-range args)))
((symbol-function 'ebox-candidate-replace-host-ref)
(lambda (&rest args)
(cl-incf host-replaces) (apply old-host args)))
((symbol-function 'ebox-commit)
(lambda (&rest args)
(cl-incf commits) (apply old-commit args))))
(setf (etaf-value etaf-test-slot-source) '((a . "A")))))
(should (= 1 etaf-test-slot-range-evals))
(should (= 1 range-replaces))
(should (zerop host-replaces))
(should (= 1 commits))
(should (zerop etaf-test-slot-parent-renders))
(should (zerop etaf-test-slot-forwarder-renders))
(should (zerop etaf-test-slot-consumer-renders))
(if (eq component 'etaf-test-slot-range-fallback)
(progn
(should (zerop etaf-test-slot-author-updated))
(should (= 1 etaf-test-slot-consumer-updated))
(with-current-buffer buffer-name
(should (equal '(:foreground "fallback-color")
(get-text-property
0 'face (buffer-string))))))
(should (= 1 etaf-test-slot-author-updated))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))))
(ert-deftest etaf-runtime-slot-range-two-sites-batch-one-commit ()
"Evaluate two projection sites and publish two Range replacements once."
(let ((buffer-name " *etaf-slot-range-two-sites-test*")
(etaf-test-slot-source (etaf-ref nil))
(etaf-test-slot-range-evals 0)
(range-replaces 0) (commits 0))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view (etaf-test-slot-range-two-site-parent)))
(setq etaf-test-slot-range-evals 0)
(let ((old-range (symbol-function 'ebox-candidate-replace-range-ref))
(old-commit (symbol-function 'ebox-commit)))
(cl-letf (((symbol-function 'ebox-candidate-replace-range-ref)
(lambda (&rest args)
(cl-incf range-replaces) (apply old-range args)))
((symbol-function 'ebox-commit)
(lambda (&rest args)
(cl-incf commits) (apply old-commit args))))
(setf (etaf-value etaf-test-slot-source) '((a . "A")))))
(should (= 2 etaf-test-slot-range-evals))
(should (= 2 range-replaces))
(should (= 1 commits)))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-slot-retarget-equal-output-promotes-dependencies ()
"Retarget caller slot deps without rendering Consumer or publishing Ebox."
(let ((buffer-name " *etaf-slot-retarget-equal-test*")
(mode (etaf-ref nil))
(etaf-test-slot-branch-left (etaf-ref 0))
(etaf-test-slot-branch-right (etaf-ref 0))
(commits 0))
(setq etaf-test-slot-parent-renders 0
etaf-test-slot-consumer-renders 0)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(etaf-test-slot-range-branch-parent :mode (etaf-value mode))))
(setq etaf-test-slot-parent-renders 0
etaf-test-slot-consumer-renders 0)
(let ((runtime (etaf-runtime-for-buffer buffer-name))
(old-commit (symbol-function 'ebox-commit)))
(cl-letf (((symbol-function 'ebox-commit)
(lambda (&rest args)
(cl-incf commits) (apply old-commit args))))
(let ((before (etaf-runtime-generation runtime)))
(setf (etaf-value mode) t)
(should (= 1 (- (etaf-runtime-generation runtime) before)))))
(should (= 1 etaf-test-slot-parent-renders))
(should (zerop etaf-test-slot-consumer-renders))
(should (zerop commits))
(let ((generation (etaf-runtime-current-generation runtime)))
(should-not (etaf--generation-source-effects
generation etaf-test-slot-branch-left))
(should (etaf--generation-source-effects
generation etaf-test-slot-branch-right)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-slot-range-rolls-back-rebuilds-and-removes-items ()
"Keep slot Range state atomic across rollback, rebuild, and item removal."
(let* ((buffer-name " *etaf-slot-range-rollback-test*")
(etaf-test-slot-source (etaf-ref '((a . "A"))))
(root-source (etaf-ref 0))
(view (lambda ()
(etaf-value root-source)
(etaf--view-call 'etaf-test-slot-range-parent
(list :key 'owner) nil))))
(unwind-protect
(progn
(etaf-mount buffer-name view)
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime))
(effect-id (car (etaf--generation-source-effects
generation etaf-test-slot-source)))
(effect (etaf--generation-effect generation effect-id))
(slot-id (etaf--generation-effect-semantic-id effect)))
(should (eq 'slot (etaf--generation-effect-kind effect)))
(setq etaf-test-slot-range-evals 0)
(setf (etaf-value etaf-test-slot-source) '((b . "B")))
(should (= 1 etaf-test-slot-range-evals))
(setq etaf-test-slot-range-evals 0)
(setf (etaf-value root-source) 1)
(should (zerop etaf-test-slot-range-evals))
(should (string-match-p "B" (etaf-test--buffer-text buffer-name)))
(let ((committed (etaf-runtime-current-generation runtime))
(before (etaf-test--buffer-text buffer-name)))
(cl-letf (((symbol-function 'accept-change-group)
(lambda (&rest _)
(error "injected slot Range final accept failure"))))
(should-error
(setf (etaf-value etaf-test-slot-source) '((c . "C")))
:type 'error))
(should (eq committed (etaf-runtime-current-generation runtime)))
(should (equal before (etaf-test--buffer-text buffer-name))))
(etaf-runtime-flush runtime)
(let* ((generation (etaf-runtime-current-generation runtime))
(slot (etaf--pvec-get
(etaf-generation-semantic-nodes generation) slot-id))
(item-id (gethash (list 'host slot-id :key 'c)
(etaf--semantic-slot-range-item-identity-index
slot))))
(should item-id)
(should (string-match-p "C" (etaf-test--buffer-text buffer-name)))
(setf (etaf-value etaf-test-slot-source) nil)
(let ((generation (etaf-runtime-current-generation runtime)))
(should-not (etaf--pvec-get
(etaf-generation-semantic-nodes generation) item-id))
(should-not (etaf--pvec-get
(etaf-generation-parent-table generation) item-id))
(should-not (etaf--pvec-get
(etaf-generation-children-table generation) item-id))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-material-fragment-is-one-retained-range-owner ()
"Update a material fragment without rendering its Component or Root."
(let ((buffer-name " *etaf-fragment-range-test*")
(etaf-test-fragment-source (etaf-ref nil))
(range-replaces 0) (root-replaces 0) (commits 0))
(setq etaf-test-fragment-range-evals 0
etaf-test-fragment-owner-renders 0)
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view (etaf-test-fragment-range-owner)))
(setq etaf-test-fragment-range-evals 0
etaf-test-fragment-owner-renders 0)
(let ((old-range (symbol-function 'ebox-candidate-replace-range-ref))
(old-root (symbol-function 'ebox-candidate-replace-root))
(old-commit (symbol-function 'ebox-commit)))
(cl-letf (((symbol-function 'ebox-candidate-replace-range-ref)
(lambda (&rest args)
(cl-incf range-replaces) (apply old-range args)))
((symbol-function 'ebox-candidate-replace-root)
(lambda (&rest args)
(cl-incf root-replaces) (apply old-root args)))
((symbol-function 'ebox-commit)
(lambda (&rest args)
(cl-incf commits) (apply old-commit args))))
(setf (etaf-value etaf-test-fragment-source)
'((a . "A") (b . "B")))))
(should (= 1 etaf-test-fragment-range-evals))
(should (zerop etaf-test-fragment-owner-renders))
(should (= 1 range-replaces))
(should (zerop root-replaces))
(should (= 1 commits))
(should (string-match-p "A" (etaf-test--buffer-text buffer-name)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime))
(effect-id (car (etaf--generation-source-effects
generation etaf-test-fragment-source))))
(should (eq 'fragment
(etaf--generation-effect-kind
(etaf--generation-effect generation effect-id))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-material-raw-ebox-is-one-opaque-range-owner ()
"Update raw value and key through one opaque Range effect."
(let ((buffer-name " *etaf-raw-range-test*")
(etaf-test-raw-source (etaf-ref "A"))
(etaf-test-raw-key-source (etaf-ref 'a))
(root-source (etaf-ref 0))
(range-replaces 0) (commits 0))
(setq etaf-test-raw-evals 0 etaf-test-raw-owner-renders 0)
(unwind-protect
(progn
(etaf-mount
buffer-name
(lambda ()
(etaf-value root-source)
(etaf--view-call 'etaf-test-raw-range-owner
(list :key 'owner) nil)))
(setq etaf-test-raw-evals 0 etaf-test-raw-owner-renders 0)
(let ((runtime (etaf-runtime-for-buffer buffer-name))
(old-range (symbol-function 'ebox-candidate-replace-range-ref))
(old-commit (symbol-function 'ebox-commit)))
(cl-letf (((symbol-function 'ebox-candidate-replace-range-ref)
(lambda (&rest args)
(cl-incf range-replaces) (apply old-range args)))
((symbol-function 'ebox-commit)
(lambda (&rest args)
(cl-incf commits) (apply old-commit args))))
(etaf-runtime-event-begin runtime)
(setf (etaf-value etaf-test-raw-source) "B")
(setf (etaf-value etaf-test-raw-key-source) 'b)
(etaf-runtime-event-end runtime)))
(should (= 1 etaf-test-raw-evals))
(should (zerop etaf-test-raw-owner-renders))
(should (= 1 range-replaces))
(should (= 1 commits))
(should (string-match-p "B" (etaf-test--buffer-text buffer-name)))
(setf (etaf-value root-source) 1)
(should (= 1 etaf-test-raw-evals))
(should (string-match-p "B" (etaf-test--buffer-text buffer-name)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime))
(effect-id (car (etaf--generation-source-effects
generation etaf-test-raw-source)))
(semantic (etaf--generation-effect-semantic
generation effect-id)))
(should (eq 'raw
(etaf--generation-effect-kind
(etaf--generation-effect generation effect-id))))
(should-not (etaf--semantic-host-p semantic))
(should (eq 'b
(plist-get (etaf--semantic-range-output-signature semantic)
:key)))
(let ((committed generation)
(before (etaf-test--buffer-text buffer-name)))
(cl-letf (((symbol-function 'accept-change-group)
(lambda (&rest _)
(error "injected raw Range final accept failure"))))
(should-error
(setf (etaf-value etaf-test-raw-source) "C") :type 'error))
(should (eq committed (etaf-runtime-current-generation runtime)))
(should (equal before (etaf-test--buffer-text buffer-name))))
(etaf-runtime-flush runtime)
(should (string-match-p "C" (etaf-test--buffer-text buffer-name)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-root-effect-owns-one-semantic-root-range ()
"Publish Root changes through one semantic Root Range and root replacement."
(let* ((buffer-name " *etaf-semantic-root-range-test*")
(source (etaf-ref nil))
(root-evals 0) (root-replaces 0) (commits 0)
(view (lambda ()
(cl-incf root-evals)
(mapcar (lambda (entry)
(etaf--view-call 'text (list :key (car entry))
(list (cdr entry))))
(etaf-value source)))))
(unwind-protect
(progn
(etaf-mount buffer-name view)
(setq root-evals 0)
(let ((old-root (symbol-function 'ebox-candidate-replace-root))
(old-commit (symbol-function 'ebox-commit)))
(cl-letf (((symbol-function 'ebox-candidate-replace-root)
(lambda (&rest args)
(cl-incf root-replaces) (apply old-root args)))
((symbol-function 'ebox-commit)
(lambda (&rest args)
(cl-incf commits) (apply old-commit args))))
(setf (etaf-value source) '((a . "A") (b . "B")))))
(should (= 1 root-evals))
(should (= 1 root-replaces))
(should (= 1 commits))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime))
(root (etaf--pvec-get
(etaf-generation-semantic-nodes generation) 0))
(range-id (car (etaf--pvec-get
(etaf-generation-children-table generation) 0)))
(range (etaf--pvec-get
(etaf-generation-semantic-nodes generation) range-id)))
(should (etaf--semantic-root-p root))
(should (eq 'root (etaf--semantic-range-kind range)))
(should (= 0 (etaf--semantic-range-parent-id range)))
(should (= range-id
(etaf--generation-effect-semantic-id
(etaf--generation-effect generation 0))))
(let ((committed generation)
(before (etaf-test--buffer-text buffer-name)))
(cl-letf (((symbol-function 'accept-change-group)
(lambda (&rest _)
(error "injected Root final accept failure"))))
(should-error
(setf (etaf-value source) '((c . "C"))) :type 'error))
(should (eq committed (etaf-runtime-current-generation runtime)))
(should (equal before (etaf-test--buffer-text buffer-name))))
(etaf-runtime-flush runtime)
(should (string-match-p "C" (etaf-test--buffer-text buffer-name)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-transparent-component-publishes-output-range ()
"Publish transparent Component nil/one/many output through one Range."
(let ((buffer-name " *etaf-transparent-output-range-test*")
(etaf-test-transparent-source (etaf-ref nil))
(range-replaces 0) (host-replaces 0) (commits 0))
(setq etaf-test-transparent-renders 0
etaf-test-transparent-parent-renders 0)
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-transparent-parent)))
(setq etaf-test-transparent-renders 0
etaf-test-transparent-parent-renders 0)
(let ((old-range (symbol-function 'ebox-candidate-replace-range-ref))
(old-host (symbol-function 'ebox-candidate-replace-host-ref))
(old-commit (symbol-function 'ebox-commit)))
(cl-letf (((symbol-function 'ebox-candidate-replace-range-ref)
(lambda (&rest args)
(cl-incf range-replaces) (apply old-range args)))
((symbol-function 'ebox-candidate-replace-host-ref)
(lambda (&rest args)
(cl-incf host-replaces) (apply old-host args)))
((symbol-function 'ebox-commit)
(lambda (&rest args)
(cl-incf commits) (apply old-commit args))))
(setf (etaf-value etaf-test-transparent-source)
'((a . "A") (b . "B")))))
(should (= 1 etaf-test-transparent-renders))
(should (zerop etaf-test-transparent-parent-renders))
(should (= 1 range-replaces))
(should (zerop host-replaces))
(should (= 1 commits))
(should (string-match-p "A" (etaf-test--buffer-text buffer-name)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime))
(component
(cl-loop for id from 1 to (etaf-runtime-next-semantic-id runtime)
for node = (etaf--pvec-get
(etaf-generation-semantic-nodes generation)
id)
when (and (etaf--semantic-component-p node)
(equal (car (etaf--semantic-component-identity node))
'etaf-test-transparent-owner))
return node))
(range (etaf--pvec-get
(etaf-generation-semantic-nodes generation)
(etaf--semantic-component-output-range-id component))))
(should (eq 'transparent
(etaf--semantic-component-publication-kind component)))
(should (eq 'component-output (etaf--semantic-range-kind range)))
(should (eq (etaf--semantic-component-output-range-ref component)
(etaf--semantic-range-range-ref range)))
(let ((committed generation)
(before (etaf-test--buffer-text buffer-name)))
(cl-letf (((symbol-function 'accept-change-group)
(lambda (&rest _)
(error "injected transparent final accept failure"))))
(should-error
(setf (etaf-value etaf-test-transparent-source)
'((c . "C")))
:type 'error))
(should (eq committed (etaf-runtime-current-generation runtime)))
(should (equal before (etaf-test--buffer-text buffer-name))))
(etaf-runtime-flush runtime)
(should (string-match-p "C"
(etaf-test--buffer-text buffer-name)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-transparent-chain-shares-nearest-backend-anchor ()
"Update an inner transparent Component without rendering its ancestors."
(let ((buffer-name " *etaf-transparent-chain-test*")
(etaf-test-transparent-source (etaf-ref '((a . "A"))))
(range-replaces 0) (commits 0))
(setq etaf-test-transparent-inner-renders 0
etaf-test-transparent-outer-renders 0)
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view (etaf-test-transparent-chain-parent)))
(setq etaf-test-transparent-inner-renders 0
etaf-test-transparent-outer-renders 0)
(let ((old-range (symbol-function 'ebox-candidate-replace-range-ref))
(old-commit (symbol-function 'ebox-commit)))
(cl-letf (((symbol-function 'ebox-candidate-replace-range-ref)
(lambda (&rest args)
(cl-incf range-replaces) (apply old-range args)))
((symbol-function 'ebox-commit)
(lambda (&rest args)
(cl-incf commits) (apply old-commit args))))
(setf (etaf-value etaf-test-transparent-source)
'((a . "B")))))
(should (= 1 etaf-test-transparent-inner-renders))
(should (zerop etaf-test-transparent-outer-renders))
(should (= 1 range-replaces))
(should (= 1 commits))
(should (string-match-p "B" (etaf-test--buffer-text buffer-name))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-runtime-parent-rerender-rebuilds-invalidated-artifact ()
"Rebuild a committed parent anchor after a descendant-only publication."
(let ((buffer-name " *etaf-ancestor-artifact-test*")
(etaf-test-ancestor-parent-source (etaf-ref "light"))
(etaf-test-ancestor-child-source (etaf-ref nil)))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view (etaf-test-ancestor-artifact-parent)))
(setf (etaf-value etaf-test-ancestor-child-source) t)
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime))
(parent
(etaf--generation-semantic
generation '(etaf-test-ancestor-artifact-parent (root)))))
(should (etaf--semantic-component-p parent))
(should-not (etaf--semantic-component-artifact-key parent))
(setf (etaf-value etaf-test-ancestor-parent-source) "dark")
(should (equal
(plist-get
(etaf-runtime-host-props-for
runtime '(etaf-host (root :view)))
:bgcolor)
"dark"))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-runtime-context-provider-promotes-consumer-atomically ()
"Promote provider and dependent Host property only with their generation."
(let ((buffer-name " *etaf-generation-context-test*")
(etaf-test-context-provider-source (etaf-ref "red")))
(setq etaf-test-context-provider-renders 0
etaf-test-context-consumer-renders 0)
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view (etaf-test-generation-context-provider)))
(setq etaf-test-context-provider-renders 0
etaf-test-context-consumer-renders 0)
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(old-generation (etaf-runtime-current-generation runtime)))
(setf (etaf-value etaf-test-context-provider-source) "blue")
(should (= 1 etaf-test-context-provider-renders))
(should (zerop etaf-test-context-consumer-renders))
(with-current-buffer buffer-name
(should (equal '(:foreground "blue")
(get-text-property 0 'face (buffer-string)))))
(let ((committed (etaf-runtime-current-generation runtime))
(before (etaf-test--buffer-text buffer-name)))
(cl-letf (((symbol-function 'ebox-commit)
(lambda (&rest _)
(error "injected Context publication failure"))))
(should-error
(setf (etaf-value etaf-test-context-provider-source) "green")
:type 'error))
(should (eq committed (etaf-runtime-current-generation runtime)))
(should (equal before (etaf-test--buffer-text buffer-name))))
(etaf-runtime-flush runtime)
(with-current-buffer buffer-name
(should (equal '(:foreground "green")
(get-text-property 0 'face (buffer-string)))))
(should-not (eq old-generation
(etaf-runtime-current-generation runtime)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-generation-owns-handler-ref-and-focus-contributions ()
"Dispatch only committed handlers and remove stale focus membership."
(let* ((buffer-name " *etaf-generation-handler-test*")
(mode (etaf-ref 'old))
(old-calls 0) (new-calls 0) (stable-calls 0)
(view
(lambda ()
(etaf--view-call
'column nil
(list
(pcase (etaf-value mode)
('old (etaf--view-call
'text
(list :ref 'target :tab-index 0
:on-press (lambda () (cl-incf old-calls)))
(list "old")))
('new (etaf--view-call
'text
(list :ref 'target :tab-index 0
:on-press (lambda () (cl-incf new-calls)))
(list "new")))
(_ (etaf--view-call 'text (list :ref 'target)
(list "removed"))))
(etaf--view-call
'text (list :ref 'stable :tab-index 1
:on-press (lambda () (cl-incf stable-calls)))
(list "stable")))))))
(unwind-protect
(progn
(etaf-mount buffer-name view)
(let ((runtime (etaf-runtime-for-buffer buffer-name))
(old-commit (symbol-function 'ebox-commit)))
(cl-letf (((symbol-function 'ebox-commit)
(lambda (&rest args)
(etaf-dispatch-event runtime 'target 'press)
(apply old-commit args))))
(setf (etaf-value mode) 'new))
(should (= 1 old-calls))
(should (zerop new-calls))
(etaf-dispatch-event runtime 'target 'press)
(should (= 1 new-calls))
(etaf-dispatch-event runtime 'stable 'press)
(should (= 1 stable-calls))
(etaf-focus runtime 'target)
(should (eq 'target (etaf-focused-host-ref runtime)))
(setf (etaf-value mode) 'removed)
(should-error (etaf-dispatch-event runtime 'target 'press)
:type 'etaf-event-error)
(should-not (etaf-focused-host-ref runtime))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-candidate-reintroduced-host-cancels-contribution-removal ()
"Cancel a Host tombstone when the same stable ref is re-registered."
(let ((runtime
(etaf--runtime-create
:candidate-removed-host-refs '(stable other)
:candidate-host-props (make-hash-table :test #'equal)
:candidate-handlers (make-hash-table :test #'equal)
:candidate-semantic-nodes (make-hash-table :test #'equal)
:candidate-graph-nodes (make-hash-table :test #'eql)
:candidate-behaviors (make-hash-table :test #'equal))))
(etaf--runtime-register-host
runtime '(:ref stable :on-press ignore) '(test))
(should (equal '(other)
(etaf-runtime-candidate-removed-host-refs runtime)))
(should (etaf-runtime-handler-for
(let ((generation
(etaf--generation-create
:indexes
(etaf--runtime-build-contribution-indexes
runtime nil t))))
(setf (etaf-runtime-current-generation runtime) generation)
runtime)
'stable))))
(ert-deftest etaf-contribution-index-compaction-preserves-effective-values ()
"Flatten contribution deltas without changing values or tombstones."
(let* ((base
(etaf--contribution-index-create
:handlers '((a . ((press . old))) (b . ((press . removed))))
:host-props '((a :role button) (b :role button))
:contexts '((10 . old-context) (20 . stable-context))
:themes '((10 . old-theme) (20 . stable-theme))
:behaviors '((10 . old-behavior) (20 . stable-behavior))
:context-consumers '(((10 . theme) 1) ((20 . theme) 2))
:lifecycle '((old . updated))))
(delta
(etaf--contribution-index-create
:base base :depth 2
:handlers '((a . ((press . new))))
:host-props '((a :role checkbox))
:contexts '((10 . new-context))
:themes '((10 . new-theme))
:behaviors '((10 . new-behavior))
:context-consumers '(((10 . theme) 3))
:lifecycle '((new . updated))
:host-removals '(b)
:semantic-removals '(30)))
(compacted (etaf--contribution-index-compact delta)))
(should-not (etaf--contribution-index-base compacted))
(should (= 1 (etaf--contribution-index-depth compacted)))
(dolist (slot '(handlers host-props contexts themes behaviors
context-consumers lifecycle))
(should (equal (etaf--contribution-index-entries delta slot)
(etaf--contribution-index-entries compacted slot))))
(let ((generation (etaf--generation-create :indexes compacted)))
(should (equal '((press . new))
(etaf--generation-index-lookup generation 'handlers 'a)))
(should-not
(etaf--generation-index-lookup generation 'handlers 'b)))))
(ert-deftest etaf-contribution-index-depth-stays-bounded ()
"Periodically compact a long sequence of local contribution generations."
(let ((etaf-generation-index-max-depth 4)
(runtime
(etaf--runtime-create
:candidate-handlers (make-hash-table :test #'equal)
:candidate-host-props (make-hash-table :test #'equal)
:candidate-semantic-nodes (make-hash-table :test #'equal)
:candidate-graph-nodes (make-hash-table :test #'eql)
:candidate-behaviors (make-hash-table :test #'equal)
:candidate-behavior-resource-keys (make-hash-table :test #'equal)))
generation)
(dotimes (index 20)
(setq generation
(etaf--generation-create
:generation-id (1+ index)
:indexes
(etaf--runtime-build-contribution-indexes
runtime generation nil)))
(should (<= (etaf--contribution-index-depth
(etaf-generation-indexes generation))
etaf-generation-index-max-depth)))))
(ert-deftest etaf-context-edge-belongs-to-direct-range-effect ()
"Invalidate the injecting Range effect, not its lexical Component effect."
(let ((buffer-name " *etaf-context-range-owner-test*")
(etaf-test-context-provider-source (etaf-ref "A")))
(setq etaf-test-context-range-evals 0)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view (etaf-test-generation-context-range-provider)))
(setq etaf-test-context-range-evals 0)
(setf (etaf-value etaf-test-context-provider-source) "B")
(should (= 1 etaf-test-context-range-evals))
(should (string-match-p "B" (etaf-test--buffer-text buffer-name)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime))
(edges (etaf--generation-index-entries
generation 'context-consumers)))
(should (= 1 (length (cdar edges))))
(should (eq 'range
(etaf--generation-effect-kind
(etaf--generation-effect generation
(cadar edges)))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-context-edge-belongs-to-slot-range-effect ()
"Invalidate the authored slot Range without rendering its consumer."
(let ((buffer-name " *etaf-context-slot-owner-test*")
(etaf-test-context-provider-source (etaf-ref "A")))
(setq etaf-test-slot-range-evals 0
etaf-test-slot-consumer-renders 0
etaf-test-context-provider-renders 0)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view (etaf-test-generation-context-slot-provider)))
(setq etaf-test-slot-range-evals 0
etaf-test-slot-consumer-renders 0
etaf-test-context-provider-renders 0)
(setf (etaf-value etaf-test-context-provider-source) "B")
(should (= 1 etaf-test-context-provider-renders))
(should (= 1 etaf-test-slot-range-evals))
(should (zerop etaf-test-slot-consumer-renders))
(should (string-match-p "B" (etaf-test--buffer-text buffer-name)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-current-generation runtime))
(effect-id (cadar (etaf--generation-index-entries
generation 'context-consumers))))
(should (eq 'slot
(etaf--generation-effect-kind
(etaf--generation-effect generation effect-id))))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-context-cycle-validator-allows-long-chain-and-rejects-cycle ()
"Settle a long Context graph and reject one deterministic cross-edge cycle."
(let ((effect-map nil) chain)
(dotimes (index 40)
(let ((effect-id (1+ index))
(consumer-id (+ 2 index)))
(setq effect-map
(etaf--pvec-put
effect-map effect-id
(etaf--generation-effect-create
:effect-id effect-id :kind 'component-render
:semantic-id consumer-id :deps nil)))
(push (cons (cons (1+ index) 'chain-key) (list effect-id)) chain)))
(let ((generation
(etaf--generation-create
:effect-map effect-map
:indexes (etaf--contribution-index-create
:context-consumers (nreverse chain)))))
(should (eq generation
(etaf--generation-validate-context-acyclic generation))))
(let* ((cycle-effects
(etaf--pvec-put
(etaf--pvec-put
nil 1 (etaf--generation-effect-create
:effect-id 1 :kind 'component-render
:semantic-id 2 :deps nil))
2 (etaf--generation-effect-create
:effect-id 2 :kind 'component-render
:semantic-id 1 :deps nil)))
(cycle
(etaf--generation-create
:effect-map cycle-effects
:indexes
(etaf--contribution-index-create
:context-consumers
(list (cons (cons 1 'left) (list 1))
(cons (cons 2 'right) (list 2)))))))
(should-error (etaf--generation-validate-context-acyclic cycle)
:type 'etaf-context-error))))
(ert-deftest etaf-runtime-inline-styled-output-survives-pure-root-rebuild ()
"Keep current propertized inline output without replaying application thunks."
(let* ((buffer-name " *etaf-inline-styled-rebuild-test*")
(etaf-test-inline-styled-source (etaf-ref "A"))
(etaf-test-inline-styled-evals 0)
(etaf-test-inline-host-prop-calls 0)
(root-source (etaf-ref 0))
(view (lambda ()
(etaf-value root-source)
(etaf--view-call 'etaf-test-inline-styled-owner
(list :key 'styled) nil))))
(unwind-protect
(progn
(etaf-mount buffer-name view)
(should (= 1 etaf-test-inline-host-prop-calls))
(setq etaf-test-inline-styled-evals 0)
(setf (etaf-value etaf-test-inline-styled-source) "B")
(should (= 1 etaf-test-inline-styled-evals))
(setq etaf-test-inline-styled-evals 0)
(setf (etaf-value root-source) 1)
(should (zerop etaf-test-inline-styled-evals))
(should (= 1 etaf-test-inline-host-prop-calls))
(with-current-buffer buffer-name
(let ((text (buffer-string)))
(should (equal "PB" (substring-no-properties text)))
(should (get-text-property 1 'face text)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name))) (kill-buffer buffer)))))
(ert-deftest etaf-event-dispatch-noop-does-not-publish ()
"Do not publish when an event callback changes no reactive state."
(let ((buffer-name " *etaf-event-noop-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-event-batch-noop)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(before (etaf-runtime-generation runtime)))
(etaf-dispatch-event runtime 'event-batch-noop 'press)
(should (= before (etaf-runtime-generation runtime)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-event-dispatch-nested-batches-once ()
"Batch nested public dispatches into one final publication."
(let ((buffer-name " *etaf-event-nested-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-event-batch-nested)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(before (etaf-runtime-generation runtime)))
(etaf-dispatch-event runtime 'event-batch-nested-outer 'press)
(should (equal "Outer Inner nested"
(etaf-test--buffer-text buffer-name)))
(should (= 1 (- (etaf-runtime-generation runtime) before)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-event-dispatch-batches-behavior-two-ref-write ()
"Batch a Behavior callback that writes two reactive refs."
(let ((buffer-name " *etaf-event-behavior-batch-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view (etaf-test-event-batch-behavior)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(before (etaf-runtime-generation runtime)))
(etaf-dispatch-event runtime 'event-batch-behavior 'press)
(should (equal "Toggle left=on right=on"
(etaf-test--buffer-text buffer-name)))
(should (= 1 (- (etaf-runtime-generation runtime) before)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-event-dispatch-batches-computed-theme ()
"Batch a callback that invalidates a computed Theme value."
(let ((buffer-name " *etaf-event-theme-batch-test*"))
(unwind-protect
(progn
(etaf-mount buffer-name (etaf-view (etaf-test-event-batch-theme)))
(should (equal "Theme theme=light"
(etaf-test--buffer-text buffer-name)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(before (etaf-runtime-generation runtime)))
(etaf-dispatch-event runtime 'event-batch-theme-toggle 'press)
(should (equal "Theme theme=dark"
(etaf-test--buffer-text buffer-name)))
(should (= 1 (- (etaf-runtime-generation runtime) before)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-event-dispatch-batches-resource-success-and-error ()
"Batch synchronous Resource success and error publications per event."
(let* ((buffer-name " *etaf-event-resource-batch-test*")
(fail (etaf-ref nil :name 'etaf-test-event-resource-fail))
(resource
(etaf-resource
(lambda ()
(if (etaf-value fail)
(error "expected resource failure")
(etaf-resource-result "ok")))
:immediate nil :name 'etaf-test-event-resource)))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view
(etaf-test-event-batch-resource
:resource resource :fail fail)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(before (etaf-runtime-generation runtime)))
(etaf-dispatch-event runtime 'event-batch-resource-success 'press)
(should (equal "Load success Load error status=success value=ok error=no"
(etaf-test--buffer-text buffer-name)))
(should (= 1 (- (etaf-runtime-generation runtime) before)))
(setq before (etaf-runtime-generation runtime))
(etaf-dispatch-event runtime 'event-batch-resource-error 'press)
(with-current-buffer buffer-name
(should (string-match-p
"status=error value=none error=yes"
(buffer-string))))
(should (= 1 (- (etaf-runtime-generation runtime) before)))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer))
(etaf-resource-dispose resource))))
(ert-deftest etaf-mounted-input-focus-order-and-lifecycle ()
"Order equal tab stops by live position and toggle input with mount life."
(let ((buffer-name " *etaf-input-lifecycle-test*"))
(setq etaf-test-event-count 0)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(column
(text :ref 'first :tab-index 0
:on-press (lambda () (cl-incf etaf-test-event-count))
"First")
(text :ref 'second :tab-index 0
:on-press (lambda () (cl-incf etaf-test-event-count))
"Second"))))
(should (etaf-runtime-for-buffer buffer-name))
(with-current-buffer buffer-name
(should etaf-input-mode)
(should (eq #'etaf-focus-next (key-binding (kbd "TAB"))))
(should (eq #'etaf-activate (key-binding (kbd "RET"))))
(should (eq #'etaf-focus-previous
(key-binding (kbd "<backtab>"))))
(switch-to-buffer buffer-name)
(execute-kbd-macro (kbd "TAB"))
(execute-kbd-macro (kbd "RET")))
(let ((runtime (etaf-runtime-for-buffer buffer-name)))
(should (eq 'first (etaf-focused-host-ref runtime)))
(should (= 1 etaf-test-event-count))
(with-current-buffer buffer-name
(should (= (point) (etaf-host-ref-position runtime 'first))))
(should (eq 'second (etaf-focus-next runtime)))
(with-current-buffer buffer-name
(should (= (point) (etaf-host-ref-position runtime 'second))))
(let ((window (get-buffer-window buffer-name t)))
(should (windowp window))
(etaf-activate-mouse
(list 'mouse-1
(list window
(etaf-host-ref-position runtime 'second)))))
(should (= 2 etaf-test-event-count))
(etaf-unmount runtime))
(with-current-buffer buffer-name
(should-not etaf-input-mode)))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-activation-skips-disabled-and-callbackless-hosts ()
"Do not activate a disabled Host or a Host without a press callback."
(let ((buffer-name " *etaf-activation-filter-test*"))
(setq etaf-test-event-count 0)
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(column
(text :ref 'disabled :tab-index 0 :disabled t
:on-press (lambda () (cl-incf etaf-test-event-count))
"Disabled")
(text :ref 'passive :tab-index 1 "Passive"))))
(let ((runtime (etaf-runtime-for-buffer buffer-name)))
(with-current-buffer buffer-name
(goto-char (etaf-host-ref-position runtime 'disabled))
(should-error (etaf-activate runtime) :type 'user-error)
(goto-char (etaf-host-ref-position runtime 'passive))
(should-error (etaf-activate runtime) :type 'user-error)
(let ((window (get-buffer-window buffer-name t)))
(etaf-activate-mouse
(list 'mouse-1
(list window
(etaf-host-ref-position runtime 'passive))))))
(should (= 0 etaf-test-event-count))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-mount-publishes-through-ebox ()
"Mount a View into a buffer using Ebox's buffer publication API."
(let ((buffer-name " *etaf-test-mount*"))
(unwind-protect
(progn
(etaf-mount buffer-name
(etaf-view (text :color "#F4F6FB" "Mounted")))
(with-current-buffer buffer-name
(should (equal "Mounted" (buffer-string)))))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-mount-accepts-final-initial-viewport ()
"Publish the first generation at its final viewport without a rerender."
(let ((buffer-name " *etaf-test-initial-viewport*"))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf-view
(column :width '(viewport) :height '(viewport-height)
(text "Viewport")))
'(:viewport-width 640 :viewport-height 24))
(let ((report
(ebox-surface-update-buffer-viewport
(get-buffer buffer-name) 640 24)))
(should (eq (plist-get report :strategy) 'no-op)))
(should-error
(etaf-mount buffer-name (etaf-view (text "Invalid"))
'(:unknown-option t)))
(should-error
(etaf-mount buffer-name (etaf-view (text "Invalid"))
'(:viewport-width 0))))
(when-let ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
;;; etaf-tests.el ends here
Reference in New Issue View Git Blame Copy Permalink