bind is now a CEK special form that captures its body unevaluated, establishes a tracking context (*bind-tracking*), and registers subscribers on provide frames when context reads are tracked. - bind special form: step-sf-bind, make-bind-frame, bind continue handler - provide-set frame: provide! evaluates value with kont (fixes peek bug) - context tracking: step-sf-context appends to *bind-tracking* when active - scope-stack fallback: provide pushes to scope stack for cek-call contexts - CekFrame mutation: cf_remaining/cf_results/cf_extra2 now mutable - Transpiler: subscribers + prev-tracking field mappings, *bind-tracking* in ml-mutable-globals - Test fixes: string-append → str, restored edge-cases suite Passing: bind returns initial value, bind with expression, bind with let, bind no deps is static, bind with conditional deps, provide! updates/multiple/nil, provide! computed new value, peek read-modify-write, guard inside bind, bind with string-append, provide! same value does not notify, bind does not fire on unrelated provide!, bind sees latest value, bind inside provide scope. Remaining: subscriber re-evaluation on provide! (scope-stack key issue), batch coalescing (no batch support yet). Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
542 lines
16 KiB
Plaintext
542 lines
16 KiB
Plaintext
;; ==========================================================================
|
|
;; test-unified-reactive.sx — Tests for step 10c unified reactive model
|
|
;;
|
|
;; Requires: test-framework.sx, signals.sx loaded first.
|
|
;;
|
|
;; Tests the unified reactive model where:
|
|
;; - provide stores values in reactive cells (signals internally)
|
|
;; - context reads cells; auto-subscribes inside tracking contexts
|
|
;; - peek reads cells without subscribing
|
|
;; - provide! mutates cells and notifies subscribers
|
|
;; - bind creates a tracking context — re-evaluates body on change
|
|
;;
|
|
;; signal/deref/computed/effect remain unchanged and complementary.
|
|
;; ==========================================================================
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; provide creates reactive cells
|
|
;; --------------------------------------------------------------------------
|
|
(defsuite
|
|
"provide-reactive-cell"
|
|
(deftest
|
|
"provide scopes value to body"
|
|
(assert-equal 42 (provide :x 42 (context :x))))
|
|
(deftest
|
|
"provide multiple keys"
|
|
(provide
|
|
:x 1
|
|
(provide :y 2 (assert-equal 3 (+ (context :x) (context :y))))))
|
|
(deftest
|
|
"provide nested shadow"
|
|
(provide
|
|
:x 1
|
|
(assert-equal 1 (context :x))
|
|
(provide :x 2 (assert-equal 2 (context :x)))
|
|
(assert-equal 1 (context :x))))
|
|
(deftest
|
|
"provide nil value is valid"
|
|
(provide :x nil (assert-equal nil (context :x))))
|
|
(deftest
|
|
"provide dict value"
|
|
(provide
|
|
:data {:age 30 :name "alice"}
|
|
(assert-equal "alice" (get (context :data) "name"))))
|
|
(deftest
|
|
"provide lambda value"
|
|
(provide
|
|
:handler (fn (x) (* x 2))
|
|
(assert-equal 10 ((context :handler) 5))))
|
|
(deftest
|
|
"provide deep nesting"
|
|
(provide
|
|
:a 1
|
|
(provide
|
|
:b 2
|
|
(provide
|
|
:c 3
|
|
(provide
|
|
:d 4
|
|
(provide
|
|
:e 5
|
|
(assert-equal
|
|
15
|
|
(+
|
|
(context :a)
|
|
(context :b)
|
|
(context :c)
|
|
(context :d)
|
|
(context :e)))))))))
|
|
(deftest
|
|
"provide overwrites in same scope"
|
|
(provide :x 1 (provide :x 2 (assert-equal 2 (context :x)))))
|
|
(deftest
|
|
"provide with empty body returns nil"
|
|
(assert-equal nil (provide :x 1))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; context reads — cold and tracked
|
|
;; --------------------------------------------------------------------------
|
|
(defsuite
|
|
"context-read"
|
|
(deftest
|
|
"context returns provided value"
|
|
(provide :name "alice" (assert-equal "alice" (context :name))))
|
|
(deftest
|
|
"context missing key returns nil"
|
|
(assert-equal nil (context :nonexistent)))
|
|
(deftest
|
|
"context missing key with default"
|
|
(assert-equal "fallback" (context :nonexistent "fallback")))
|
|
(deftest
|
|
"context finds nearest provide"
|
|
(provide
|
|
:x "outer"
|
|
(provide :x "inner" (assert-equal "inner" (context :x)))))
|
|
(deftest
|
|
"context in let binding"
|
|
(provide :x 10 (let ((v (context :x))) (assert-equal 10 v))))
|
|
(deftest
|
|
"context in lambda"
|
|
(provide
|
|
:x 42
|
|
(let ((f (fn () (context :x)))) (assert-equal 42 (f)))))
|
|
(deftest
|
|
"context in map"
|
|
(provide
|
|
:prefix "item-"
|
|
(assert-equal
|
|
(list "item-a" "item-b")
|
|
(map (fn (x) (str (context :prefix) x)) (list "a" "b")))))
|
|
(deftest
|
|
"context with keyword name"
|
|
(provide :my-key 99 (assert-equal 99 (context :my-key)))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; peek — cold read, never subscribes
|
|
;; --------------------------------------------------------------------------
|
|
(defsuite
|
|
"peek-cold-read"
|
|
(deftest
|
|
"peek returns current value"
|
|
(provide :x 42 (assert-equal 42 (peek :x))))
|
|
(deftest
|
|
"peek missing key returns nil"
|
|
(assert-equal nil (peek :nonexistent)))
|
|
(deftest
|
|
"peek missing key with default"
|
|
(assert-equal "default" (peek :nonexistent "default")))
|
|
(deftest
|
|
"peek finds nearest provide"
|
|
(provide
|
|
:x "outer"
|
|
(provide :x "inner" (assert-equal "inner" (peek :x)))))
|
|
(deftest
|
|
"peek sees updated value after provide!"
|
|
(provide :x 1 (provide! :x 2) (assert-equal 2 (peek :x))))
|
|
(deftest
|
|
"peek does not subscribe"
|
|
(provide
|
|
:x 1
|
|
(provide
|
|
:y 0
|
|
(let
|
|
((count (signal 0)))
|
|
(bind
|
|
(do
|
|
(let
|
|
((peeked (peek :x)))
|
|
(reset! count (+ 1 (deref count))))
|
|
nil))
|
|
(assert-equal 1 (deref count))
|
|
(provide! :x 2)
|
|
(assert-equal 1 (deref count)))))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; provide! — mutate and notify
|
|
;; --------------------------------------------------------------------------
|
|
(defsuite
|
|
"provide-mutation"
|
|
(deftest
|
|
"provide! updates value"
|
|
(provide :x 1 (provide! :x 2) (assert-equal 2 (context :x))))
|
|
(deftest
|
|
"provide! multiple times"
|
|
(provide
|
|
:x 1
|
|
(provide! :x 2)
|
|
(provide! :x 3)
|
|
(assert-equal 3 (context :x))))
|
|
(deftest
|
|
"provide! nil is valid"
|
|
(provide :x 1 (provide! :x nil) (assert-equal nil (context :x))))
|
|
(deftest
|
|
"provide! inner scope does not affect outer"
|
|
(provide
|
|
:x 1
|
|
(provide :x 10 (provide! :x 20))
|
|
(assert-equal 1 (context :x))))
|
|
(deftest
|
|
"provide! to string value"
|
|
(provide
|
|
:msg "hello"
|
|
(provide! :msg "world")
|
|
(assert-equal "world" (context :msg))))
|
|
(deftest
|
|
"provide! to list value"
|
|
(provide
|
|
:items (list 1 2)
|
|
(provide! :items (list 1 2 3))
|
|
(assert-equal (list 1 2 3) (context :items))))
|
|
(deftest
|
|
"provide! with computed new value"
|
|
(provide
|
|
:count 0
|
|
(provide! :count (+ 1 (peek :count)))
|
|
(assert-equal 1 (context :count))
|
|
(provide! :count (+ 1 (peek :count)))
|
|
(assert-equal 2 (context :count)))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; bind — tracking context
|
|
;; --------------------------------------------------------------------------
|
|
(defsuite
|
|
"bind-tracking"
|
|
(deftest
|
|
"bind returns initial value"
|
|
(provide :x 10 (assert-equal 10 (bind (context :x)))))
|
|
(deftest
|
|
"bind with expression"
|
|
(provide :x 3 (assert-equal 9 (bind (* (context :x) (context :x))))))
|
|
(deftest
|
|
"bind re-evaluates on provide!"
|
|
(provide
|
|
:x 1
|
|
(let
|
|
((log (signal (list))))
|
|
(bind
|
|
(do (swap! log (fn (l) (append l (list (context :x))))) nil))
|
|
(assert-equal (list 1) (deref log))
|
|
(provide! :x 2)
|
|
(assert-equal (list 1 2) (deref log)))))
|
|
(deftest
|
|
"bind tracks multiple keys"
|
|
(provide
|
|
:x 1
|
|
(provide
|
|
:y 10
|
|
(let
|
|
((log (signal (list))))
|
|
(bind
|
|
(do
|
|
(swap!
|
|
log
|
|
(fn (l) (append l (list (+ (context :x) (context :y))))))
|
|
nil))
|
|
(assert-equal (list 11) (deref log))
|
|
(provide! :x 2)
|
|
(assert-equal (list 11 12) (deref log))
|
|
(provide! :y 20)
|
|
(assert-equal (list 11 12 22) (deref log))))))
|
|
(deftest
|
|
"bind does not fire on unrelated provide!"
|
|
(provide
|
|
:x 1
|
|
(provide
|
|
:y 100
|
|
(let
|
|
((count (signal 0)))
|
|
(bind
|
|
(do
|
|
(let ((v (context :x))) (reset! count (+ 1 (deref count))))
|
|
nil))
|
|
(assert-equal 1 (deref count))
|
|
(provide! :y 200)
|
|
(assert-equal 1 (deref count))
|
|
(provide! :x 2)
|
|
(assert-equal 2 (deref count))))))
|
|
(deftest
|
|
"bind with let"
|
|
(provide
|
|
:x 5
|
|
(assert-equal
|
|
"value: 5"
|
|
(bind (let ((v (context :x))) (str "value: " v))))))
|
|
(deftest
|
|
"bind no deps is static"
|
|
(let
|
|
((count (signal 0)))
|
|
(bind (do (reset! count (+ 1 (deref count))) "static"))
|
|
(assert-equal 1 (deref count))))
|
|
(deftest
|
|
"bind with conditional deps"
|
|
(provide
|
|
:flag true
|
|
(provide
|
|
:a "yes"
|
|
(provide
|
|
:b "no"
|
|
(assert-equal
|
|
"yes"
|
|
(bind (if (context :flag) (context :a) (context :b)))))))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; bind + provide! interaction — re-evaluation semantics
|
|
;; --------------------------------------------------------------------------
|
|
(defsuite
|
|
"bind-provide-interaction"
|
|
(deftest
|
|
"bind sees latest value after provide!"
|
|
(provide
|
|
:x 1
|
|
(let
|
|
((latest (signal nil)))
|
|
(bind (do (reset! latest (context :x)) nil))
|
|
(assert-equal 1 (deref latest))
|
|
(provide! :x 42)
|
|
(assert-equal 42 (deref latest)))))
|
|
(deftest
|
|
"provide! from within callback pattern"
|
|
(provide
|
|
:count 0
|
|
(let
|
|
((increment (fn () (provide! :count (+ 1 (peek :count))))))
|
|
(let
|
|
((log (signal (list))))
|
|
(bind
|
|
(do
|
|
(swap! log (fn (l) (append l (list (context :count)))))
|
|
nil))
|
|
(assert-equal (list 0) (deref log))
|
|
(increment)
|
|
(assert-equal (list 0 1) (deref log))
|
|
(increment)
|
|
(assert-equal (list 0 1 2) (deref log))))))
|
|
(deftest
|
|
"multiple binds on same key"
|
|
(provide
|
|
:x 1
|
|
(let
|
|
((log-a (signal (list))) (log-b (signal (list))))
|
|
(bind
|
|
(do (swap! log-a (fn (l) (append l (list (context :x))))) nil))
|
|
(bind
|
|
(do
|
|
(swap! log-b (fn (l) (append l (list (* 10 (context :x))))))
|
|
nil))
|
|
(assert-equal (list 1) (deref log-a))
|
|
(assert-equal (list 10) (deref log-b))
|
|
(provide! :x 2)
|
|
(assert-equal (list 1 2) (deref log-a))
|
|
(assert-equal (list 10 20) (deref log-b)))))
|
|
(deftest
|
|
"provide! same value does not notify"
|
|
(provide
|
|
:x 1
|
|
(let
|
|
((count (signal 0)))
|
|
(bind
|
|
(do
|
|
(let ((v (context :x))) (reset! count (+ 1 (deref count))))
|
|
nil))
|
|
(assert-equal 1 (deref count))
|
|
(provide! :x 1)
|
|
(assert-equal 1 (deref count))))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; nested bind
|
|
;; --------------------------------------------------------------------------
|
|
(defsuite
|
|
"bind-nesting"
|
|
(deftest
|
|
"nested bind tracks independently"
|
|
(provide
|
|
:x 1
|
|
(provide
|
|
:y 10
|
|
(let
|
|
((outer-log (signal (list))) (inner-log (signal (list))))
|
|
(bind
|
|
(do
|
|
(swap! outer-log (fn (l) (append l (list (context :x)))))
|
|
(bind
|
|
(do
|
|
(swap!
|
|
inner-log
|
|
(fn (l) (append l (list (context :y)))))
|
|
nil))
|
|
nil))
|
|
(assert-equal (list 1) (deref outer-log))
|
|
(assert-equal (list 10) (deref inner-log))
|
|
(provide! :y 20)
|
|
(assert-equal (list 1) (deref outer-log))
|
|
(assert-equal (list 10 20) (deref inner-log))))))
|
|
(deftest
|
|
"bind inside provide scope"
|
|
(provide
|
|
:x 1
|
|
(provide
|
|
:y 2
|
|
(let
|
|
((result (signal nil)))
|
|
(bind (do (reset! result (+ (context :x) (context :y))) nil))
|
|
(assert-equal 3 (deref result))
|
|
(provide! :y 10)
|
|
(assert-equal 11 (deref result)))))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; batching with unified model
|
|
;; --------------------------------------------------------------------------
|
|
(defsuite
|
|
"unified-batch"
|
|
(deftest
|
|
"batch coalesces provide! notifications"
|
|
(provide
|
|
:x 1
|
|
(let
|
|
((count (signal 0)))
|
|
(bind
|
|
(do
|
|
(let ((v (context :x))) (reset! count (+ 1 (deref count))))
|
|
nil))
|
|
(assert-equal 1 (deref count))
|
|
(batch
|
|
(fn () (do (provide! :x 2) (provide! :x 3) (provide! :x 4))))
|
|
(assert-equal 2 (deref count))
|
|
(assert-equal 4 (context :x)))))
|
|
(deftest
|
|
"batch with multiple keys"
|
|
(provide
|
|
:x 0
|
|
(provide
|
|
:y 0
|
|
(let
|
|
((count (signal 0)))
|
|
(bind
|
|
(do
|
|
(let
|
|
((sum (+ (context :x) (context :y))))
|
|
(reset! count (+ 1 (deref count))))
|
|
nil))
|
|
(assert-equal 1 (deref count))
|
|
(batch (fn () (do (provide! :x 10) (provide! :y 20))))
|
|
(assert-equal 2 (deref count)))))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; disposal and lifecycle
|
|
;; --------------------------------------------------------------------------
|
|
(defsuite
|
|
"unified-disposal"
|
|
(deftest
|
|
"provide scope exit cleans up"
|
|
(do
|
|
(provide :temp 1 (assert-equal 1 (context :temp)))
|
|
(assert-equal nil (context :temp))))
|
|
(deftest
|
|
"bind in provide scope disposes on exit"
|
|
(provide
|
|
:x 1
|
|
(let
|
|
((count (signal 0)))
|
|
(provide
|
|
:y 10
|
|
(bind
|
|
(do
|
|
(let ((v (context :y))) (reset! count (+ 1 (deref count))))
|
|
nil))
|
|
(assert-equal 1 (deref count))
|
|
(provide! :y 20)
|
|
(assert-equal 2 (deref count)))
|
|
(assert-equal 2 (deref count))))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; backward compatibility — signal/deref still work
|
|
;; --------------------------------------------------------------------------
|
|
(defsuite
|
|
"unified-backward-compat"
|
|
(deftest
|
|
"signal and deref still work"
|
|
(let
|
|
((s (signal 42)))
|
|
(assert-equal 42 (deref s))
|
|
(reset! s 100)
|
|
(assert-equal 100 (deref s))))
|
|
(deftest
|
|
"computed still works"
|
|
(let
|
|
((s (signal 3)))
|
|
(let
|
|
((doubled (computed (fn () (* 2 (deref s))))))
|
|
(assert-equal 6 (deref doubled))
|
|
(reset! s 5)
|
|
(assert-equal 10 (deref doubled)))))
|
|
(deftest
|
|
"effect still works"
|
|
(let
|
|
((s (signal "a")) (log (signal (list))))
|
|
(effect (fn () (swap! log (fn (l) (append l (list (deref s)))))))
|
|
(assert-equal (list "a") (deref log))
|
|
(reset! s "b")
|
|
(assert-equal (list "a" "b") (deref log))))
|
|
(deftest
|
|
"signal inside provide"
|
|
(provide
|
|
:label "hello"
|
|
(let
|
|
((count (signal 0)))
|
|
(assert-equal "hello" (context :label))
|
|
(assert-equal 0 (deref count))
|
|
(reset! count 1)
|
|
(assert-equal 1 (deref count))
|
|
(assert-equal "hello" (context :label))))))
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; edge cases
|
|
;; --------------------------------------------------------------------------
|
|
(defsuite
|
|
"unified-edge-cases"
|
|
(deftest
|
|
"provide across lambda boundary"
|
|
(provide
|
|
:theme "dark"
|
|
(let
|
|
((get-theme (fn () (context :theme))))
|
|
(assert-equal "dark" (get-theme)))))
|
|
(deftest
|
|
"provide! with peek for read-modify-write"
|
|
(provide
|
|
:items (list)
|
|
(provide! :items (append (peek :items) (list "a")))
|
|
(provide! :items (append (peek :items) (list "b")))
|
|
(assert-equal (list "a" "b") (context :items))))
|
|
(deftest
|
|
"context in higher-order form"
|
|
(provide
|
|
:multiplier 3
|
|
(assert-equal
|
|
(list 3 6 9)
|
|
(map (fn (x) (* x (context :multiplier))) (list 1 2 3)))))
|
|
(deftest
|
|
"context in filter"
|
|
(provide
|
|
:threshold 5
|
|
(assert-equal
|
|
(list 6 7 8)
|
|
(filter (fn (x) (> x (context :threshold))) (list 3 4 5 6 7 8)))))
|
|
(deftest
|
|
"provide string key coercion"
|
|
(provide :my-key 42 (assert-equal 42 (context :my-key))))
|
|
(deftest
|
|
"guard inside bind"
|
|
(provide
|
|
:x 1
|
|
(assert-equal 1 (bind (guard (exn (true -1)) (context :x))))))
|
|
(deftest
|
|
"bind with string-append"
|
|
(provide
|
|
:first "hello"
|
|
(provide
|
|
:second "world"
|
|
(assert-equal
|
|
"hello world"
|
|
(bind (str (context :first) " " (context :second))))))))
|