;;; 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.")

(define-error 'tp-binding-test-primary "TP binding test primary failure")

(defvar tp-binding-test-transaction-trace nil
  "Dynamic transaction phase trace used by rollback tests.")

(defvar tp-binding-test-precommit-condition nil
  "Condition signaled by the test precommit hook, or nil.")

(defvar tp-binding-test-final-accept-function nil
  "Test final-accept function installed by the test precommit hook.")

(defun tp--binding-test-precommit-inject ()
  "Record precommit and signal `tp-binding-test-precommit-condition'."
  (push 'precommit tp-binding-test-transaction-trace)
  (when tp-binding-test-final-accept-function
    (tp--transaction-install-final-accept
     tp-binding-test-final-accept-function))
  (when tp-binding-test-precommit-condition
    (signal (car tp-binding-test-precommit-condition)
            (cdr tp-binding-test-precommit-condition))))

(defun tp--binding-test-foreign-precommit ()
  "Represent an undeclared private-looking foreign precommit function."
  nil)

(defun tp-binding-test--rollback-hook-fail ()
  "Record rollback hook failure and signal it."
  (push 'rollback-hook-fail tp-binding-test-transaction-trace)
  (error "Rollback hook failure"))

(defun tp-binding-test--rollback-hook-after ()
  "Record the rollback hook following a failed hook."
  (push 'rollback-hook-after tp-binding-test-transaction-trace))

(defun tp-binding-test--rollback-final-fail ()
  "Record rollback-final failure and signal it."
  (push 'rollback-final-fail tp-binding-test-transaction-trace)
  (error "Rollback final failure"))

(defun tp-binding-test--rollback-final-after ()
  "Record the rollback-final hook following a failed hook."
  (push 'rollback-final-after tp-binding-test-transaction-trace))

(defun tp-binding-test--capture-condition (function)
  "Call FUNCTION and return its signaled error or quit condition."
  (condition-case condition
      (progn (funcall function) nil)
    (error condition)
    (quit condition)))

(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-public-transaction-state-follows-dynamic-extent ()
  "The public transaction predicate is true only inside joined transactions."
  (should-not (tp-transaction-active-p))
  (tp-with-transaction
    (should (tp-transaction-active-p))
    (tp-with-transaction
      (should (tp-transaction-active-p))))
  (should-not (tp-transaction-active-p)))

(ert-deftest tp-binding-test-transaction-commits-signals-in-first-touch-order ()
  "Touched signals commit once in first-touch order, including net reverts."
  (tp-binding-test--isolated
    (let* ((first (tp-signal-create 0))
           (second (tp-signal-create 0))
           (third (tp-signal-create 0))
           (original (symbol-function 'tp--commit-signal-entry))
           commit-order final-accept-order (final-accept-count 0))
      (cl-letf (((symbol-function 'tp--commit-signal-entry)
                 (lambda (entry)
                   (push (tp-signal-id
                          (tp--signal-commit-entry-signal entry))
                         commit-order)
                   (funcall original entry)))
                ((symbol-function 'tp--transaction-noop-final-accept)
                 (lambda ()
                   (cl-incf final-accept-count)
                   (setq final-accept-order
                         (mapcar
                          (lambda (entry)
                            (tp-signal-id
                             (tp--signal-commit-entry-signal entry)))
                          tp--transaction-signal-commit-journal)))))
        (tp-with-transaction
          (tp-signal-set second 1)
          (tp-with-transaction
            (tp-signal-set first 1)
            (tp-signal-set second 0))
          (tp-signal-set third 3)))
      (setq commit-order (nreverse commit-order))
      (should (equal commit-order
                     (mapcar #'tp-signal-id (list second first third))))
      (should (equal final-accept-order commit-order))
      (should (= final-accept-count 1))
      (should (= (tp-signal-peek first) 1))
      (should (= (tp-signal-peek second) 0))
      (should (= (tp-signal-peek third) 3))
      (dolist (signal (list first second third))
        (should (= (tp-signal-revision signal) 1))))))

(ert-deftest tp-binding-test-signal-commit-journal-rolls-back-every-write ()
  "Every signal-write injection restores values, revisions, and bindings."
  (tp-binding-test--isolated
    (dolist (fail-after '(0 1 2 3))
      (let* ((first (tp-signal-create 1))
             (second (tp-signal-create 2))
             (third (tp-signal-create 3))
             (binding
              (tp-bind (list 'owner fail-after) '(test . sum)
                       (lambda ()
                         (+ (tp-signal-read first)
                            (tp-signal-read second)
                            (tp-signal-read third)))))
             (binding-revision (tp-binding-revision binding))
             (original (symbol-function 'tp--commit-signal-entry))
             (writes 0))
        (cl-letf (((symbol-function 'tp--commit-signal-entry)
                   (lambda (entry)
                     (when (and (zerop fail-after) (zerop writes))
                       (error "Before first signal write"))
                     (funcall original entry)
                     (cl-incf writes)
                     (when (= writes fail-after)
                       (error "After signal write %d" writes)))))
          (should-error
           (tp-with-transaction
             (tp-signal-set first 10)
             (tp-signal-set second 20)
             (tp-signal-set third 30))))
        (should (equal (mapcar #'tp-signal-peek (list first second third))
                       '(1 2 3)))
        (should (equal (mapcar #'tp-signal-revision
                               (list first second third))
                       '(0 0 0)))
        (should (= (tp-binding-read binding) 6))
        (should (= (tp-binding-revision binding) binding-revision))
        (should (= (tp-binding-dependency-count binding) 3))
        (dolist (signal (list first second third))
          (should (= (tp-signal-subscriber-count signal) 1)))
        (tp-with-transaction
          (tp-signal-set first 10)
          (tp-signal-set second 20)
          (tp-signal-set third 30))
        (should (equal (mapcar #'tp-signal-peek (list first second third))
                       '(10 20 30)))
        (should (equal (mapcar #'tp-signal-revision
                               (list first second third))
                       '(1 1 1)))
        (should (= (tp-binding-read binding) 60))))))

(ert-deftest tp-binding-test-precommit-and-final-accept-failures-roll-back ()
  "Precommit and final-accept error or quit restores pure reactive state."
  (tp-binding-test--isolated
    (dolist (phase '(precommit final-accept))
      (dolist (condition '((error "Injected error") (quit)))
        (let* ((signal (tp-signal-create 1))
               observed-final
               (tp--transaction-precommit-functions
                '(tp--binding-test-precommit-inject))
               (tp--transaction-precommit-allowed-functions
                '(tp--binding-test-precommit-inject))
               (tp-binding-test-precommit-condition
                (and (eq phase 'precommit) condition))
               (tp-binding-test-final-accept-function
                (and (eq phase 'final-accept)
                     (lambda ()
                       (setq observed-final
                             (list (tp-signal-committed-value signal)
                                   (tp-signal-revision signal)))
                       (signal (car condition) (cdr condition))))))
          (let ((failure
                 (tp-binding-test--capture-condition
                  (lambda ()
                    (tp-with-transaction (tp-signal-set signal 2))))))
            (should (eq (car failure) (car condition))))
          (when (eq phase 'final-accept)
            (should (equal observed-final '(2 1))))
          (should (= (tp-signal-peek signal) 1))
          (should (= (tp-signal-revision signal) 0))
          (setq tp--transaction-precommit-functions nil
                tp-binding-test-precommit-condition nil
                tp-binding-test-final-accept-function nil)
          (tp-signal-set signal 2)
          (should (= (tp-signal-peek signal) 2))
          (should (= (tp-signal-revision signal) 1)))))))

(ert-deftest tp-binding-test-final-accept-pending-quit-is-contained ()
  "Clear final-accept pending quit before committed and after-commit actions."
  (tp-binding-test--isolated
    (let ((signal (tp-signal-create 1)) after-ran
          (tp--transaction-precommit-functions
           '(tp--binding-test-precommit-inject))
          (tp--transaction-precommit-allowed-functions
           '(tp--binding-test-precommit-inject))
          (tp-binding-test-final-accept-function
           (lambda () (setq quit-flag t))))
      (tp-with-transaction
        (tp-signal-set signal 2)
        (tp--enqueue-after-commit (lambda () (setq after-ran t))))
      (should (= 2 (tp-signal-peek signal)))
      (should after-ran)
      (should (eq 'final-accept
                  (caar tp--last-transaction-diagnostics))))))

(ert-deftest tp-binding-test-precommit-registry-rejects-foreign-functions ()
  "Only declared TP-internal symbols may enter the precommit registry."
  (tp-binding-test--isolated
    (let ((tp--transaction-precommit-functions nil)
          (tp--transaction-precommit-allowed-functions
           '(tp--binding-test-precommit-inject)))
      (tp--transaction-register-precommit-function
       'tp--binding-test-precommit-inject)
      (should (equal tp--transaction-precommit-functions
                     '(tp--binding-test-precommit-inject)))
      (should-error
       (tp--transaction-register-precommit-function
        'tp--binding-test-foreign-precommit)
       :type 'tp-reactive-error)
      (dolist (foreign
               (list 'ignore 'tp--binding-test-foreign-precommit
                     (lambda () nil)))
        (let ((signal (tp-signal-create 1))
              (tp--transaction-precommit-functions (list foreign)))
          (should-error
           (tp-with-transaction (tp-signal-set signal 2))
           :type 'tp-reactive-error)
          (should (= (tp-signal-peek signal) 1))
          (should (= (tp-signal-revision signal) 0)))))))

(ert-deftest tp-binding-test-production-precommit-registry-is-exact ()
  "The package exposes exactly its one statically declared precommit owner."
  (should (equal tp--transaction-precommit-allowed-functions
                 '(tp--surface-precommit-transaction)))
  (should (equal tp--transaction-precommit-functions
                 '(tp--surface-precommit-transaction))))

(ert-deftest tp-binding-test-condition-trailer-cannot-collide-with-primary-data ()
  "User condition data ending like rollback metadata is not a TP trailer."
  (let ((condition '(error "Primary" :rollback-failures user-value)))
    (should-not
     (tp--transaction-condition-trailer condition :rollback-failures))))

(ert-deftest tp-binding-test-rollback-preserves-primary-and-runs-all-phases ()
  "Rollback failures attach in order without replacing the primary condition."
  (tp-binding-test--isolated
    (let* ((signal (tp-signal-create 1))
           (binding (tp-bind 'owner '(test . rollback)
                             (lambda () (tp-signal-read signal))))
           (tp-binding-test-transaction-trace nil)
           (tp-binding-test-precommit-condition nil)
           (tp--transaction-precommit-functions
            '(tp--binding-test-precommit-inject))
           (tp--transaction-precommit-allowed-functions
            '(tp--binding-test-precommit-inject))
           (tp-binding-test-final-accept-function
            (lambda ()
              (signal 'tp-binding-test-primary
                      '(:payload 7 :rollback-failures user-value))))
           (tp--transaction-rollback-functions
            '(tp-binding-test--rollback-hook-fail
              tp-binding-test--rollback-hook-after))
           (tp--transaction-rollback-final-functions
            '(tp-binding-test--rollback-final-fail
              tp-binding-test--rollback-final-after))
           (restore-signal (symbol-function 'tp--restore-signal-entry))
           (rollback-bindings (symbol-function 'tp--rollback-bindings))
           (restore-counters
            (symbol-function 'tp--restore-transaction-counters))
           signal-restore-failed
           failure)
      (cl-letf (((symbol-function 'tp--restore-signal-entry)
                 (lambda (entry)
                   (funcall restore-signal entry)
                   (push 'signal-restored tp-binding-test-transaction-trace)
                   (unless signal-restore-failed
                     (setq signal-restore-failed t)
                     (error "Signal restore failure"))))
                ((symbol-function 'tp--rollback-bindings)
                 (lambda ()
                   (funcall rollback-bindings)
                   (push 'bindings-restored
                         tp-binding-test-transaction-trace)))
                ((symbol-function 'tp--restore-transaction-counters)
                 (lambda (snapshot)
                   (funcall restore-counters snapshot)
                   (push 'counters-restored
                         tp-binding-test-transaction-trace))))
        (setq failure
              (condition-case condition
                  (tp-with-transaction
                    (tp-transaction-participate-v2
                     :key 'first
                     :stage (lambda ()
                       (push 'publish-first
                             tp-binding-test-transaction-trace))
                     :rollback (lambda ()
                       (push 'rollback-first
                             tp-binding-test-transaction-trace)))
                    (tp-transaction-participate-v2
                     :key 'second
                     :stage (lambda ()
                       (push 'publish-second
                             tp-binding-test-transaction-trace))
                     :rollback (lambda ()
                       (push 'rollback-second
                             tp-binding-test-transaction-trace)))
                    (tp-signal-set signal 2))
                (tp-binding-test-primary condition))))
      (should (eq (car failure) 'tp-binding-test-primary))
      (should (= (plist-get (cdr failure) :payload) 7))
      (should (equal (butlast failure 2)
                     '(tp-binding-test-primary
                       :payload 7 :rollback-failures user-value)))
      (let ((rollback-failures
             (tp--transaction-condition-trailer
              failure :rollback-failures)))
        (should (equal (mapcar #'car rollback-failures)
                       '(rollback-hooks signal-journal rollback-final))))
      (should
       (equal (nreverse tp-binding-test-transaction-trace)
              '(publish-first publish-second precommit
                rollback-second rollback-first
                rollback-hook-fail rollback-hook-after
                signal-restored bindings-restored counters-restored
                rollback-final-fail rollback-final-after)))
      (should (= (tp-signal-peek signal) 1))
      (should (= (tp-signal-revision signal) 0))
      (should (= (tp-binding-read binding) 1)))))

(ert-deftest tp-binding-test-rollback-preserves-quit-primary ()
  "A quit remains primary when rollback hooks fail and later hooks still run."
  (tp-binding-test--isolated
    (let* ((signal (tp-signal-create 1))
           (tp-binding-test-transaction-trace nil)
           (tp--transaction-precommit-functions
            '(tp--binding-test-precommit-inject))
           (tp--transaction-precommit-allowed-functions
            '(tp--binding-test-precommit-inject))
           (tp-binding-test-final-accept-function
            (lambda () (signal 'quit '(:payload 9))))
           (tp--transaction-rollback-functions
            '(tp-binding-test--rollback-hook-fail
              tp-binding-test--rollback-hook-after))
           (failure
            (tp-binding-test--capture-condition
             (lambda ()
               (tp-with-transaction (tp-signal-set signal 2))))))
      (should (eq (car failure) 'quit))
      (should (= (plist-get (cdr failure) :payload) 9))
      (should
       (equal (mapcar #'car
                      (tp--transaction-condition-trailer
                       failure :rollback-failures))
              '(rollback-hooks)))
      (should (equal (nreverse tp-binding-test-transaction-trace)
                     '(precommit rollback-hook-fail rollback-hook-after)))
      (should (= (tp-signal-peek signal) 1))
      (should (= (tp-signal-revision signal) 0)))))

(ert-deftest tp-binding-test-final-accept-throw-rolls-back-nonlocally ()
  "A final-accept throw preserves its tag/value after complete rollback."
  (tp-binding-test--isolated
    (let* ((signal (tp-signal-create 1))
           (binding (tp-bind 'owner '(test . throw)
                             (lambda () (tp-signal-read signal))))
           (binding-revision (tp-binding-revision binding))
           (tp-binding-test-transaction-trace nil)
           (tp--transaction-precommit-functions
            '(tp--binding-test-precommit-inject))
           (tp--transaction-precommit-allowed-functions
            '(tp--binding-test-precommit-inject))
           (tp-binding-test-final-accept-function
            (lambda () (throw 'tp-binding-test-tag 'thrown-value)))
           (tp--transaction-rollback-functions
            '(tp-binding-test--rollback-hook-fail
              tp-binding-test--rollback-hook-after))
           (result
            (catch 'tp-binding-test-tag
              (tp-with-transaction (tp-signal-set signal 2))
              'not-thrown)))
      (should (eq result 'thrown-value))
      (should (equal (nreverse tp-binding-test-transaction-trace)
                     '(precommit rollback-hook-fail rollback-hook-after)))
      (should (= (tp-signal-peek signal) 1))
      (should (= (tp-signal-revision signal) 0))
      (should (= (tp-binding-read binding) 1))
      (should (= (tp-binding-revision binding) binding-revision))
      (setq tp-binding-test-final-accept-function nil
            tp--transaction-precommit-functions nil
            tp--transaction-rollback-functions nil)
      (tp-signal-set signal 2)
      (should (= (tp-signal-peek signal) 2))
      (should (= (tp-signal-revision signal) 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-v2
         :key key :stage #'ignore :rollback #'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-v2
            :key (list 'test "participant" ["key"])
            :stage #'ignore :rollback #'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)))))

(ert-deftest tp-binding-test-precomputed-keeps-explicit-edge-reactive ()
  "A precomputed binding skips first compute and reacts through its edge."
  (let* ((signal (tp-signal-create 1))
         (parent (tp-bind 'parent 'value (lambda () (tp-signal-read signal))))
         (runs 0)
         (child
          (tp-bind-precomputed
           'child 'value
           (lambda () (cl-incf runs) (1+ (tp-binding-read parent)))
           2 (list parent))))
    (should (= (tp-binding-read child) 2))
    (should (= runs 0))
    (should (= (tp-binding-dependency-count child) 1))
    (tp-signal-set signal 4)
    (should (= (tp-binding-read child) 5))
    (should (= runs 1))))

(provide 'tp-binding-tests)
;;; tp-binding-tests.el ends here