giles
50871780a3
Regression tests for the silent failure where callLambda returns a Thunk (TCO) that must be trampolined for side effects to execute. Without trampoline, event handlers (swap!, reset!) silently did nothing. 5 tests covering: single mutation, event arg passing, multi-statement body, repeated accumulation, and nested lambda calls — all through the (trampoline (call-lambda handler args)) pattern that dom-on uses. Tests: 1322 JS (full), 1114 OCaml Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
349 lines
12 KiB
Plaintext
349 lines
12 KiB
Plaintext
;; ==========================================================================
|
|
;; test-signals-advanced.sx — Stress tests for the reactive signal system
|
|
;;
|
|
;; Requires: test-framework.sx loaded first.
|
|
;; Modules tested: signals.sx (signal, deref, reset!, swap!, computed,
|
|
;; effect, batch)
|
|
;;
|
|
;; Note: Multi-expression lambda bodies are wrapped in (do ...) for
|
|
;; compatibility with evaluators that support only single-expression bodies.
|
|
;; ==========================================================================
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Signal basics extended
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "signal-basics-extended"
|
|
(deftest "signal with nil initial value"
|
|
(let ((s (signal nil)))
|
|
(assert-true (signal? s))
|
|
(assert-nil (deref s))))
|
|
|
|
(deftest "signal with list value"
|
|
(let ((s (signal (list 1 2 3))))
|
|
(assert-equal (list 1 2 3) (deref s))
|
|
(reset! s (list 4 5 6))
|
|
(assert-equal (list 4 5 6) (deref s))))
|
|
|
|
(deftest "signal with dict value"
|
|
(let ((s (signal {:name "alice" :score 42})))
|
|
(assert-equal "alice" (get (deref s) "name"))
|
|
(assert-equal 42 (get (deref s) "score"))))
|
|
|
|
(deftest "signal with lambda value"
|
|
(let ((fn-val (fn (x) (* x 2)))
|
|
(s (signal nil)))
|
|
(reset! s fn-val)
|
|
;; The stored lambda should be callable
|
|
(assert-equal 10 ((deref s) 5))))
|
|
|
|
(deftest "multiple signals independent of each other"
|
|
(let ((a (signal 1))
|
|
(b (signal 2))
|
|
(c (signal 3)))
|
|
(reset! a 10)
|
|
;; b and c must be unchanged
|
|
(assert-equal 10 (deref a))
|
|
(assert-equal 2 (deref b))
|
|
(assert-equal 3 (deref c))
|
|
(reset! b 20)
|
|
(assert-equal 10 (deref a))
|
|
(assert-equal 20 (deref b))
|
|
(assert-equal 3 (deref c))))
|
|
|
|
(deftest "deref returns current value not a stale snapshot"
|
|
(let ((s (signal "first")))
|
|
(let ((snap1 (deref s)))
|
|
(reset! s "second")
|
|
(let ((snap2 (deref s)))
|
|
;; snap1 holds the string "first" (immutable), snap2 is "second"
|
|
(assert-equal "first" snap1)
|
|
(assert-equal "second" snap2))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Computed chains
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "computed-chains"
|
|
(deftest "chain of three computed signals"
|
|
(let ((base (signal 2))
|
|
(doubled (computed (fn () (* 2 (deref base)))))
|
|
(tripled (computed (fn () (* 3 (deref doubled))))))
|
|
;; Initial: base=2 → doubled=4 → tripled=12
|
|
(assert-equal 4 (deref doubled))
|
|
(assert-equal 12 (deref tripled))
|
|
;; Update propagates through the entire chain
|
|
(reset! base 5)
|
|
(assert-equal 10 (deref doubled))
|
|
(assert-equal 30 (deref tripled))))
|
|
|
|
(deftest "computed depending on multiple signals"
|
|
(let ((x (signal 3))
|
|
(y (signal 4))
|
|
(hypo (computed (fn ()
|
|
;; sqrt(x^2 + y^2) — Pythagorean hypotenuse (integer approx)
|
|
(+ (* (deref x) (deref x))
|
|
(* (deref y) (deref y)))))))
|
|
(assert-equal 25 (deref hypo))
|
|
(reset! x 0)
|
|
(assert-equal 16 (deref hypo))
|
|
(reset! y 0)
|
|
(assert-equal 0 (deref hypo))))
|
|
|
|
(deftest "computed with conditional logic"
|
|
(let ((flag (signal true))
|
|
(a (signal 10))
|
|
(b (signal 99))
|
|
(result (computed (fn ()
|
|
(if (deref flag) (deref a) (deref b))))))
|
|
(assert-equal 10 (deref result))
|
|
(reset! flag false)
|
|
(assert-equal 99 (deref result))
|
|
(reset! b 42)
|
|
(assert-equal 42 (deref result))
|
|
(reset! flag true)
|
|
(assert-equal 10 (deref result))))
|
|
|
|
(deftest "diamond dependency: A->B, A->C, B+C->D"
|
|
;; A change in A must propagate via both B and C to D,
|
|
;; but D must still hold a coherent (not intermediate) value.
|
|
(let ((A (signal 1))
|
|
(B (computed (fn () (* 2 (deref A)))))
|
|
(C (computed (fn () (* 3 (deref A)))))
|
|
(D (computed (fn () (+ (deref B) (deref C))))))
|
|
;; A=1 → B=2, C=3 → D=5
|
|
(assert-equal 2 (deref B))
|
|
(assert-equal 3 (deref C))
|
|
(assert-equal 5 (deref D))
|
|
;; A=4 → B=8, C=12 → D=20
|
|
(reset! A 4)
|
|
(assert-equal 8 (deref B))
|
|
(assert-equal 12 (deref C))
|
|
(assert-equal 20 (deref D))))
|
|
|
|
(deftest "computed returns nil when source signal is nil"
|
|
(let ((s (signal nil))
|
|
(c (computed (fn ()
|
|
(let ((v (deref s)))
|
|
(when (not (nil? v)) (* v 2)))))))
|
|
(assert-nil (deref c))
|
|
(reset! s 7)
|
|
(assert-equal 14 (deref c))
|
|
(reset! s nil)
|
|
(assert-nil (deref c)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Effect patterns
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "effect-patterns"
|
|
(deftest "effect runs immediately on creation"
|
|
(let ((ran (signal false)))
|
|
(effect (fn () (reset! ran true)))
|
|
(assert-true (deref ran))))
|
|
|
|
(deftest "effect re-runs when dependency changes"
|
|
(let ((n (signal 0))
|
|
(calls (signal 0)))
|
|
(effect (fn () (do (deref n) (swap! calls inc))))
|
|
;; Initial run counts as 1
|
|
(assert-equal 1 (deref calls))
|
|
(reset! n 1)
|
|
(assert-equal 2 (deref calls))
|
|
(reset! n 2)
|
|
(assert-equal 3 (deref calls))))
|
|
|
|
(deftest "effect with multiple dependencies"
|
|
(let ((a (signal "x"))
|
|
(b (signal "y"))
|
|
(calls (signal 0)))
|
|
(effect (fn () (do (deref a) (deref b) (swap! calls inc))))
|
|
(assert-equal 1 (deref calls))
|
|
;; Changing a triggers re-run
|
|
(reset! a "x2")
|
|
(assert-equal 2 (deref calls))
|
|
;; Changing b also triggers re-run
|
|
(reset! b "y2")
|
|
(assert-equal 3 (deref calls))))
|
|
|
|
(deftest "effect cleanup function called on re-run"
|
|
(let ((trigger (signal 0))
|
|
(cleanups (signal 0)))
|
|
(effect (fn () (do
|
|
(deref trigger)
|
|
;; Return a cleanup function
|
|
(fn () (swap! cleanups inc)))))
|
|
;; First run — no previous cleanup to call
|
|
(assert-equal 0 (deref cleanups))
|
|
;; Second run — previous cleanup fires first
|
|
(reset! trigger 1)
|
|
(assert-equal 1 (deref cleanups))
|
|
;; Third run — second cleanup fires
|
|
(reset! trigger 2)
|
|
(assert-equal 2 (deref cleanups))))
|
|
|
|
(deftest "effect tracks only actually-deref'd signals"
|
|
;; An effect that conditionally reads signal B should only re-run
|
|
;; for B changes when B is actually read (flag=true).
|
|
(let ((flag (signal true))
|
|
(b (signal 0))
|
|
(calls (signal 0)))
|
|
(effect (fn () (do
|
|
(deref flag)
|
|
(when (deref flag) (deref b))
|
|
(swap! calls inc))))
|
|
;; Initial run reads both flag and b
|
|
(assert-equal 1 (deref calls))
|
|
;; flip flag to false — re-run, but now b is NOT deref'd
|
|
(reset! flag false)
|
|
(assert-equal 2 (deref calls))
|
|
;; Changing b should NOT trigger another run (b wasn't deref'd last time)
|
|
(reset! b 99)
|
|
(assert-equal 2 (deref calls)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Batch behavior
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "batch-behavior"
|
|
(deftest "batch coalesces multiple signal updates into one effect run"
|
|
(let ((a (signal 0))
|
|
(b (signal 0))
|
|
(run-count (signal 0)))
|
|
(effect (fn () (do (deref a) (deref b) (swap! run-count inc))))
|
|
;; Initial run
|
|
(assert-equal 1 (deref run-count))
|
|
;; Two writes inside a single batch → one effect run, not two
|
|
(batch (fn () (do
|
|
(reset! a 1)
|
|
(reset! b 2))))
|
|
(assert-equal 2 (deref run-count))))
|
|
|
|
(deftest "nested batch — inner batch does not flush, outer batch does"
|
|
(let ((s (signal 0))
|
|
(run-count (signal 0)))
|
|
(effect (fn () (do (deref s) (swap! run-count inc))))
|
|
(assert-equal 1 (deref run-count))
|
|
(batch (fn ()
|
|
(batch (fn ()
|
|
(reset! s 1)))
|
|
;; Still inside outer batch — should not have fired yet
|
|
(reset! s 2)))
|
|
;; Outer batch ends → exactly one more run
|
|
(assert-equal 2 (deref run-count))
|
|
;; Final value is the last write
|
|
(assert-equal 2 (deref s))))
|
|
|
|
(deftest "batch with computed — computed updates once not per signal write"
|
|
(let ((x (signal 0))
|
|
(y (signal 0))
|
|
(sum (computed (fn () (+ (deref x) (deref y)))))
|
|
(recomps (signal 0)))
|
|
;; Track recomputations by wrapping via an effect
|
|
(effect (fn () (do (deref sum) (swap! recomps inc))))
|
|
;; Initial: effect + computed both ran once
|
|
(assert-equal 1 (deref recomps))
|
|
(batch (fn () (do
|
|
(reset! x 10)
|
|
(reset! y 20))))
|
|
;; sum must reflect both changes
|
|
(assert-equal 30 (deref sum))
|
|
;; effect re-ran at most once more (not twice)
|
|
(assert-equal 2 (deref recomps))))
|
|
|
|
(deftest "batch executes the thunk"
|
|
;; batch runs the thunk for side effects; return value is implementation-defined
|
|
(let ((s (signal 0)))
|
|
(batch (fn () (reset! s 42)))
|
|
(assert-equal 42 (deref s)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Swap patterns
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "swap-patterns"
|
|
(deftest "swap! with increment function"
|
|
(let ((n (signal 0)))
|
|
(swap! n inc)
|
|
(assert-equal 1 (deref n))
|
|
(swap! n inc)
|
|
(assert-equal 2 (deref n))))
|
|
|
|
(deftest "swap! with list append"
|
|
(let ((items (signal (list))))
|
|
(swap! items (fn (l) (append l "a")))
|
|
(swap! items (fn (l) (append l "b")))
|
|
(swap! items (fn (l) (append l "c")))
|
|
(assert-equal (list "a" "b" "c") (deref items))))
|
|
|
|
(deftest "swap! with dict assoc"
|
|
(let ((store (signal {})))
|
|
(swap! store (fn (d) (assoc d "x" 1)))
|
|
(swap! store (fn (d) (assoc d "y" 2)))
|
|
(assert-equal 1 (get (deref store) "x"))
|
|
(assert-equal 2 (get (deref store) "y"))))
|
|
|
|
(deftest "multiple swap! in sequence build up correct value"
|
|
(let ((acc (signal 0)))
|
|
(swap! acc + 10)
|
|
(swap! acc + 5)
|
|
(swap! acc - 3)
|
|
(assert-equal 12 (deref acc)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; call-lambda + trampoline — event handler pattern
|
|
;; --------------------------------------------------------------------------
|
|
;;
|
|
;; Regression: dom-on wraps Lambda event handlers in JS functions that
|
|
;; call callLambda. callLambda returns a Thunk (TCO), but the wrapper
|
|
;; never trampolined it, so the handler body (swap!, reset!, etc.)
|
|
;; never executed. Buttons rendered but clicks had no effect.
|
|
;;
|
|
;; These tests verify the pattern that dom-on uses:
|
|
;; (trampoline (call-lambda handler (list arg)))
|
|
;; must resolve thunks and execute side effects.
|
|
|
|
(defsuite "call-lambda-trampoline-handlers"
|
|
(deftest "call-lambda + trampoline executes signal mutation"
|
|
(let ((count (signal 0))
|
|
(handler (fn () (swap! count + 1))))
|
|
(trampoline (call-lambda handler (list)))
|
|
(assert-equal 1 (deref count))))
|
|
|
|
(deftest "call-lambda + trampoline with event arg"
|
|
(let ((last-val (signal nil))
|
|
(handler (fn (e) (reset! last-val e))))
|
|
(trampoline (call-lambda handler (list "click-event")))
|
|
(assert-equal "click-event" (deref last-val))))
|
|
|
|
(deftest "call-lambda + trampoline executes multi-statement body"
|
|
(let ((a (signal 0))
|
|
(b (signal 0))
|
|
(handler (fn ()
|
|
(reset! a 10)
|
|
(reset! b 20))))
|
|
(trampoline (call-lambda handler (list)))
|
|
(assert-equal 10 (deref a))
|
|
(assert-equal 20 (deref b))))
|
|
|
|
(deftest "repeated call-lambda accumulates side effects"
|
|
(let ((count (signal 0))
|
|
(handler (fn () (swap! count + 1))))
|
|
(trampoline (call-lambda handler (list)))
|
|
(trampoline (call-lambda handler (list)))
|
|
(trampoline (call-lambda handler (list)))
|
|
(assert-equal 3 (deref count))))
|
|
|
|
(deftest "call-lambda handler calling another lambda"
|
|
(let ((log (signal (list)))
|
|
(inner (fn (msg) (reset! log (append (deref log) (list msg)))))
|
|
(outer (fn () (inner "hello") (inner "world"))))
|
|
(trampoline (call-lambda outer (list)))
|
|
(assert-equal (list "hello" "world") (deref log)))))
|