giles
bdbf594bc8
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>
611 lines
27 KiB
Plaintext
611 lines
27 KiB
Plaintext
;; ==========================================================================
|
|
;; 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"))))
|