Files
rose-ash/spec/tests/test-unified-reactive.sx
giles a965731a33 Step 10c: bind CEK special form + provide-set frame + scope-stack integration
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>
2026-04-05 09:13:33 +00:00

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))))))))