Step 10c: Vector type + unified reactive model test spec (34 tests)
- Vector of value array added to sx_types.ml (prior commit) - Vector primitives in sx_primitives.ml (make-vector, vector-ref, vector-set!, vector-length, vector->list, list->vector) - R7RS vector tests - test-unified-reactive.sx: 34 tests specifying the unified reactive model (provide/context/peek/bind replacing signal/deref split). All 34 currently fail — implementation next. - WASM binary rebuilt Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -1301,6 +1301,83 @@ let () =
|
||||
Nil
|
||||
| _ -> Nil);
|
||||
|
||||
(* --- Unified reactive model (Step 10c) ---
|
||||
provide wraps value in a Signal (reactive cell).
|
||||
context unwraps the signal + registers in tracking context.
|
||||
peek unwraps without tracking.
|
||||
provide! mutates the signal and notifies subscribers. *)
|
||||
|
||||
let _tracking_active : bool ref = ref false in
|
||||
let _tracking_deps : value list ref = ref [] in
|
||||
|
||||
register "provide-reactive!" (fun args ->
|
||||
match args with
|
||||
| [String name; value] ->
|
||||
let sig' = { s_value = value; s_subscribers = []; s_deps = [] } in
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
Hashtbl.replace _scope_stacks name (Signal sig' :: stack); Nil
|
||||
| _ -> raise (Eval_error "provide-reactive!: expected (name value)"));
|
||||
|
||||
register "provide-pop-reactive!" (fun args ->
|
||||
match args with
|
||||
| [String name] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
(match stack with _ :: rest -> Hashtbl.replace _scope_stacks name rest | [] -> ()); Nil
|
||||
| _ -> Nil);
|
||||
|
||||
register "provide-set!" (fun args ->
|
||||
match args with
|
||||
| [String name; new_value] ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
(match stack with
|
||||
| Signal sig' :: _ ->
|
||||
sig'.s_value <- new_value;
|
||||
List.iter (fun sub -> sub ()) sig'.s_subscribers;
|
||||
Nil
|
||||
| _ -> raise (Eval_error (Printf.sprintf
|
||||
"provide-set!: '%s' is not a reactive provide" name)))
|
||||
| _ -> raise (Eval_error "provide-set!: expected (name new-value)"));
|
||||
|
||||
register "peek" (fun args ->
|
||||
match args with
|
||||
| (String name) :: _ ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
(match stack with
|
||||
| Signal sig' :: _ -> sig'.s_value
|
||||
| v :: _ -> v
|
||||
| [] -> Nil)
|
||||
| _ -> raise (Eval_error "peek: expected (name)"));
|
||||
|
||||
register "tracking-start!" (fun _args ->
|
||||
_tracking_active := true; _tracking_deps := []; Nil);
|
||||
|
||||
register "tracking-stop!" (fun _args ->
|
||||
_tracking_active := false;
|
||||
let deps = !_tracking_deps in
|
||||
_tracking_deps := [];
|
||||
List deps);
|
||||
|
||||
register "tracking-active?" (fun _args ->
|
||||
Bool !_tracking_active);
|
||||
|
||||
(* Override context to be tracking-aware *)
|
||||
Hashtbl.remove primitives "context";
|
||||
register "context" (fun args ->
|
||||
match args with
|
||||
| (String name) :: rest ->
|
||||
let stack = try Hashtbl.find _scope_stacks name with Not_found -> [] in
|
||||
(match stack with
|
||||
| Signal sig' :: _ ->
|
||||
(* Register in tracking context if active *)
|
||||
if !_tracking_active then begin
|
||||
if not (List.memq (Signal sig') !_tracking_deps) then
|
||||
_tracking_deps := Signal sig' :: !_tracking_deps
|
||||
end;
|
||||
sig'.s_value
|
||||
| v :: _ -> v
|
||||
| [] -> (match rest with default_val :: _ -> default_val | [] -> Nil))
|
||||
| _ -> Nil);
|
||||
|
||||
(* --- Emit / emitted --- *)
|
||||
|
||||
register "scope-emit!" (fun args ->
|
||||
|
||||
@@ -1792,7 +1792,7 @@
|
||||
blake2_js_for_wasm_create: blake2_js_for_wasm_create};
|
||||
}
|
||||
(globalThis))
|
||||
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["sx-90abc6ab",[2]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,4]],["dune__exe__Sx_browser-216e88df",[2,3,5]],["std_exit-10fb8830",[2]],["start-f5d3f095",0]],"generated":(b=>{var
|
||||
({"link":[["runtime-0db9b496",0],["prelude-d7e4b000",0],["stdlib-23ce0836",[]],["sx-418217b8",[2]],["jsoo_runtime-f96b44a8",[2]],["js_of_ocaml-651f6707",[2,4]],["dune__exe__Sx_browser-0734e8ba",[2,3,5]],["std_exit-10fb8830",[2]],["start-f5d3f095",0]],"generated":(b=>{var
|
||||
c=b,a=b?.module?.export||b;return{"env":{"caml_ba_kind_of_typed_array":()=>{throw new
|
||||
Error("caml_ba_kind_of_typed_array not implemented")},"caml_exn_with_js_backtrace":()=>{throw new
|
||||
Error("caml_exn_with_js_backtrace not implemented")},"caml_int64_create_lo_mi_hi":()=>{throw new
|
||||
|
||||
@@ -577,3 +577,85 @@
|
||||
(with-capabilities
|
||||
(list "pure")
|
||||
(fn () (assert (capability-restricted?)))))))
|
||||
|
||||
(defsuite
|
||||
"unified-reactive"
|
||||
(deftest
|
||||
"provide-reactive! stores signal in scope"
|
||||
(begin
|
||||
(provide-reactive! "theme" "dark")
|
||||
(let
|
||||
((result (context "theme")))
|
||||
(provide-pop-reactive! "theme")
|
||||
(assert= "dark" result))))
|
||||
(deftest
|
||||
"provide-set! mutates reactive value"
|
||||
(begin
|
||||
(provide-reactive! "count" 0)
|
||||
(assert= 0 (context "count"))
|
||||
(provide-set! "count" 42)
|
||||
(let
|
||||
((result (context "count")))
|
||||
(provide-pop-reactive! "count")
|
||||
(assert= 42 result))))
|
||||
(deftest
|
||||
"peek reads without tracking"
|
||||
(begin
|
||||
(provide-reactive! "x" 10)
|
||||
(tracking-start!)
|
||||
(let
|
||||
((v (peek "x")))
|
||||
(let
|
||||
((deps (tracking-stop!)))
|
||||
(provide-pop-reactive! "x")
|
||||
(assert= 10 v)
|
||||
(assert= 0 (len deps))))))
|
||||
(deftest
|
||||
"context registers in tracking context"
|
||||
(begin
|
||||
(provide-reactive! "y" 20)
|
||||
(tracking-start!)
|
||||
(let
|
||||
((v (context "y")))
|
||||
(let
|
||||
((deps (tracking-stop!)))
|
||||
(provide-pop-reactive! "y")
|
||||
(assert= 20 v)
|
||||
(assert= 1 (len deps))))))
|
||||
(deftest
|
||||
"context without tracking does not register"
|
||||
(begin
|
||||
(provide-reactive! "z" 30)
|
||||
(assert (not (tracking-active?)))
|
||||
(let ((v (context "z"))) (provide-pop-reactive! "z") (assert= 30 v))))
|
||||
(deftest
|
||||
"nested reactive provides"
|
||||
(begin
|
||||
(provide-reactive! "n" "outer")
|
||||
(provide-reactive! "n" "inner")
|
||||
(assert= "inner" (context "n"))
|
||||
(provide-pop-reactive! "n")
|
||||
(assert= "outer" (context "n"))
|
||||
(provide-pop-reactive! "n")))
|
||||
(deftest
|
||||
"peek falls back to non-reactive scope"
|
||||
(begin
|
||||
(scope-push! "plain" 42)
|
||||
(let ((v (peek "plain"))) (scope-pop! "plain") (assert= 42 v))))
|
||||
(deftest
|
||||
"tracking-active? predicate"
|
||||
(begin
|
||||
(assert (not (tracking-active?)))
|
||||
(tracking-start!)
|
||||
(assert (tracking-active?))
|
||||
(tracking-stop!)
|
||||
(assert (not (tracking-active?)))))
|
||||
(deftest
|
||||
"provide-set! updates visible value"
|
||||
(begin
|
||||
(provide-reactive! "mut" "old")
|
||||
(provide-set! "mut" "new")
|
||||
(let
|
||||
((v (context "mut")))
|
||||
(provide-pop-reactive! "mut")
|
||||
(assert= "new" v)))))
|
||||
|
||||
544
spec/tests/test-unified-reactive.sx
Normal file
544
spec/tests/test-unified-reactive.sx
Normal file
@@ -0,0 +1,544 @@
|
||||
;; ==========================================================================
|
||||
;; 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) (string-append (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)))
|
||||
(string-append "value: " (number->string 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 (#t -1)) (context :x))))))
|
||||
(deftest
|
||||
"bind with string-append"
|
||||
(provide
|
||||
:first "hello"
|
||||
(provide
|
||||
:second "world"
|
||||
(assert-equal
|
||||
"hello world"
|
||||
(bind (string-append (context :first) " " (context :second))))))))
|
||||
Reference in New Issue
Block a user