;;; 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) ;; This suite locks ETAF range and slot semantics against the named Elisp ;; projection plans. Keep an optional locally built Ebox module from ;; replacing those plans with `native-frame'; native execution is covered by ;; the Playground integration and performance gates. (setq ebox-native-reflow-module-path nil) (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-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-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)) ('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-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-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-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 (box :color (progn (cl-incf etaf-test-inline-host-prop-calls) "red") "P" (text :font-weight 'bold (expr :value (progn (cl-incf etaf-test-inline-styled-evals) (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 :font-weight '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 :font-weight 'shadow "Default header")) (slot (text :font-weight '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" :font-weight '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 :font-weight 'bold "Hello")))) (should (etaf--view-node-p view)) (should (equal 'bold (plist-get (etaf--view-node-props view) :font-weight))) (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 :font-weight 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-normalizes-box-string-child-to-text () "Normalize a static Box string child to one Text View." (let* ((view (etaf-view (box "A"))) (child (car (etaf--view-node-children view)))) (should (etaf--view-node-p child)) (should (eq (etaf--view-node-name child) 'text)) (should (equal (etaf--view-node-children child) '("A"))))) (ert-deftest etaf-view-normalizes-root-string-to-text () "Normalize a static root string to one Text View." (let ((view (etaf-view "A"))) (should (etaf--view-node-p view)) (should (eq (etaf--view-node-name view) 'text)) (should (equal (etaf--view-node-children view) '("A"))))) (ert-deftest etaf-view-normalizes-component-string-slot-to-text () "Normalize a static Component string child before slot ownership." (let* ((call (etaf-view (etaf-test-slot-card :title "Card" "Body"))) (child (car (cdr (assq 'default (etaf--component-call-slots call)))))) (should (etaf--view-node-p child)) (should (eq (etaf--view-node-name child) 'text)) (should (equal (etaf--view-node-children child) '("Body"))))) (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-box-forms-lower-outer-and-layout-to-ebox () "Lower each Box form to one typed Box with its selected Layout." (let ((row (etaf-render (etaf-view (row :outer 'inline (text "A") (text "B"))))) (column (etaf-render (etaf-view (column :outer 'block (text "A") (text "B")))))) (should (equal (ebox--computed-display row) '(inline row))) (should (equal (ebox--computed-display column) '(block column))) (should (equal (substring-no-properties (ebox-render row)) "AB")) (should (equal (substring-no-properties (ebox-render column)) "A\nB")))) (ert-deftest etaf-view-box-rejects-invalid-layout () "Reject an invalid canonical Box layout before publication." (should-error (etaf-render (etaf-view (box :layout 'masonry "A"))) :type 'error)) (ert-deftest etaf-runtime-box-retains-child-text-update () "Mounted canonical Box should retain its layout while Text updates." (let ((buffer-name " *etaf-box-runtime-test*") (source (etaf-ref "A"))) (unwind-protect (progn (etaf-mount buffer-name (etaf-view (row (text (expr :value (etaf-value source))) (text "B")))) (should (string-match-p "AB" (etaf-test--buffer-text buffer-name))) (setf (etaf-value source) "C") (should (string-match-p "CB" (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-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 (ebox-box-node-p node)) (should (eq (ebox-layout-config-kind (ebox-box-node-layout node)) '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)))) (children (ebox-box-node-children node)) (title (car children)) (body (cadr children))) (should (equal "inline-title" (ebox-style-node-specified-value title :color))) (should (equal "title-bg" (ebox-style-node-specified-value title :bgcolor))) (should (equal "style-root" (ebox-style-node-specified-value node :color))) (should-not (ebox-style-node-specified-value 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-style-node-specified-value 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-style-node-specified-value node :color)))) (let ((node (etaf-render (etaf-view (etaf-test-style-rule-order :color "inline-color"))))) (should (equal "inline-color" (ebox-style-node-specified-value 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-style-node-specified-value 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-style-node-specified-value 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-style-node-specified-value 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-style-node-specified-value (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-style-node-specified-value (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-style-node-specified-value node :color))) (should (equal "theme-bg" (ebox-style-node-specified-value 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-style-node-specified-value (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 (ebox-style-node-specified-value (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))) (should (equal "#111111" (background semantic)))) (with-current-buffer buffer-name (should (cl-some (lambda (entry) (equal "#111111" (plist-get (cadr entry) :background))) face-remapping-alist))) (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-box-composes-adjacent-styled-text-runs () "Represent styled runs as sibling Text nodes, never a nested Text tree." (let* ((node (etaf-render (etaf-view (box "Hello " (text :font-weight 'bold "world") "!")))) (content (ebox-render node))) (should (equal "Hello world!" (substring-no-properties content))) (should (equal '(:weight 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-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-runtime-observer-covers-initial-publication () "Observed mount emits TP, Ebox, then one final ETAF operation report." (let ((buffer-name " *etaf-observed-mount-test*") reports) (unwind-protect (progn (etaf-mount buffer-name (etaf-view (box "Observed")) (list :observer (lambda (report) (push report reports)))) (setq reports (nreverse reports)) (should (equal (mapcar (lambda (report) (plist-get report :provider)) reports) '(tp ebox etaf))) (should (equal (mapcar (lambda (report) (plist-get report :sequence)) reports) '(1 2 3))) (should (equal (delete-dups (mapcar (lambda (report) (plist-get report :operation-id)) reports)) '(1))) (let ((final (car (last reports)))) (should (eq (plist-get final :stage) 'runtime-operation)) (should (eq (plist-get final :kind) 'mount)) (should (eq (plist-get final :status) 'success)) (should (= (plist-get final :generation-before) 0)) (should (= (plist-get final :generation-after) 1)))) (when-let* ((runtime (etaf-runtime-for-buffer buffer-name))) (etaf-runtime-set-observer runtime nil) (etaf-unmount runtime)) (when-let* ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) (ert-deftest etaf-runtime-observer-flattens-nested-event-and-detaches () "Nested event/flush work shares one operation and detach stops reports." (let ((buffer-name " *etaf-observed-event-test*") reports) (unwind-protect (progn (etaf-mount buffer-name (etaf-view (etaf-test-event-batch-nested))) (let ((runtime (etaf-runtime-for-buffer buffer-name))) (etaf-runtime-set-observer runtime (lambda (report) (push report reports))) (etaf-dispatch-event runtime 'event-batch-nested-outer 'press) (setq reports (nreverse reports)) (should (equal (mapcar (lambda (report) (plist-get report :provider)) reports) '(tp ebox etaf))) (should (= 1 (cl-count 'etaf reports :key (lambda (report) (plist-get report :provider))))) (should (= 1 (length (delete-dups (mapcar (lambda (report) (plist-get report :operation-id)) reports))))) (should (equal "Outer Inner nested" (etaf-test--buffer-text buffer-name))) (should-not (etaf-runtime-set-observer runtime nil)) (setq reports nil) (etaf-dispatch-event runtime 'event-batch-nested-outer 'press) (should-not reports))) (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-observer-noop-and-failure-cannot-change-state () "No-op observation and observer errors preserve exact committed state." (let ((buffer-name " *etaf-observed-noop-test*") reports) (unwind-protect (progn (etaf-mount buffer-name (etaf-view (etaf-test-event-batch-noop))) (let* ((runtime (etaf-runtime-for-buffer buffer-name)) (generation (etaf-runtime-generation runtime)) (before (with-current-buffer buffer-name (buffer-string)))) (etaf-runtime-set-observer runtime (lambda (report) (push report reports) (error "observer failure"))) (etaf-dispatch-event runtime 'event-batch-noop 'press) (should (= generation (etaf-runtime-generation runtime))) (should (equal-including-properties before (with-current-buffer buffer-name (buffer-string)))) (should (= 1 (length reports))) (should (eq (plist-get (car reports) :provider) 'etaf)) (should (cl-find 'observer (etaf-runtime-diagnostics runtime) :key (lambda (entry) (plist-get entry :phase)))))) (when-let* ((runtime (etaf-runtime-for-buffer buffer-name))) (etaf-runtime-set-observer runtime nil) (etaf-unmount runtime)) (when-let* ((buffer (get-buffer buffer-name))) (kill-buffer buffer))))) (ert-deftest etaf-runtime-observer-compare-and-set-preserves-foreign-owner () "Observer consumers replace only the exact sink they own." (let ((buffer-name " *etaf-observer-owner-test*") (first #'ignore) (second (lambda (_report) nil))) (unwind-protect (progn (etaf-mount buffer-name (etaf-view (box "Observer owner"))) (let ((runtime (etaf-runtime-for-buffer buffer-name))) (should (etaf-runtime-compare-and-set-observer runtime nil first)) (should-not (etaf-runtime-compare-and-set-observer runtime nil second)) (should (etaf-runtime-compare-and-set-observer runtime first second)) (should-not (etaf-runtime-compare-and-set-observer runtime first nil)) (should (etaf-runtime-compare-and-set-observer runtime second nil)))) (when-let* ((runtime (etaf-runtime-for-buffer buffer-name))) (etaf-runtime-set-observer runtime nil) (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--generation-child-ids generation parent-id)) (should (integerp child-id)) (should (= parent-id (etaf--generation-parent-id 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--generation-child-ids 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 output while retaining Range-only dependency." (dolist (unsupported '(component deep-component 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--generation-parent-id new-generation semantic-id)) (should-not (etaf--generation-child-ids 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-shared-inline-source-updates-distinct-text-hosts () "Publish two distinct Text hosts that read one shared source in one commit." (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--generation-parent-id generation item-id)) (should-not (etaf--generation-child-ids 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-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--generation-child-ids 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 "")))) (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