0d35358e05
Replace the legacy managed layer renderer with one independent retained/reactive text runtime. TP now owns exact dependencies, stable objects, marker-backed mounts, property contribution composition, atomic publication, rollback, and direct text-property facades without ECSS or Ebox dependencies.\n\nBREAKING CHANGE: remove tp-render, tp-stack, scan-driven managed layers, inline runtime metadata, TP-owned CSS cascade APIs, and dollar-variable declarations.\n\nVerified: 290/290 ERT, shuffled 290/290 (seed 20260806), 8/8 doctests, WERROR compile-all, checkdoc, package-lint, diff-check, and isolated TP-only load.
398 lines
16 KiB
EmacsLisp
398 lines
16 KiB
EmacsLisp
;;; tp-binding-tests.el --- Tests for TP binding graph -*- lexical-binding: t; -*-
|
|
|
|
;; Copyright (C) 2026 Geekinney
|
|
|
|
;;; Commentary:
|
|
|
|
;; Contract tests for TP 1.0 signals, bindings, and transactions.
|
|
|
|
;;; Code:
|
|
|
|
(require 'ert)
|
|
(require 'tp-reactive)
|
|
|
|
(defvar tp-binding-test-variable nil
|
|
"Variable used by scoped signal adapter tests.")
|
|
|
|
(defmacro tp-binding-test--isolated (&rest body)
|
|
"Run BODY with an isolated reactive runtime."
|
|
(declare (indent 0) (debug t))
|
|
`(progn
|
|
(tp-reactive-reset)
|
|
(unwind-protect (progn ,@body)
|
|
(tp-reactive-reset))))
|
|
|
|
(ert-deftest tp-binding-test-signal-invalidates-only-direct-subscribers ()
|
|
"A sparse signal write never visits unrelated bindings."
|
|
(tp-binding-test--isolated
|
|
(let ((target (tp-signal-create 0))
|
|
(unrelated (tp-signal-create 0))
|
|
(target-calls 0)
|
|
(unrelated-calls 0))
|
|
(tp-with-transaction
|
|
(tp-bind 'target-owner '(test . value)
|
|
(lambda ()
|
|
(cl-incf target-calls)
|
|
(tp-signal-read target)))
|
|
(dotimes (index 9999)
|
|
(tp-bind (list 'unrelated-owner index) '(test . value)
|
|
(lambda ()
|
|
(cl-incf unrelated-calls)
|
|
(tp-signal-read unrelated)))))
|
|
(should (= target-calls 1))
|
|
(should (= unrelated-calls 9999))
|
|
(tp-reactive-reset-counters)
|
|
(cl-letf (((symbol-function 'buffer-list)
|
|
(lambda (&rest _) (error "Legacy scan")))
|
|
((symbol-function 'text-property-search-forward)
|
|
(lambda (&rest _) (error "Legacy scan")))
|
|
((symbol-function 'tp-reactive--buffer-layer-names)
|
|
(lambda (&rest _) (error "Legacy scan")))
|
|
((symbol-function 'tp-reactive-layer-buffers)
|
|
(lambda (&rest _) (error "Legacy scan"))))
|
|
(tp-signal-set target 1))
|
|
(should (= target-calls 2))
|
|
(should (= unrelated-calls 9999))
|
|
(should (equal (tp-reactive-counters)
|
|
'(:invalidated 1 :recomputed 1 :skipped 0
|
|
:subscription-added 0 :subscription-removed 0))))))
|
|
|
|
(ert-deftest tp-binding-test-conditional-dependencies-rewire ()
|
|
"A binding unsubscribes from the branch it no longer reads."
|
|
(tp-binding-test--isolated
|
|
(let ((enabled (tp-signal-create t))
|
|
(active (tp-signal-create 'active))
|
|
(disabled (tp-signal-create 'disabled))
|
|
(calls 0))
|
|
(tp-bind 'owner '(test . branch)
|
|
(lambda ()
|
|
(cl-incf calls)
|
|
(if (tp-signal-read enabled)
|
|
(tp-signal-read active)
|
|
(tp-signal-read disabled))))
|
|
(tp-signal-set enabled nil)
|
|
(should (= calls 2))
|
|
(tp-signal-set active 'ignored)
|
|
(should (= calls 2))
|
|
(tp-signal-set disabled 'changed)
|
|
(should (= calls 3)))))
|
|
|
|
(ert-deftest tp-binding-test-equal-signal-write-is-noop ()
|
|
"Setting an equal signal value does not dirty its binding."
|
|
(tp-binding-test--isolated
|
|
(let ((source (tp-signal-create '(1 2) :equality #'equal))
|
|
(calls 0))
|
|
(tp-bind 'owner '(test . value)
|
|
(lambda ()
|
|
(cl-incf calls)
|
|
(tp-signal-read source)))
|
|
(tp-reactive-reset-counters)
|
|
(tp-signal-set source (list 1 2))
|
|
(should (= calls 1))
|
|
(should (equal (tp-reactive-counters)
|
|
'(:invalidated 0 :recomputed 0 :skipped 0
|
|
:subscription-added 0 :subscription-removed 0))))))
|
|
|
|
(ert-deftest tp-binding-test-transaction-deduplicates-writes ()
|
|
"Repeated writes in one transaction recompute each binding once."
|
|
(tp-binding-test--isolated
|
|
(let ((source (tp-signal-create 0))
|
|
(calls 0))
|
|
(tp-bind 'owner '(test . value)
|
|
(lambda ()
|
|
(cl-incf calls)
|
|
(tp-signal-read source)))
|
|
(tp-reactive-reset-counters)
|
|
(tp-with-transaction
|
|
(dotimes (value 100)
|
|
(tp-signal-set source (1+ value))))
|
|
(should (= (tp-signal-peek source) 100))
|
|
(should (= calls 2))
|
|
(should (= (plist-get (tp-reactive-counters) :recomputed) 1)))))
|
|
|
|
(ert-deftest tp-binding-test-nested-write-queues-a-second-pass ()
|
|
"A compute write queues stabilization instead of recursing."
|
|
(tp-binding-test--isolated
|
|
(let ((source (tp-signal-create 0))
|
|
(calls 0))
|
|
(let ((binding
|
|
(tp-bind 'owner '(test . stabilizing)
|
|
(lambda ()
|
|
(cl-incf calls)
|
|
(let ((value (tp-signal-read source)))
|
|
(when (zerop value)
|
|
(tp-signal-set source 1))
|
|
value)))))
|
|
(should (= (tp-binding-read binding) 1))
|
|
(should (= (tp-signal-peek source) 1))
|
|
(should (= calls 2))))))
|
|
|
|
(ert-deftest tp-binding-test-chain-stops-at-equal-computed-value ()
|
|
"An equal intermediate value prevents downstream recomputation."
|
|
(tp-binding-test--isolated
|
|
(let* ((source (tp-signal-create 10))
|
|
(middle-calls 0)
|
|
(leaf-calls 0)
|
|
(middle
|
|
(tp-bind 'middle-owner '(test . quotient)
|
|
(lambda ()
|
|
(cl-incf middle-calls)
|
|
(/ (tp-signal-read source) 10))))
|
|
(_leaf
|
|
(tp-bind 'leaf-owner '(test . display)
|
|
(lambda ()
|
|
(cl-incf leaf-calls)
|
|
(format "%s" (tp-binding-read middle))))))
|
|
(tp-signal-set source 11)
|
|
(should (= middle-calls 2))
|
|
(should (= leaf-calls 1))
|
|
(tp-signal-set source 20)
|
|
(should (= middle-calls 3))
|
|
(should (= leaf-calls 2)))))
|
|
|
|
(ert-deftest tp-binding-test-owner-disposal-cleans-graph-edges ()
|
|
"Disposing an owner removes all incoming and outgoing subscriptions."
|
|
(tp-binding-test--isolated
|
|
(let* ((source (tp-signal-create 1))
|
|
(owner (list 'owner))
|
|
(base (tp-bind owner '(test . base)
|
|
(lambda () (tp-signal-read source))))
|
|
(derived (tp-bind owner '(test . derived)
|
|
(lambda () (1+ (tp-binding-read base))))))
|
|
(should (= (tp-signal-subscriber-count source) 1))
|
|
(should (= (tp-binding-subscriber-count base) 1))
|
|
(should (= (tp-binding-dependency-count derived) 1))
|
|
(tp-binding-dispose-owner owner)
|
|
(should (= (tp-signal-subscriber-count source) 0))
|
|
(should (= (tp-binding-subscriber-count base) 0))
|
|
(should-not (tp-binding-live-p base))
|
|
(should-not (tp-binding-live-p derived)))))
|
|
|
|
(ert-deftest tp-binding-test-failed-compute-rolls-back-values-and-dependencies ()
|
|
"A failed transaction restores signal, binding, and dependency state."
|
|
(tp-binding-test--isolated
|
|
(let* ((switch (tp-signal-create t))
|
|
(left (tp-signal-create 10))
|
|
(right (tp-signal-create 20))
|
|
(binding
|
|
(tp-bind 'owner '(test . branch)
|
|
(lambda ()
|
|
(if (tp-signal-read switch)
|
|
(tp-signal-read left)
|
|
(progn
|
|
(tp-signal-read right)
|
|
(error "Broken branch")))))))
|
|
(let ((counters-before (tp-reactive-counters)))
|
|
(should-error (tp-signal-set switch nil) :type 'error)
|
|
(should (equal (tp-reactive-counters) counters-before)))
|
|
(should (tp-signal-peek switch))
|
|
(should (= (tp-binding-read binding) 10))
|
|
(should (= (tp-signal-subscriber-count left) 1))
|
|
(should (= (tp-signal-subscriber-count right) 0))
|
|
(tp-signal-set left 11)
|
|
(should (= (tp-binding-read binding) 11)))))
|
|
|
|
(ert-deftest tp-binding-test-failed-new-binding-is-unregistered ()
|
|
"A failed initial compute invalidates and unregisters the new binding."
|
|
(tp-binding-test--isolated
|
|
(let (failed)
|
|
(should-error
|
|
(tp-bind 'owner '(test . failing)
|
|
(lambda ()
|
|
(setq failed tp--current-binding)
|
|
(error "Initial failure"))))
|
|
(should-not (tp-binding-live-p failed))
|
|
(let ((replacement
|
|
(tp-bind 'owner '(test . failing) (lambda () 42))))
|
|
(should-not (eq failed replacement))
|
|
(should (= (tp-binding-read replacement) 42))))))
|
|
|
|
(ert-deftest tp-binding-test-key-owns-data-and-preserves-opaque-identities ()
|
|
"A retained binding key copies data containers but not identity objects."
|
|
(tp-binding-test--isolated
|
|
(with-temp-buffer
|
|
(let* ((caller-string (copy-sequence "binding"))
|
|
(caller-vector (vector (copy-sequence "key")))
|
|
(record (tp--make-native-range (current-buffer) :buffer 1 1))
|
|
(calls 0)
|
|
(callback (lambda () (cl-incf calls)))
|
|
(table (make-hash-table :test #'equal))
|
|
(marker (copy-marker (point-min)))
|
|
(key (list 'test caller-string caller-vector record callback
|
|
table marker (current-buffer)))
|
|
(binding (tp-bind 'owner key (lambda () 1)))
|
|
(stored (tp-binding-key binding)))
|
|
(should-not (eq stored key))
|
|
(should-not (eq (nth 1 stored) caller-string))
|
|
(should-not (eq (nth 2 stored) caller-vector))
|
|
(should-not (eq (aref (nth 2 stored) 0) (aref caller-vector 0)))
|
|
(should (eq (nth 3 stored) record))
|
|
(should (eq (nth 4 stored) callback))
|
|
(should (eq (nth 5 stored) table))
|
|
(should (eq (nth 6 stored) marker))
|
|
(should (eq (nth 7 stored) (current-buffer)))
|
|
(should (= calls 0))
|
|
(aset caller-string 0 ?B)
|
|
(aset (aref caller-vector 0) 0 ?K)
|
|
(should (equal (nth 1 stored) "binding"))
|
|
(should (equal (nth 2 stored) ["key"]))))))
|
|
|
|
(ert-deftest tp-binding-test-cycle-error-reports-binding-path ()
|
|
"A binding dependency cycle reports the keys in cycle order."
|
|
(tp-binding-test--isolated
|
|
(let ((switch (tp-signal-create nil)) first second)
|
|
(setq first
|
|
(tp-bind 'first-owner '(test . first)
|
|
(lambda ()
|
|
(if (tp-signal-read switch)
|
|
(tp-binding-read second)
|
|
1))))
|
|
(setq second
|
|
(tp-bind 'second-owner '(test . second)
|
|
(lambda () (1+ (tp-binding-read first)))))
|
|
(let ((failure
|
|
(should-error (tp-signal-set switch t)
|
|
:type 'tp-binding-cycle)))
|
|
(should
|
|
(equal (cadr failure)
|
|
'((test . first) (test . second) (test . first)))))
|
|
(should-not (tp-signal-peek switch))
|
|
(should (= (tp-binding-read first) 1))
|
|
(should (= (tp-binding-read second) 2)))))
|
|
|
|
(ert-deftest tp-binding-test-cycle-error-cannot-mutate-retained-keys ()
|
|
"Cycle diagnostics return data copies instead of retained binding keys."
|
|
(tp-binding-test--isolated
|
|
(let* ((switch (tp-signal-create nil))
|
|
(first-key
|
|
(list 'test (copy-sequence "first")
|
|
(vector (copy-sequence "path"))))
|
|
(second-key
|
|
(list 'test (copy-sequence "second")
|
|
(vector (copy-sequence "path"))))
|
|
first second)
|
|
(setq first
|
|
(tp-bind 'first-owner first-key
|
|
(lambda ()
|
|
(if (tp-signal-read switch)
|
|
(tp-binding-read second)
|
|
1))))
|
|
(setq second
|
|
(tp-bind 'second-owner second-key
|
|
(lambda () (1+ (tp-binding-read first)))))
|
|
(let* ((failure
|
|
(should-error (tp-signal-set switch t)
|
|
:type 'tp-binding-cycle))
|
|
(reported-first (car (cadr failure))))
|
|
(aset (nth 1 reported-first) 0 ?F)
|
|
(aset (aref (nth 2 reported-first) 0) 0 ?P)
|
|
(should (equal (nth 1 (tp-binding-key first)) "first"))
|
|
(should (equal (nth 2 (tp-binding-key first)) ["path"]))))))
|
|
|
|
(ert-deftest tp-binding-test-participant-key-is-owned-by-transaction ()
|
|
"Transaction participant keys cannot follow caller container mutation."
|
|
(tp-binding-test--isolated
|
|
(let* ((caller-string (copy-sequence "participant"))
|
|
(caller-vector (vector (copy-sequence "key")))
|
|
(key (list 'test caller-string caller-vector)))
|
|
(tp-with-transaction
|
|
(tp-transaction-participate key #'ignore #'ignore)
|
|
(let ((stored (tp--transaction-participant-key
|
|
(car tp--transaction-participants))))
|
|
(should-not (eq (nth 1 stored) caller-string))
|
|
(should-not (eq (nth 2 stored) caller-vector))
|
|
(should-not (eq (aref (nth 2 stored) 0)
|
|
(aref caller-vector 0)))
|
|
(aset caller-string 0 ?P)
|
|
(aset (aref caller-vector 0) 0 ?K)
|
|
(should (equal (nth 1 stored) "participant"))
|
|
(should (equal (nth 2 stored) ["key"]))
|
|
(should-error
|
|
(tp-transaction-participate
|
|
(list 'test "participant" ["key"]) #'ignore #'ignore)
|
|
:type 'tp-reactive-error))))))
|
|
|
|
(ert-deftest tp-binding-test-dirty-target-can-break-an-old-cycle-edge ()
|
|
"A dirty target rewires before cycle validation examines its old edges."
|
|
(tp-binding-test--isolated
|
|
(let ((first-mode (tp-signal-create nil))
|
|
(second-mode (tp-signal-create t))
|
|
first second)
|
|
(setq first
|
|
(tp-bind 'first-owner '(test . first)
|
|
(lambda ()
|
|
(if (tp-signal-read first-mode)
|
|
(tp-binding-read second)
|
|
1))))
|
|
(setq second
|
|
(tp-bind 'second-owner '(test . second)
|
|
(lambda ()
|
|
(if (tp-signal-read second-mode)
|
|
(tp-binding-read first)
|
|
2))))
|
|
(tp-with-transaction
|
|
(tp-signal-set second-mode nil)
|
|
(tp-signal-set first-mode t))
|
|
(should (= (tp-binding-read first) 2))
|
|
(should (= (tp-binding-read second) 2)))))
|
|
|
|
(ert-deftest tp-binding-test-buffer-signal-dies-with-its-scope ()
|
|
"Killing a buffer-local source detaches all subscriptions."
|
|
(tp-binding-test--isolated
|
|
(let* ((buffer (generate-new-buffer " *tp-binding-scope*"))
|
|
(signal (tp-signal-create 1 :scope buffer))
|
|
(binding
|
|
(tp-bind 'owner '(test . local)
|
|
(lambda () (tp-signal-read signal)))))
|
|
(should (= (tp-binding-dependency-count binding) 1))
|
|
(kill-buffer buffer)
|
|
(should-not (tp-signal-live-p signal))
|
|
(should (= (tp-binding-dependency-count binding) 0)))))
|
|
|
|
(ert-deftest tp-binding-test-global-signal-can-be-disposed-explicitly ()
|
|
"Explicit disposal releases a global signal's graph edges."
|
|
(tp-binding-test--isolated
|
|
(let* ((signal (tp-signal-create 1))
|
|
(binding
|
|
(tp-bind 'owner '(test . global)
|
|
(lambda () (tp-signal-read signal)))))
|
|
(tp-signal-dispose signal)
|
|
(should-not (tp-signal-live-p signal))
|
|
(should (= (tp-signal-subscriber-count signal) 0))
|
|
(should (= (tp-binding-dependency-count binding) 0)))))
|
|
|
|
(ert-deftest tp-binding-test-variable-adapter-separates-global-and-buffer-scope ()
|
|
"Variable adapters route global and buffer-local writes precisely."
|
|
(tp-binding-test--isolated
|
|
(let* ((symbol 'tp-binding-test-variable)
|
|
(buffer (generate-new-buffer " *tp-binding-variable*"))
|
|
(global-calls 0)
|
|
(local-calls 0))
|
|
(unwind-protect
|
|
(progn
|
|
(set symbol 1)
|
|
(with-current-buffer buffer
|
|
(set (make-local-variable symbol) 10))
|
|
(let ((global (tp-variable-signal symbol))
|
|
(local (tp-variable-signal symbol buffer)))
|
|
(tp-bind 'global-owner '(test . global)
|
|
(lambda ()
|
|
(cl-incf global-calls)
|
|
(tp-signal-read global)))
|
|
(tp-bind 'local-owner '(test . local)
|
|
(lambda ()
|
|
(cl-incf local-calls)
|
|
(tp-signal-read local)))
|
|
(set symbol 2)
|
|
(should (= global-calls 2))
|
|
(should (= local-calls 1))
|
|
(with-current-buffer buffer
|
|
(set symbol 11))
|
|
(should (= global-calls 2))
|
|
(should (= local-calls 2))))
|
|
(when (buffer-live-p buffer) (kill-buffer buffer))
|
|
(makunbound symbol)))))
|
|
|
|
(provide 'tp-binding-tests)
|
|
;;; tp-binding-tests.el ends here
|