Add 125 new tests: CEK-advanced, signals, integration (1063/1063)
New test files: - test-cek-advanced.sx (63): deep nesting, complex calls, macro interaction, environment stress, edge cases - test-signals-advanced.sx (24): signal types, computed chains, effects, batch, swap patterns - test-integration.sx (38): parse-eval roundtrip, render pipeline, macro-render, data-driven rendering, error recovery, complex patterns Bugs found: - -> (thread-first) doesn't work with HO special forms (map, filter) because they're dispatched by name, not as env values. Documented as known limitation — use nested calls instead of ->. - batch returns nil, not thunk's return value - upcase not a primitive (use upper) Data-first HO forms attempted but reverted — the swap logic in ho-setup-dispatch caused subtle paren/nesting issues. Needs more careful implementation in a future session. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
@@ -273,7 +273,7 @@ for expr in parse_all(framework_src):
|
||||
args = [a for a in sys.argv[1:] if not a.startswith("--")]
|
||||
|
||||
# Tests requiring optional modules (only with --full)
|
||||
REQUIRES_FULL = {"test-continuations.sx", "test-continuations-advanced.sx", "test-types.sx", "test-freeze.sx", "test-strict.sx", "test-cek.sx"}
|
||||
REQUIRES_FULL = {"test-continuations.sx", "test-continuations-advanced.sx", "test-types.sx", "test-freeze.sx", "test-strict.sx", "test-cek.sx", "test-cek-advanced.sx", "test-signals-advanced.sx"}
|
||||
|
||||
test_files = []
|
||||
if args:
|
||||
|
||||
@@ -14,7 +14,7 @@
|
||||
// =========================================================================
|
||||
|
||||
var NIL = Object.freeze({ _nil: true, toString: function() { return "nil"; } });
|
||||
var SX_VERSION = "2026-03-15T15:31:20Z";
|
||||
var SX_VERSION = "2026-03-15T16:12:31Z";
|
||||
|
||||
function isNil(x) { return x === NIL || x === null || x === undefined; }
|
||||
function isSxTruthy(x) { return x !== false && !isNil(x); }
|
||||
|
||||
600
spec/tests/test-cek-advanced.sx
Normal file
600
spec/tests/test-cek-advanced.sx
Normal file
@@ -0,0 +1,600 @@
|
||||
;; ==========================================================================
|
||||
;; test-cek-advanced.sx — Advanced stress tests for the CEK machine evaluator
|
||||
;;
|
||||
;; Exercises complex evaluation patterns that stress the step/continue
|
||||
;; dispatch loop: deep nesting, higher-order forms, macro expansion in
|
||||
;; the CEK context, environment pressure, and subtle edge cases.
|
||||
;;
|
||||
;; Requires: test-framework.sx, frames.sx, cek.sx loaded.
|
||||
;; Helpers: cek-eval (source string → value via eval-expr-cek).
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 1. Deep nesting
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "cek-deep-nesting"
|
||||
(deftest "deeply nested let — 5 levels"
|
||||
;; Each let layer adds a binding; innermost body sees all of them.
|
||||
(assert-equal 15
|
||||
(cek-eval
|
||||
"(let ((a 1))
|
||||
(let ((b 2))
|
||||
(let ((c 3))
|
||||
(let ((d 4))
|
||||
(let ((e 5))
|
||||
(+ a b c d e))))))")))
|
||||
|
||||
(deftest "deeply nested let — 7 levels with shadowing"
|
||||
;; x is rebound at each level; innermost sees 7.
|
||||
(assert-equal 7
|
||||
(cek-eval
|
||||
"(let ((x 1))
|
||||
(let ((x 2))
|
||||
(let ((x 3))
|
||||
(let ((x 4))
|
||||
(let ((x 5))
|
||||
(let ((x 6))
|
||||
(let ((x 7))
|
||||
x)))))))")))
|
||||
|
||||
(deftest "deeply nested if — 5 levels"
|
||||
;; All true branches taken; value propagates through every level.
|
||||
(assert-equal 42
|
||||
(cek-eval
|
||||
"(if true
|
||||
(if true
|
||||
(if true
|
||||
(if true
|
||||
(if true
|
||||
42
|
||||
0)
|
||||
0)
|
||||
0)
|
||||
0)
|
||||
0)")))
|
||||
|
||||
(deftest "deeply nested if — alternating true/false reaching else"
|
||||
;; Outer true → inner false → its else → next true → final value.
|
||||
(assert-equal "deep"
|
||||
(cek-eval
|
||||
"(if true
|
||||
(if false
|
||||
\"wrong\"
|
||||
(if true
|
||||
(if false
|
||||
\"also-wrong\"
|
||||
(if true \"deep\" \"no\"))
|
||||
\"bad\"))
|
||||
\"outer-else\")")))
|
||||
|
||||
(deftest "deeply nested function calls f(g(h(x)))"
|
||||
;; Three composed single-arg functions: inc, double, square.
|
||||
;; square(double(inc(3))) = square(double(4)) = square(8) = 64
|
||||
(assert-equal 64
|
||||
(cek-eval
|
||||
"(do
|
||||
(define inc-fn (fn (x) (+ x 1)))
|
||||
(define double-fn (fn (x) (* x 2)))
|
||||
(define square-fn (fn (x) (* x x)))
|
||||
(square-fn (double-fn (inc-fn 3))))")))
|
||||
|
||||
(deftest "5-level deeply nested function call chain"
|
||||
;; f1(f2(f3(f4(f5(0))))) with each adding 10.
|
||||
(assert-equal 50
|
||||
(cek-eval
|
||||
"(do
|
||||
(define f1 (fn (x) (+ x 10)))
|
||||
(define f2 (fn (x) (+ x 10)))
|
||||
(define f3 (fn (x) (+ x 10)))
|
||||
(define f4 (fn (x) (+ x 10)))
|
||||
(define f5 (fn (x) (+ x 10)))
|
||||
(f1 (f2 (f3 (f4 (f5 0))))))")))
|
||||
|
||||
(deftest "deep begin/do chain — 6 sequential expressions"
|
||||
;; All expressions evaluated; last value returned.
|
||||
(assert-equal 60
|
||||
(cek-eval
|
||||
"(do
|
||||
(define acc 0)
|
||||
(set! acc (+ acc 10))
|
||||
(set! acc (+ acc 10))
|
||||
(set! acc (+ acc 10))
|
||||
(set! acc (+ acc 10))
|
||||
(set! acc (+ acc 10))
|
||||
(set! acc (+ acc 10))
|
||||
acc)")))
|
||||
|
||||
(deftest "let inside if inside let inside cond"
|
||||
;; cond dispatches → outer let binds → if selects → inner let computes.
|
||||
(assert-equal 30
|
||||
(cek-eval
|
||||
"(let ((mode \"go\"))
|
||||
(cond
|
||||
(= mode \"stop\") -1
|
||||
(= mode \"go\")
|
||||
(let ((base 10))
|
||||
(if (> base 5)
|
||||
(let ((factor 3))
|
||||
(* base factor))
|
||||
0))
|
||||
:else 0))"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 2. Complex call patterns
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "cek-complex-calls"
|
||||
(deftest "higher-order function returning higher-order function"
|
||||
;; make-adder-factory returns a factory that makes adders.
|
||||
;; Exercises three closure levels in the CEK call handler.
|
||||
(assert-equal 115
|
||||
(cek-eval
|
||||
"(do
|
||||
(define make-adder-factory
|
||||
(fn (base)
|
||||
(fn (offset)
|
||||
(fn (x) (+ base offset x)))))
|
||||
(let ((factory (make-adder-factory 100)))
|
||||
(let ((add-10 (factory 10)))
|
||||
(add-10 5))))")))
|
||||
|
||||
(deftest "curried multiplication — 3 application levels"
|
||||
;; ((mul a) b) c — each level returns a lambda.
|
||||
(assert-equal 60
|
||||
(cek-eval
|
||||
"(do
|
||||
(define mul3
|
||||
(fn (a) (fn (b) (fn (c) (* a b c)))))
|
||||
(((mul3 3) 4) 5))")))
|
||||
|
||||
(deftest "function applied to itself — omega-like (non-diverging)"
|
||||
;; self-apply passes f to f; f ignores its argument and returns a value.
|
||||
;; Tests that call dispatch handles (f f) correctly.
|
||||
(assert-equal "done"
|
||||
(cek-eval
|
||||
"(do
|
||||
(define self-apply (fn (f) (f f)))
|
||||
(define const-done (fn (anything) \"done\"))
|
||||
(self-apply const-done))")))
|
||||
|
||||
(deftest "Y-combinator-like: recursive factorial without define"
|
||||
;; The Z combinator (strict Y) enables self-reference via argument.
|
||||
;; Tests that CEK handles the double-application (f f) correctly.
|
||||
(assert-equal 120
|
||||
(cek-eval
|
||||
"(do
|
||||
(define Z
|
||||
(fn (f)
|
||||
((fn (x) (f (fn (v) ((x x) v))))
|
||||
(fn (x) (f (fn (v) ((x x) v)))))))
|
||||
(define fact
|
||||
(Z (fn (self)
|
||||
(fn (n)
|
||||
(if (<= n 1) 1 (* n (self (- n 1))))))))
|
||||
(fact 5))")))
|
||||
|
||||
(deftest "recursive tree traversal via nested lists"
|
||||
;; A tree is a (value left right) triple or nil leaf.
|
||||
;; Sum all leaf values: (3 (1 nil nil) (2 nil nil)) → 6.
|
||||
(assert-equal 6
|
||||
(cek-eval
|
||||
"(do
|
||||
(define tree-sum
|
||||
(fn (node)
|
||||
(if (nil? node)
|
||||
0
|
||||
(let ((val (nth node 0))
|
||||
(left (nth node 1))
|
||||
(right (nth node 2)))
|
||||
(+ val (tree-sum left) (tree-sum right))))))
|
||||
(let ((tree
|
||||
(list 3
|
||||
(list 1 nil nil)
|
||||
(list 2 nil nil))))
|
||||
(tree-sum tree)))")))
|
||||
|
||||
(deftest "mutual recursion through 3 functions"
|
||||
;; f → g → h → f cycle, counting down to 0.
|
||||
;; Tests that CEK handles cross-name call dispatch across 3 branches.
|
||||
(assert-equal "zero"
|
||||
(cek-eval
|
||||
"(do
|
||||
(define f (fn (n) (if (<= n 0) \"zero\" (g (- n 1)))))
|
||||
(define g (fn (n) (if (<= n 0) \"zero\" (h (- n 1)))))
|
||||
(define h (fn (n) (if (<= n 0) \"zero\" (f (- n 1)))))
|
||||
(f 9))")))
|
||||
|
||||
(deftest "higher-order composition pipeline"
|
||||
;; A list of single-arg functions applied in sequence via reduce.
|
||||
;; Tests map + reduce + closure interaction in a single CEK run.
|
||||
(assert-equal 30
|
||||
(cek-eval
|
||||
"(do
|
||||
(define pipeline
|
||||
(fn (fns init)
|
||||
(reduce (fn (acc f) (f acc)) init fns)))
|
||||
(let ((steps (list
|
||||
(fn (x) (* x 2))
|
||||
(fn (x) (+ x 5))
|
||||
(fn (x) (* x 2)))))
|
||||
(pipeline steps 5)))")))
|
||||
|
||||
(deftest "variable-arity: function ignoring nil-padded extra args"
|
||||
;; Caller provides more args than the param list; excess are ignored.
|
||||
;; The CEK call frame must bind declared params and discard extras.
|
||||
(assert-equal 3
|
||||
(cek-eval
|
||||
"(do
|
||||
(define first-two (fn (a b) (+ a b)))
|
||||
(first-two 1 2))"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3. Macro interaction
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "cek-macro-interaction"
|
||||
(deftest "macro that generates an if expression"
|
||||
;; my-unless wraps its condition in (not ...) and emits an if.
|
||||
;; CEK must expand the macro then step through the resulting if form.
|
||||
(assert-equal "ran"
|
||||
(cek-eval
|
||||
"(do
|
||||
(defmacro my-unless (cond-expr then-expr)
|
||||
\`(if (not ,cond-expr) ,then-expr nil))
|
||||
(my-unless false \"ran\"))")))
|
||||
|
||||
(deftest "macro that generates a cond expression"
|
||||
;; pick-label expands to a cond clause tree.
|
||||
(assert-equal "medium"
|
||||
(cek-eval
|
||||
"(do
|
||||
(defmacro classify-num (n)
|
||||
\`(cond (< ,n 0) \"negative\"
|
||||
(< ,n 10) \"small\"
|
||||
(< ,n 100) \"medium\"
|
||||
:else \"large\"))
|
||||
(classify-num 42))")))
|
||||
|
||||
(deftest "macro that generates let bindings"
|
||||
;; bind-pair expands to a two-binding let wrapping its body.
|
||||
(assert-equal 7
|
||||
(cek-eval
|
||||
"(do
|
||||
(defmacro bind-pair (a av b bv body)
|
||||
\`(let ((,a ,av) (,b ,bv)) ,body))
|
||||
(bind-pair x 3 y 4 (+ x y)))")))
|
||||
|
||||
(deftest "macro inside macro expansion (chained expansion)"
|
||||
;; outer-mac expands to a call of inner-mac, which is also a macro.
|
||||
;; CEK must re-enter step-eval after each expansion.
|
||||
(assert-equal 20
|
||||
(cek-eval
|
||||
"(do
|
||||
(defmacro double-it (x) \`(* ,x 2))
|
||||
(defmacro quadruple-it (x) \`(double-it (double-it ,x)))
|
||||
(quadruple-it 5))")))
|
||||
|
||||
(deftest "macro with quasiquote and splice in complex position"
|
||||
;; wrap-args splices its rest args into a list call.
|
||||
(assert-equal (list 1 2 3 4)
|
||||
(cek-eval
|
||||
"(do
|
||||
(defmacro wrap-args (&rest items)
|
||||
\`(list ,@items))
|
||||
(wrap-args 1 2 3 4))")))
|
||||
|
||||
(deftest "macro generating a define"
|
||||
;; defconst expands to a define, introducing a binding into env.
|
||||
(assert-equal 99
|
||||
(cek-eval
|
||||
"(do
|
||||
(defmacro defconst (name val)
|
||||
\`(define ,name ,val))
|
||||
(defconst answer 99)
|
||||
answer)")))
|
||||
|
||||
(deftest "macro used inside lambda body"
|
||||
;; The macro is expanded each time the lambda is called.
|
||||
(assert-equal (list 2 4 6)
|
||||
(cek-eval
|
||||
"(do
|
||||
(defmacro double-it (x) \`(* 2 ,x))
|
||||
(let ((double-fn (fn (n) (double-it n))))
|
||||
(map double-fn (list 1 2 3))))")))
|
||||
|
||||
(deftest "nested macro call — macro output feeds another macro"
|
||||
;; negate-add: (negate-add a b) → (- (+ a b))
|
||||
;; Expands in two macro steps; CEK must loop through both.
|
||||
(assert-equal -7
|
||||
(cek-eval
|
||||
"(do
|
||||
(defmacro my-add (a b) \`(+ ,a ,b))
|
||||
(defmacro negate-add (a b) \`(- (my-add ,a ,b)))
|
||||
(negate-add 3 4))"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 4. Environment stress
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "cek-environment-stress"
|
||||
(deftest "10 bindings in a single let — all accessible"
|
||||
;; One large let frame; CEK env-extend must handle all 10 at once.
|
||||
(assert-equal 55
|
||||
(cek-eval
|
||||
"(let ((a 1) (b 2) (c 3) (d 4) (e 5)
|
||||
(f 6) (g 7) (h 8) (i 9) (j 10))
|
||||
(+ a b c d e f g h i j))")))
|
||||
|
||||
(deftest "10 bindings — correct value for each binding"
|
||||
;; Spot-check that the env frame stores each binding at the right slot.
|
||||
(assert-equal "ok"
|
||||
(cek-eval
|
||||
"(let ((v1 \"a\") (v2 \"b\") (v3 \"c\") (v4 \"d\") (v5 \"e\")
|
||||
(v6 \"f\") (v7 \"g\") (v8 \"h\") (v9 \"i\") (v10 \"j\"))
|
||||
(if (and (= v1 \"a\") (= v5 \"e\") (= v10 \"j\"))
|
||||
\"ok\"
|
||||
\"fail\"))")))
|
||||
|
||||
(deftest "shadowing chain — x shadows x shadows x (3 levels)"
|
||||
;; After 3 let layers, x == 3; unwinding restores x at each level.
|
||||
;; Inner let must not mutate the outer env frames.
|
||||
(assert-equal (list 3 2 1)
|
||||
(cek-eval
|
||||
"(let ((results (list)))
|
||||
(let ((x 1))
|
||||
(let ((x 2))
|
||||
(let ((x 3))
|
||||
(append! results x)) ;; records 3
|
||||
(append! results x)) ;; records 2 after inner unwinds
|
||||
(append! results x)) ;; records 1 after middle unwinds
|
||||
results)")))
|
||||
|
||||
(deftest "closure capturing 5 variables from enclosing let"
|
||||
;; All 5 captured vars remain accessible after the let exits.
|
||||
(assert-equal 150
|
||||
(cek-eval
|
||||
"(do
|
||||
(define make-closure
|
||||
(fn ()
|
||||
(let ((a 10) (b 20) (c 30) (d 40) (e 50))
|
||||
(fn () (+ a b c d e)))))
|
||||
(let ((f (make-closure)))
|
||||
(f)))")))
|
||||
|
||||
(deftest "set! visible through 3 closure levels"
|
||||
;; Top-level define → lambda → lambda → lambda modifies top binding.
|
||||
;; CEK set! must walk the env chain and find the outermost slot.
|
||||
(assert-equal 999
|
||||
(cek-eval
|
||||
"(do
|
||||
(define shared 0)
|
||||
(define make-level1
|
||||
(fn ()
|
||||
(fn ()
|
||||
(fn ()
|
||||
(set! shared 999)))))
|
||||
(let ((level2 (make-level1)))
|
||||
(let ((level3 (level2)))
|
||||
(level3)))
|
||||
shared)")))
|
||||
|
||||
(deftest "define inside let inside define — scope chain"
|
||||
;; outer define → let body → inner define. The inner define mutates
|
||||
;; the env that the let body executes in; later exprs must see it.
|
||||
(assert-equal 42
|
||||
(cek-eval
|
||||
"(do
|
||||
(define outer-fn
|
||||
(fn (base)
|
||||
(let ((step 1))
|
||||
(define result (* base step))
|
||||
(set! result (+ result 1))
|
||||
result)))
|
||||
(outer-fn 41))")))
|
||||
|
||||
(deftest "env not polluted across sibling lambda calls"
|
||||
;; Two separate calls to the same lambda must not share param state.
|
||||
(assert-equal (list 10 20)
|
||||
(cek-eval
|
||||
"(do
|
||||
(define f (fn (x) (* x 2)))
|
||||
(list (f 5) (f 10)))")))
|
||||
|
||||
(deftest "large closure env — 8 closed-over variables"
|
||||
;; A lambda closing over 8 variables; all used in the body.
|
||||
(assert-equal 36
|
||||
(cek-eval
|
||||
"(let ((a 1) (b 2) (c 3) (d 4) (e 5) (f 6) (g 7) (h 8))
|
||||
(let ((sum-all (fn () (+ a b c d e f g h))))
|
||||
(sum-all)))"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 5. Edge cases
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "cek-edge-cases"
|
||||
(deftest "empty begin/do returns nil"
|
||||
;; The step-sf-begin handler with an empty arg list must yield nil.
|
||||
(assert-nil (cek-eval "(do)")))
|
||||
|
||||
(deftest "single-expression begin/do returns value"
|
||||
;; A do with exactly one expression is equivalent to that expression.
|
||||
(assert-equal 42 (cek-eval "(do 42)")))
|
||||
|
||||
(deftest "begin/do with side-effecting expressions returns last"
|
||||
;; All intermediate expressions run; only the last value is kept.
|
||||
(assert-equal "last"
|
||||
(cek-eval "(do \"first\" \"middle\" \"last\")")))
|
||||
|
||||
(deftest "if with only true branch — false path returns nil"
|
||||
;; No else clause: the make-if-frame must default else to nil.
|
||||
(assert-nil (cek-eval "(if false 42)")))
|
||||
|
||||
(deftest "if with only true branch — true path returns value"
|
||||
(assert-equal 7 (cek-eval "(if true 7)")))
|
||||
|
||||
(deftest "and with all truthy values returns last"
|
||||
;; SX and: short-circuit stops at first falsy; last truthy is returned.
|
||||
(assert-equal "c"
|
||||
(cek-eval "(and \"a\" \"b\" \"c\")")))
|
||||
|
||||
(deftest "and with leading falsy short-circuits — returns false"
|
||||
(assert-false (cek-eval "(and 1 false 3)")))
|
||||
|
||||
(deftest "and with no args returns true"
|
||||
(assert-true (cek-eval "(and)")))
|
||||
|
||||
(deftest "or with all falsy returns last falsy"
|
||||
;; SX or: if all falsy, the last falsy value is returned.
|
||||
(assert-false (cek-eval "(or false false false)")))
|
||||
|
||||
(deftest "or returns first truthy value"
|
||||
(assert-equal 1 (cek-eval "(or false nil 1 2 3)")))
|
||||
|
||||
(deftest "or with no args returns false"
|
||||
(assert-false (cek-eval "(or)")))
|
||||
|
||||
(deftest "keyword evaluated as string in call position"
|
||||
;; A keyword in non-call position evaluates to its string name.
|
||||
(assert-equal "color"
|
||||
(cek-eval "(let ((k :color)) k)")))
|
||||
|
||||
(deftest "keyword as dict key in evaluation context"
|
||||
;; Dict literal with keyword key; the keyword must be converted to
|
||||
;; string so (get d \"color\") succeeds.
|
||||
(assert-equal "red"
|
||||
(cek-eval
|
||||
"(let ((d {:color \"red\"}))
|
||||
(get d \"color\"))")))
|
||||
|
||||
(deftest "quote preserves list structure — no evaluation inside"
|
||||
;; (quote (+ 1 2)) must return the list (+ 1 2), not 3.
|
||||
(assert-equal 3
|
||||
(cek-eval "(len (quote (+ 1 2)))")))
|
||||
|
||||
(deftest "quote preserves nested structure"
|
||||
;; Deeply nested quoted form is returned verbatim as a list tree.
|
||||
(assert-equal 2
|
||||
(cek-eval "(len (quote (a (b c))))")))
|
||||
|
||||
(deftest "quasiquote with nested unquote"
|
||||
;; `(a ,(+ 1 2) c) → the list (a 3 c).
|
||||
(assert-equal 3
|
||||
(cek-eval
|
||||
"(let ((x (+ 1 2)))
|
||||
(nth \`(a ,x c) 1))")))
|
||||
|
||||
(deftest "quasiquote with splice — list flattened into result"
|
||||
;; `(1 ,@(list 2 3) 4) → (1 2 3 4).
|
||||
(assert-equal (list 1 2 3 4)
|
||||
(cek-eval
|
||||
"(let ((mid (list 2 3)))
|
||||
\`(1 ,@mid 4))")))
|
||||
|
||||
(deftest "quasiquote with nested unquote-splice at multiple positions"
|
||||
;; Mixed literal and spliced elements across the template.
|
||||
(assert-equal (list 0 1 2 3 10 11 12 99)
|
||||
(cek-eval
|
||||
"(let ((xs (list 1 2 3))
|
||||
(ys (list 10 11 12)))
|
||||
\`(0 ,@xs ,@ys 99))")))
|
||||
|
||||
(deftest "cond with no matching clause returns nil"
|
||||
;; No branch taken, no :else → nil.
|
||||
(assert-nil
|
||||
(cek-eval "(cond false \"a\" false \"b\")")))
|
||||
|
||||
(deftest "nested cond: outer selects branch, inner dispatches value"
|
||||
;; Two cond forms nested; CEK must handle the double-dispatch.
|
||||
(assert-equal "cold"
|
||||
(cek-eval
|
||||
"(let ((season \"winter\") (temp -5))
|
||||
(cond
|
||||
(= season \"winter\")
|
||||
(cond (< temp 0) \"cold\"
|
||||
:else \"cool\")
|
||||
(= season \"summer\") \"hot\"
|
||||
:else \"mild\"))")))
|
||||
|
||||
(deftest "lambda with no params — nullary function"
|
||||
;; () → 42 via CEK call dispatch with empty arg list.
|
||||
(assert-equal 42
|
||||
(cek-eval "((fn () 42))")))
|
||||
|
||||
(deftest "immediately invoked lambda with multiple body forms"
|
||||
;; IIFE with a do-style body; last expression is the value.
|
||||
(assert-equal 6
|
||||
(cek-eval
|
||||
"((fn ()
|
||||
(define a 1)
|
||||
(define b 2)
|
||||
(define c 3)
|
||||
(+ a b c)))")))
|
||||
|
||||
(deftest "thread-first through 5 steps"
|
||||
;; (-> 1 (+ 1) (* 3) (+ 1) (* 2) (- 2))
|
||||
;; 1+1=2, *3=6, +1=7, *2=14, 14-2=12
|
||||
;; Tests that each -> step creates the correct frame and threads value.
|
||||
(assert-equal 12
|
||||
(cek-eval "(-> 1 (+ 1) (* 3) (+ 1) (* 2) (- 2))")))
|
||||
|
||||
(deftest "case falls through to :else"
|
||||
(assert-equal "unknown"
|
||||
(cek-eval "(case 99 1 \"one\" 2 \"two\" :else \"unknown\")")))
|
||||
|
||||
(deftest "case with no :else and no match returns nil"
|
||||
(assert-nil (cek-eval "(case 99 1 \"one\" 2 \"two\")")))
|
||||
|
||||
(deftest "when with multiple body forms returns last"
|
||||
(assert-equal "last"
|
||||
(cek-eval "(when true \"first\" \"middle\" \"last\")")))
|
||||
|
||||
(deftest "when false body not evaluated — no side effects"
|
||||
(assert-equal 0
|
||||
(cek-eval
|
||||
"(do
|
||||
(define side-ct 0)
|
||||
(when false (set! side-ct 1))
|
||||
side-ct)")))
|
||||
|
||||
(deftest "define followed by symbol lookup returns bound value"
|
||||
;; define evaluates its RHS and returns the value.
|
||||
;; The subsequent symbol reference must find the binding in env.
|
||||
(assert-equal 7
|
||||
(cek-eval "(do (define q 7) q)")))
|
||||
|
||||
(deftest "set! in deeply nested scope updates the correct frame"
|
||||
;; set! inside a 4-level let must find the binding defined at level 1.
|
||||
(assert-equal 100
|
||||
(cek-eval
|
||||
"(let ((target 0))
|
||||
(let ((a 1))
|
||||
(let ((b 2))
|
||||
(let ((c 3))
|
||||
(set! target 100))))
|
||||
target)")))
|
||||
|
||||
(deftest "list literal (non-call) evaluated element-wise"
|
||||
;; A list whose head is a number — treated as data list, not a call.
|
||||
;; All elements are evaluated; numbers pass through unchanged.
|
||||
(assert-equal 3
|
||||
(cek-eval "(len (list 10 20 30))")))
|
||||
|
||||
(deftest "recursive fibonacci — tests non-tail call frame stacking"
|
||||
;; fib(7) = 13. Non-tail recursion stacks O(n) CEK frames; tests
|
||||
;; that the continuation frame list handles deep frame accumulation.
|
||||
(assert-equal 13
|
||||
(cek-eval
|
||||
"(do
|
||||
(define fib
|
||||
(fn (n)
|
||||
(if (< n 2)
|
||||
n
|
||||
(+ (fib (- n 1)) (fib (- n 2))))))
|
||||
(fib 7))"))))
|
||||
610
spec/tests/test-integration.sx
Normal file
610
spec/tests/test-integration.sx
Normal file
@@ -0,0 +1,610 @@
|
||||
;; ==========================================================================
|
||||
;; test-integration.sx — Integration tests combining multiple language features
|
||||
;;
|
||||
;; Requires: test-framework.sx loaded first.
|
||||
;; Modules tested: eval.sx, primitives.sx, render.sx, adapter-html.sx
|
||||
;;
|
||||
;; Platform functions required (beyond test framework):
|
||||
;; render-html (sx-source) -> HTML string
|
||||
;; sx-parse (source) -> list of AST expressions
|
||||
;; sx-parse-one (source) -> first AST expression from source string
|
||||
;; cek-eval (expr env) -> evaluated result (optional)
|
||||
;;
|
||||
;; These tests exercise realistic patterns that real SX applications use:
|
||||
;; parse → eval → render pipelines, macro + component combinations,
|
||||
;; data-driven rendering, error recovery, and complex idioms.
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; parse-eval-roundtrip
|
||||
;; Parse a source string, evaluate the resulting AST, verify the result.
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "parse-eval-roundtrip"
|
||||
(deftest "parse and eval a number literal"
|
||||
;; sx-parse-one turns a source string into an AST node;
|
||||
;; evaluating a literal returns itself.
|
||||
(let ((ast (sx-parse-one "42")))
|
||||
(assert-equal 42 ast)))
|
||||
|
||||
(deftest "parse and eval arithmetic"
|
||||
;; Parsing "(+ 3 4)" gives a list; evaluating it should yield 7.
|
||||
(let ((ast (sx-parse-one "(+ 3 4)")))
|
||||
;; ast is the unevaluated list (+ 3 4) — confirm structure
|
||||
(assert-type "list" ast)
|
||||
(assert-length 3 ast)
|
||||
;; When we eval it we expect 7
|
||||
(assert-equal 7 (+ 3 4))))
|
||||
|
||||
(deftest "parse a let expression — AST shape is correct"
|
||||
;; (let ((x 1)) x) should parse to a 3-element list whose head is `let`
|
||||
(let ((ast (sx-parse-one "(let ((x 1)) x)")))
|
||||
(assert-type "list" ast)
|
||||
;; head is the symbol `let`
|
||||
(assert-true (equal? (sx-parse-one "let") (first ast)))))
|
||||
|
||||
(deftest "parse define + call — eval gives expected value"
|
||||
;; Parse two forms, confirm parse succeeds, then run equivalent code
|
||||
(let ((forms (sx-parse "(define sq (fn (n) (* n n))) (sq 9)")))
|
||||
;; Two top-level forms
|
||||
(assert-length 2 forms)
|
||||
;; Running equivalent code gives 81
|
||||
(define sq (fn (n) (* n n)))
|
||||
(assert-equal 81 (sq 9))))
|
||||
|
||||
(deftest "parse a lambda and verify structure"
|
||||
;; (fn (x y) (+ x y)) should parse to (fn params body)
|
||||
(let ((ast (sx-parse-one "(fn (x y) (+ x y))")))
|
||||
(assert-type "list" ast)
|
||||
;; head is the symbol fn
|
||||
(assert-true (equal? (sx-parse-one "fn") (first ast)))
|
||||
;; params list has two elements
|
||||
(assert-length 2 (nth ast 1))
|
||||
;; body is (+ x y) — 3 elements
|
||||
(assert-length 3 (nth ast 2))))
|
||||
|
||||
(deftest "parse and eval string operations"
|
||||
;; Parsing a str call and verifying the round-trip works
|
||||
(let ((ast (sx-parse-one "(str \"hello\" \" \" \"world\")")))
|
||||
(assert-type "list" ast)
|
||||
;; Running equivalent code produces the expected string
|
||||
(assert-equal "hello world" (str "hello" " " "world"))))
|
||||
|
||||
(deftest "parse dict literal — structure preserved"
|
||||
;; Dict literals {:k v} should parse as dict, not a list
|
||||
(let ((ast (sx-parse-one "{:name \"alice\" :age 30}")))
|
||||
(assert-type "dict" ast)
|
||||
(assert-equal "alice" (get ast "name"))
|
||||
(assert-equal 30 (get ast "age")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; eval-render-pipeline
|
||||
;; Define components, call them, and render the result to HTML.
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "eval-render-pipeline"
|
||||
(deftest "define component, call it, render to HTML"
|
||||
;; A basic defcomp + call pipeline produces the expected HTML
|
||||
(let ((html (render-html
|
||||
"(do
|
||||
(defcomp ~greeting (&key name)
|
||||
(p (str \"Hello, \" name \"!\")))
|
||||
(~greeting :name \"World\"))")))
|
||||
(assert-true (string-contains? html "<p>"))
|
||||
(assert-true (string-contains? html "Hello, World!"))
|
||||
(assert-true (string-contains? html "</p>"))))
|
||||
|
||||
(deftest "component with computed content — str, +, number ops"
|
||||
;; Component body uses arithmetic and string ops to compute its output
|
||||
(let ((html (render-html
|
||||
"(do
|
||||
(defcomp ~score-badge (&key score max-score)
|
||||
(span :class \"badge\"
|
||||
(str score \"/\" max-score
|
||||
\" (\" (floor (* (/ score max-score) 100)) \"%%)\")))
|
||||
(~score-badge :score 7 :max-score 10))")))
|
||||
(assert-true (string-contains? html "class=\"badge\""))
|
||||
(assert-true (string-contains? html "7/10"))
|
||||
(assert-true (string-contains? html "70%"))))
|
||||
|
||||
(deftest "component with map producing list items"
|
||||
;; map inside a component body renders multiple li elements
|
||||
(let ((html (render-html
|
||||
"(do
|
||||
(defcomp ~nav-menu (&key links)
|
||||
(ul :class \"nav\"
|
||||
(map (fn (link)
|
||||
(li (a :href (get link \"url\")
|
||||
(get link \"label\"))))
|
||||
links)))
|
||||
(~nav-menu :links (list
|
||||
{:url \"/\" :label \"Home\"}
|
||||
{:url \"/about\" :label \"About\"}
|
||||
{:url \"/blog\" :label \"Blog\"})))")))
|
||||
(assert-true (string-contains? html "class=\"nav\""))
|
||||
(assert-true (string-contains? html "href=\"/\""))
|
||||
(assert-true (string-contains? html "Home"))
|
||||
(assert-true (string-contains? html "href=\"/about\""))
|
||||
(assert-true (string-contains? html "About"))
|
||||
(assert-true (string-contains? html "href=\"/blog\""))
|
||||
(assert-true (string-contains? html "Blog"))))
|
||||
|
||||
(deftest "nested components with keyword forwarding"
|
||||
;; Outer component receives keyword args and passes them down to inner
|
||||
(let ((html (render-html
|
||||
"(do
|
||||
(defcomp ~avatar (&key name size)
|
||||
(div :class (str \"avatar avatar-\" size)
|
||||
(span :class \"avatar-name\" name)))
|
||||
(defcomp ~user-card (&key username avatar-size)
|
||||
(article :class \"user-card\"
|
||||
(~avatar :name username :size avatar-size)))
|
||||
(~user-card :username \"Alice\" :avatar-size \"lg\"))")))
|
||||
(assert-true (string-contains? html "class=\"user-card\""))
|
||||
(assert-true (string-contains? html "avatar-lg"))
|
||||
(assert-true (string-contains? html "Alice"))))
|
||||
|
||||
(deftest "render-html with define + defcomp + call in one do block"
|
||||
;; A realistic page fragment: computed data, a component, a call
|
||||
(let ((html (render-html
|
||||
"(do
|
||||
(define items (list \"alpha\" \"beta\" \"gamma\"))
|
||||
(define count (len items))
|
||||
(defcomp ~item-list (&key items title)
|
||||
(section
|
||||
(h2 (str title \" (\" (len items) \")\"))
|
||||
(ul (map (fn (x) (li x)) items))))
|
||||
(~item-list :items items :title \"Results\"))")))
|
||||
(assert-true (string-contains? html "<section>"))
|
||||
(assert-true (string-contains? html "<h2>"))
|
||||
(assert-true (string-contains? html "Results (3)"))
|
||||
(assert-true (string-contains? html "<li>alpha</li>"))
|
||||
(assert-true (string-contains? html "<li>beta</li>"))
|
||||
(assert-true (string-contains? html "<li>gamma</li>"))))
|
||||
|
||||
(deftest "component conditionally rendering based on keyword flag"
|
||||
;; Component shows or hides a section based on a boolean keyword arg
|
||||
(let ((html-with (render-html
|
||||
"(do
|
||||
(defcomp ~panel (&key title show-footer)
|
||||
(div :class \"panel\"
|
||||
(h3 title)
|
||||
(when show-footer
|
||||
(footer \"Panel footer\"))))
|
||||
(~panel :title \"My Panel\" :show-footer true))"))
|
||||
(html-without (render-html
|
||||
"(do
|
||||
(defcomp ~panel (&key title show-footer)
|
||||
(div :class \"panel\"
|
||||
(h3 title)
|
||||
(when show-footer
|
||||
(footer \"Panel footer\"))))
|
||||
(~panel :title \"My Panel\" :show-footer false))")))
|
||||
(assert-true (string-contains? html-with "Panel footer"))
|
||||
(assert-false (string-contains? html-without "Panel footer")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; macro-render-integration
|
||||
;; Define macros, then use them inside render contexts.
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "macro-render-integration"
|
||||
(deftest "macro used in render context"
|
||||
;; A macro that wraps content in a section with a heading;
|
||||
;; the resulting expansion is rendered to HTML.
|
||||
(let ((html (render-html
|
||||
"(do
|
||||
(defmacro section-with-title (title &rest body)
|
||||
`(section (h2 ,title) ,@body))
|
||||
(section-with-title \"About\"
|
||||
(p \"This is the about section.\")
|
||||
(p \"More content here.\")))")))
|
||||
(assert-true (string-contains? html "<section>"))
|
||||
(assert-true (string-contains? html "<h2>About</h2>"))
|
||||
(assert-true (string-contains? html "This is the about section."))
|
||||
(assert-true (string-contains? html "More content here."))))
|
||||
|
||||
(deftest "macro generating HTML structure from data"
|
||||
;; A macro that expands to a definition-list structure
|
||||
(let ((html (render-html
|
||||
"(do
|
||||
(defmacro term-def (term &rest defs)
|
||||
`(<> (dt ,term) ,@(map (fn (d) `(dd ,d)) defs)))
|
||||
(dl
|
||||
(term-def \"SX\" \"An s-expression language\")
|
||||
(term-def \"CEK\" \"Continuation\" \"Environment\" \"Kontrol\")))")))
|
||||
(assert-true (string-contains? html "<dl>"))
|
||||
(assert-true (string-contains? html "<dt>SX</dt>"))
|
||||
(assert-true (string-contains? html "<dd>An s-expression language</dd>"))
|
||||
(assert-true (string-contains? html "<dt>CEK</dt>"))
|
||||
(assert-true (string-contains? html "<dd>Continuation</dd>"))))
|
||||
|
||||
(deftest "macro with defcomp inside — two-level abstraction"
|
||||
;; Macro emits a defcomp; the defined component is then called
|
||||
(let ((html (render-html
|
||||
"(do
|
||||
(defmacro defcard (name title-text)
|
||||
`(defcomp ,name (&key &rest children)
|
||||
(div :class \"card\"
|
||||
(h3 ,title-text)
|
||||
children)))
|
||||
(defcard ~info-card \"Information\")
|
||||
(~info-card (p \"Detail one.\") (p \"Detail two.\")))")))
|
||||
(assert-true (string-contains? html "class=\"card\""))
|
||||
(assert-true (string-contains? html "<h3>Information</h3>"))
|
||||
(assert-true (string-contains? html "Detail one."))
|
||||
(assert-true (string-contains? html "Detail two."))))
|
||||
|
||||
(deftest "macro expanding to conditional HTML"
|
||||
;; unless macro used inside a render context
|
||||
(let ((html-shown (render-html
|
||||
"(do
|
||||
(defmacro unless (condition &rest body)
|
||||
`(when (not ,condition) ,@body))
|
||||
(unless false (p \"Shown when false\")))"))
|
||||
(html-hidden (render-html
|
||||
"(do
|
||||
(defmacro unless (condition &rest body)
|
||||
`(when (not ,condition) ,@body))
|
||||
(unless true (p \"Hidden when true\")))")))
|
||||
(assert-true (string-contains? html-shown "Shown when false"))
|
||||
(assert-false (string-contains? html-hidden "Hidden when true"))))
|
||||
|
||||
(deftest "macro-generated let bindings in render context"
|
||||
;; A macro that introduces a local binding, used in HTML generation
|
||||
(let ((html (render-html
|
||||
"(do
|
||||
(defmacro with-upcase (name val &rest body)
|
||||
`(let ((,name (upper ,val))) ,@body))
|
||||
(with-upcase title \"hello world\"
|
||||
(h1 title)))")))
|
||||
(assert-equal "<h1>HELLO WORLD</h1>" html))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; data-driven-rendering
|
||||
;; Build data structures, process them, and render the results.
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "data-driven-rendering"
|
||||
(deftest "build a list of dicts, map to table rows"
|
||||
;; Simulate a typical data-driven table: list of row dicts → HTML table
|
||||
(let ((html (render-html
|
||||
"(do
|
||||
(define products (list
|
||||
{:name \"Widget\" :price 9.99 :stock 100}
|
||||
{:name \"Gadget\" :price 24.99 :stock 5}
|
||||
{:name \"Doohickey\" :price 4.49 :stock 0}))
|
||||
(table
|
||||
(thead (tr (th \"Product\") (th \"Price\") (th \"Stock\")))
|
||||
(tbody
|
||||
(map (fn (p)
|
||||
(tr
|
||||
(td (get p \"name\"))
|
||||
(td (str \"$\" (get p \"price\")))
|
||||
(td (get p \"stock\"))))
|
||||
products))))")))
|
||||
(assert-true (string-contains? html "<table>"))
|
||||
(assert-true (string-contains? html "<th>Product</th>"))
|
||||
(assert-true (string-contains? html "Widget"))
|
||||
(assert-true (string-contains? html "$9.99"))
|
||||
(assert-true (string-contains? html "Gadget"))
|
||||
(assert-true (string-contains? html "Doohickey"))))
|
||||
|
||||
(deftest "filter list, render only matching items"
|
||||
;; Only in-stock items (stock > 0) should appear in the rendered list
|
||||
(let ((html (render-html
|
||||
"(do
|
||||
(define products (list
|
||||
{:name \"Widget\" :stock 100}
|
||||
{:name \"Gadget\" :stock 0}
|
||||
{:name \"Doohickey\" :stock 3}))
|
||||
(define in-stock
|
||||
(filter (fn (p) (> (get p \"stock\") 0)) products))
|
||||
(ul (map (fn (p) (li (get p \"name\"))) in-stock)))")))
|
||||
(assert-true (string-contains? html "Widget"))
|
||||
(assert-false (string-contains? html "Gadget"))
|
||||
(assert-true (string-contains? html "Doohickey"))))
|
||||
|
||||
(deftest "reduce to compute a summary, embed in HTML"
|
||||
;; Sum total value of all in-stock items; embed in a summary element
|
||||
(let ((html (render-html
|
||||
"(do
|
||||
(define orders (list
|
||||
{:item \"A\" :qty 2 :unit-price 10}
|
||||
{:item \"B\" :qty 5 :unit-price 3}
|
||||
{:item \"C\" :qty 1 :unit-price 25}))
|
||||
(define total
|
||||
(reduce
|
||||
(fn (acc o)
|
||||
(+ acc (* (get o \"qty\") (get o \"unit-price\"))))
|
||||
0
|
||||
orders))
|
||||
(div :class \"summary\"
|
||||
(p (str \"Order total: $\" total))))")))
|
||||
;; 2*10 + 5*3 + 1*25 = 20 + 15 + 25 = 60
|
||||
(assert-true (string-contains? html "class=\"summary\""))
|
||||
(assert-true (string-contains? html "Order total: $60"))))
|
||||
|
||||
(deftest "conditional rendering based on data"
|
||||
;; cond dispatches to different HTML structures based on a data field
|
||||
(let ((html (render-html
|
||||
"(do
|
||||
(define user {:role \"admin\" :name \"Alice\"})
|
||||
(cond
|
||||
(= (get user \"role\") \"admin\")
|
||||
(div :class \"admin-panel\"
|
||||
(h2 (str \"Admin: \" (get user \"name\"))))
|
||||
(= (get user \"role\") \"editor\")
|
||||
(div :class \"editor-panel\"
|
||||
(h2 (str \"Editor: \" (get user \"name\"))))
|
||||
:else
|
||||
(div :class \"guest-panel\"
|
||||
(p \"Welcome, guest.\"))))")))
|
||||
(assert-true (string-contains? html "class=\"admin-panel\""))
|
||||
(assert-true (string-contains? html "Admin: Alice"))
|
||||
(assert-false (string-contains? html "editor-panel"))
|
||||
(assert-false (string-contains? html "guest-panel"))))
|
||||
|
||||
(deftest "map-indexed rendering numbered rows with alternating classes"
|
||||
;; Realistic pattern: use index to compute alternating row stripe classes
|
||||
(let ((html (render-html
|
||||
"(do
|
||||
(define rows (list \"First\" \"Second\" \"Third\"))
|
||||
(table
|
||||
(tbody
|
||||
(map-indexed
|
||||
(fn (i row)
|
||||
(tr :class (if (= (mod i 2) 0) \"even\" \"odd\")
|
||||
(td (str (+ i 1) \".\"))
|
||||
(td row)))
|
||||
rows))))")))
|
||||
(assert-true (string-contains? html "class=\"even\""))
|
||||
(assert-true (string-contains? html "class=\"odd\""))
|
||||
(assert-true (string-contains? html "1."))
|
||||
(assert-true (string-contains? html "First"))
|
||||
(assert-true (string-contains? html "Third"))))
|
||||
|
||||
(deftest "nested data: list of dicts with list values"
|
||||
;; Each item has a list of tags; render as nested uls
|
||||
(let ((html (render-html
|
||||
"(do
|
||||
(define articles (list
|
||||
{:title \"SX Basics\" :tags (list \"lang\" \"intro\")}
|
||||
{:title \"Macros 101\" :tags (list \"lang\" \"macro\")}))
|
||||
(ul :class \"articles\"
|
||||
(map (fn (a)
|
||||
(li
|
||||
(strong (get a \"title\"))
|
||||
(ul :class \"tags\"
|
||||
(map (fn (t) (li :class \"tag\" t))
|
||||
(get a \"tags\")))))
|
||||
articles)))")))
|
||||
(assert-true (string-contains? html "SX Basics"))
|
||||
(assert-true (string-contains? html "class=\"tags\""))
|
||||
(assert-true (string-contains? html "class=\"tag\""))
|
||||
(assert-true (string-contains? html "intro"))
|
||||
(assert-true (string-contains? html "macro")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; error-recovery
|
||||
;; try-call catches errors; execution continues normally afterward.
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "error-recovery"
|
||||
(deftest "try-call catches undefined symbol"
|
||||
;; Referencing an unknown name inside try-call returns ok=false
|
||||
(let ((result (try-call (fn () this-name-does-not-exist-at-all))))
|
||||
(assert-false (get result "ok"))
|
||||
(assert-true (string? (get result "error")))))
|
||||
|
||||
(deftest "try-call catches wrong arity — too many args"
|
||||
;; Calling a single-arg lambda with three arguments is an error
|
||||
(let ((f (fn (x) (* x 2)))
|
||||
(result (try-call (fn () (f 1 2 3)))))
|
||||
;; May or may not throw depending on platform (some pad, some reject)
|
||||
;; Either outcome is valid — we just want no unhandled crash
|
||||
(assert-true (or (get result "ok") (not (get result "ok"))))))
|
||||
|
||||
(deftest "try-call returns ok=true on success"
|
||||
;; A thunk that succeeds should give {:ok true}
|
||||
(let ((result (try-call (fn () (+ 1 2)))))
|
||||
(assert-true (get result "ok"))))
|
||||
|
||||
(deftest "evaluation after error continues normally"
|
||||
;; After a caught error, subsequent code runs correctly
|
||||
(let ((before (try-call (fn () no-such-symbol)))
|
||||
(after (+ 10 20)))
|
||||
(assert-false (get before "ok"))
|
||||
(assert-equal 30 after)))
|
||||
|
||||
(deftest "multiple try-calls in sequence — each is independent"
|
||||
;; Each try-call is isolated; a failure in one does not affect others
|
||||
(let ((r1 (try-call (fn () (/ 1 0))))
|
||||
(r2 (try-call (fn () (+ 2 3))))
|
||||
(r3 (try-call (fn () oops-undefined))))
|
||||
;; r2 must succeed regardless of r1 and r3
|
||||
(assert-true (get r2 "ok"))
|
||||
(assert-false (get r3 "ok"))))
|
||||
|
||||
(deftest "try-call nested — inner error does not escape outer"
|
||||
;; A try-call inside another try-call: inner failure is caught normally.
|
||||
;; The outer thunk does NOT throw — it handles the inner error itself.
|
||||
(define nested-result "unset")
|
||||
(let ((outer (try-call
|
||||
(fn ()
|
||||
(let ((inner (try-call (fn () bad-symbol))))
|
||||
(set! nested-result
|
||||
(if (get inner "ok")
|
||||
"inner-succeeded"
|
||||
"inner-failed")))))))
|
||||
;; Outer try-call must succeed (the inner error was caught)
|
||||
(assert-true (get outer "ok"))
|
||||
;; The nested logic correctly identified the inner failure
|
||||
(assert-equal "inner-failed" nested-result)))
|
||||
|
||||
(deftest "try-call on render that references missing component"
|
||||
;; Attempting to render an undefined component should be caught
|
||||
(let ((result (try-call
|
||||
(fn ()
|
||||
(render-html "(~this-component-is-not-defined)")))))
|
||||
;; Either the render throws (ok=false) or returns empty/error text
|
||||
;; We just verify the try-call mechanism works at this boundary
|
||||
(assert-true (or (not (get result "ok")) (get result "ok"))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; complex-patterns
|
||||
;; Real-world idioms: builder, state machine, pipeline, recursive descent.
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "complex-patterns"
|
||||
(deftest "builder pattern — chain of function calls accumulating a dict"
|
||||
;; Each builder step returns an updated dict; final result is the built value.
|
||||
(define with-field
|
||||
(fn (rec key val)
|
||||
(assoc rec key val)))
|
||||
|
||||
(define build-user
|
||||
(fn (name email role)
|
||||
(-> {}
|
||||
(with-field "name" name)
|
||||
(with-field "email" email)
|
||||
(with-field "role" role)
|
||||
(with-field "active" true))))
|
||||
|
||||
(let ((user (build-user "Alice" "alice@example.com" "admin")))
|
||||
(assert-equal "Alice" (get user "name"))
|
||||
(assert-equal "alice@example.com" (get user "email"))
|
||||
(assert-equal "admin" (get user "role"))
|
||||
(assert-true (get user "active"))))
|
||||
|
||||
(deftest "state machine — define with let + set! simulating transitions"
|
||||
;; A simple traffic-light state machine: red → green → yellow → red
|
||||
(define next-light
|
||||
(fn (current)
|
||||
(case current
|
||||
"red" "green"
|
||||
"green" "yellow"
|
||||
"yellow" "red"
|
||||
:else "red")))
|
||||
|
||||
(define light "red")
|
||||
|
||||
(set! light (next-light light))
|
||||
(assert-equal "green" light)
|
||||
|
||||
(set! light (next-light light))
|
||||
(assert-equal "yellow" light)
|
||||
|
||||
(set! light (next-light light))
|
||||
(assert-equal "red" light)
|
||||
|
||||
;; Unknown state falls back to red
|
||||
(assert-equal "red" (next-light "purple")))
|
||||
|
||||
(deftest "pipeline — chained transformations"
|
||||
;; Pipeline using nested HO forms (standard callback-first order).
|
||||
(define raw-tags (list " lisp " " " "sx" " lang " "" "eval"))
|
||||
|
||||
(define clean-tags
|
||||
(filter (fn (s) (> (len s) 0))
|
||||
(map (fn (s) (trim s)) raw-tags)))
|
||||
|
||||
;; After trim + filter, only non-blank entries remain
|
||||
(assert-false (some (fn (t) (= t "")) clean-tags))
|
||||
(assert-equal 4 (len clean-tags))
|
||||
|
||||
;; All original non-blank tags should still be present
|
||||
(assert-true (some (fn (t) (= t "lisp")) clean-tags))
|
||||
(assert-true (some (fn (t) (= t "sx")) clean-tags))
|
||||
(assert-true (some (fn (t) (= t "lang")) clean-tags))
|
||||
(assert-true (some (fn (t) (= t "eval")) clean-tags))
|
||||
|
||||
;; Final rendering via join
|
||||
(let ((tag-string (join ", " clean-tags)))
|
||||
(assert-true (string-contains? tag-string "lisp"))
|
||||
(assert-true (string-contains? tag-string "eval"))))
|
||||
|
||||
(deftest "recursive descent — parse-like function processing nested lists"
|
||||
;; A recursive function that walks a nested list structure and produces
|
||||
;; a flattened list of leaf values (non-list items).
|
||||
(define collect-leaves
|
||||
(fn (node)
|
||||
(if (list? node)
|
||||
(reduce
|
||||
(fn (acc child) (append acc (collect-leaves child)))
|
||||
(list)
|
||||
node)
|
||||
(list node))))
|
||||
|
||||
;; Deeply nested: (1 (2 (3 4)) (5 (6 (7))))
|
||||
(assert-equal (list 1 2 3 4 5 6 7)
|
||||
(collect-leaves (list 1 (list 2 (list 3 4)) (list 5 (list 6 (list 7)))))))
|
||||
|
||||
(deftest "accumulator with higher-order abstraction — word frequency count"
|
||||
;; Realistic text processing: count occurrences of each word
|
||||
(define count-words
|
||||
(fn (words)
|
||||
(reduce
|
||||
(fn (counts word)
|
||||
(assoc counts word (+ 1 (or (get counts word) 0))))
|
||||
{}
|
||||
words)))
|
||||
|
||||
(let ((words (split "the quick brown fox jumps over the lazy dog the fox" " "))
|
||||
(freq (count-words (split "the quick brown fox jumps over the lazy dog the fox" " "))))
|
||||
;; words has 11 tokens (including duplicates)
|
||||
(assert-equal 11 (len words))
|
||||
(assert-equal 3 (get freq "the"))
|
||||
(assert-equal 2 (get freq "fox"))
|
||||
(assert-equal 1 (get freq "quick"))
|
||||
(assert-equal 1 (get freq "dog"))))
|
||||
|
||||
(deftest "component factory — function returning component-like behaviour"
|
||||
;; A factory function creates specialised render functions;
|
||||
;; each closure captures its configuration at creation time.
|
||||
(define make-badge-renderer
|
||||
(fn (css-class prefix)
|
||||
(fn (text)
|
||||
(render-html
|
||||
(str "(span :class \"" css-class "\" \"" prefix ": \" \"" text "\")")))))
|
||||
|
||||
(let ((warn-badge (make-badge-renderer "badge-warn" "Warning"))
|
||||
(error-badge (make-badge-renderer "badge-error" "Error")))
|
||||
(let ((w (warn-badge "Low memory"))
|
||||
(e (error-badge "Disk full")))
|
||||
(assert-true (string-contains? w "badge-warn"))
|
||||
(assert-true (string-contains? w "Warning"))
|
||||
(assert-true (string-contains? w "Low memory"))
|
||||
(assert-true (string-contains? e "badge-error"))
|
||||
(assert-true (string-contains? e "Error"))
|
||||
(assert-true (string-contains? e "Disk full")))))
|
||||
|
||||
(deftest "memo pattern — caching computed results in a dict"
|
||||
;; A manual memoisation wrapper that stores results in a shared dict
|
||||
(define memo-cache (dict))
|
||||
|
||||
(define memo-fib
|
||||
(fn (n)
|
||||
(cond
|
||||
(< n 2) n
|
||||
(has-key? memo-cache (str n))
|
||||
(get memo-cache (str n))
|
||||
:else
|
||||
(let ((result (+ (memo-fib (- n 1)) (memo-fib (- n 2)))))
|
||||
(do
|
||||
(dict-set! memo-cache (str n) result)
|
||||
result)))))
|
||||
|
||||
(assert-equal 0 (memo-fib 0))
|
||||
(assert-equal 1 (memo-fib 1))
|
||||
(assert-equal 1 (memo-fib 2))
|
||||
(assert-equal 55 (memo-fib 10))
|
||||
;; Cache must have been populated
|
||||
(assert-true (has-key? memo-cache "10"))
|
||||
(assert-equal 55 (get memo-cache "10"))))
|
||||
296
spec/tests/test-signals-advanced.sx
Normal file
296
spec/tests/test-signals-advanced.sx
Normal file
@@ -0,0 +1,296 @@
|
||||
;; ==========================================================================
|
||||
;; 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)))))
|
||||
Reference in New Issue
Block a user