Phase 2: Move core spec files to spec/ and spec/tests/
git mv eval.sx, parser.sx, primitives.sx, render.sx, cek.sx, frames.sx, continuations.sx, callcc.sx, types.sx, special-forms.sx → spec/ Tests → spec/tests/ Both bootstrappers verified — find files via spec/ → web/ → shared/sx/ref/ Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
This commit is contained in:
241
spec/tests/test-cek.sx
Normal file
241
spec/tests/test-cek.sx
Normal file
@@ -0,0 +1,241 @@
|
||||
;; ==========================================================================
|
||||
;; test-cek.sx — Tests for the explicit CEK machine evaluator
|
||||
;;
|
||||
;; Tests that eval-expr-cek produces identical results to eval-expr.
|
||||
;; Requires: test-framework.sx, frames.sx, cek.sx loaded.
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 1. Literals
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "cek-literals"
|
||||
(deftest "number"
|
||||
(assert-equal 42 (eval-expr-cek 42 (test-env))))
|
||||
|
||||
(deftest "string"
|
||||
(assert-equal "hello" (eval-expr-cek "hello" (test-env))))
|
||||
|
||||
(deftest "boolean true"
|
||||
(assert-equal true (eval-expr-cek true (test-env))))
|
||||
|
||||
(deftest "boolean false"
|
||||
(assert-equal false (eval-expr-cek false (test-env))))
|
||||
|
||||
(deftest "nil"
|
||||
(assert-nil (eval-expr-cek nil (test-env)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 2. Symbol lookup
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "cek-symbols"
|
||||
(deftest "env lookup"
|
||||
(assert-equal 42
|
||||
(cek-eval "(do (define x 42) x)")))
|
||||
|
||||
(deftest "primitive call resolves"
|
||||
(assert-equal "hello"
|
||||
(cek-eval "(str \"hello\")"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3. Special forms
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "cek-if"
|
||||
(deftest "if true branch"
|
||||
(assert-equal 1
|
||||
(cek-eval "(if true 1 2)")))
|
||||
|
||||
(deftest "if false branch"
|
||||
(assert-equal 2
|
||||
(cek-eval "(if false 1 2)")))
|
||||
|
||||
(deftest "if no else"
|
||||
(assert-nil (cek-eval "(if false 1)"))))
|
||||
|
||||
|
||||
(defsuite "cek-when"
|
||||
(deftest "when true"
|
||||
(assert-equal 42
|
||||
(cek-eval "(when true 42)")))
|
||||
|
||||
(deftest "when false"
|
||||
(assert-nil (cek-eval "(when false 42)")))
|
||||
|
||||
(deftest "when multiple body"
|
||||
(assert-equal 3
|
||||
(cek-eval "(when true 1 2 3)"))))
|
||||
|
||||
|
||||
(defsuite "cek-begin"
|
||||
(deftest "do returns last"
|
||||
(assert-equal 3
|
||||
(cek-eval "(do 1 2 3)")))
|
||||
|
||||
(deftest "empty do"
|
||||
(assert-nil (cek-eval "(do)"))))
|
||||
|
||||
|
||||
(defsuite "cek-let"
|
||||
(deftest "basic let"
|
||||
(assert-equal 3
|
||||
(cek-eval "(let ((x 1) (y 2)) (+ x y))")))
|
||||
|
||||
(deftest "let body sequence"
|
||||
(assert-equal 10
|
||||
(cek-eval "(let ((x 5)) 1 2 (+ x 5))")))
|
||||
|
||||
(deftest "nested let"
|
||||
(assert-equal 5
|
||||
(cek-eval "(let ((x 1)) (let ((y 2)) (+ x y (* x y))))"))))
|
||||
|
||||
|
||||
(defsuite "cek-and-or"
|
||||
(deftest "and all true"
|
||||
(assert-equal 3
|
||||
(cek-eval "(and 1 2 3)")))
|
||||
|
||||
(deftest "and short circuit"
|
||||
(assert-false (cek-eval "(and 1 false 3)")))
|
||||
|
||||
(deftest "or first true"
|
||||
(assert-equal 1
|
||||
(cek-eval "(or 1 2 3)")))
|
||||
|
||||
(deftest "or all false"
|
||||
(assert-false (cek-eval "(or false false false)"))))
|
||||
|
||||
|
||||
(defsuite "cek-cond"
|
||||
(deftest "cond first match"
|
||||
(assert-equal "a"
|
||||
(cek-eval "(cond true \"a\" true \"b\")")))
|
||||
|
||||
(deftest "cond second match"
|
||||
(assert-equal "b"
|
||||
(cek-eval "(cond false \"a\" true \"b\")")))
|
||||
|
||||
(deftest "cond else"
|
||||
(assert-equal "c"
|
||||
(cek-eval "(cond false \"a\" :else \"c\")"))))
|
||||
|
||||
|
||||
(defsuite "cek-case"
|
||||
(deftest "case match"
|
||||
(assert-equal "yes"
|
||||
(cek-eval "(case 1 1 \"yes\" 2 \"no\")")))
|
||||
|
||||
(deftest "case no match"
|
||||
(assert-nil
|
||||
(cek-eval "(case 3 1 \"yes\" 2 \"no\")")))
|
||||
|
||||
(deftest "case else"
|
||||
(assert-equal "default"
|
||||
(cek-eval "(case 3 1 \"yes\" :else \"default\")"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 4. Function calls
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "cek-calls"
|
||||
(deftest "primitive call"
|
||||
(assert-equal 3
|
||||
(cek-eval "(+ 1 2)")))
|
||||
|
||||
(deftest "nested calls"
|
||||
(assert-equal 6
|
||||
(cek-eval "(+ 1 (+ 2 3))")))
|
||||
|
||||
(deftest "lambda call"
|
||||
(assert-equal 10
|
||||
(cek-eval "((fn (x) (* x 2)) 5)")))
|
||||
|
||||
(deftest "defined function"
|
||||
(assert-equal 25
|
||||
(cek-eval "(do (define square (fn (x) (* x x))) (square 5))"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 5. Define and set!
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "cek-define"
|
||||
(deftest "define binds"
|
||||
(assert-equal 42
|
||||
(cek-eval "(do (define x 42) x)")))
|
||||
|
||||
(deftest "set! mutates"
|
||||
(assert-equal 10
|
||||
(cek-eval "(do (define x 1) (set! x 10) x)"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 6. Quote and quasiquote
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "cek-quote"
|
||||
(deftest "quote"
|
||||
(let ((result (cek-eval "(quote (1 2 3))")))
|
||||
(assert-equal 3 (len result))))
|
||||
|
||||
(deftest "quasiquote with unquote"
|
||||
(assert-equal (list 1 42 3)
|
||||
(cek-eval "(let ((x 42)) `(1 ,x 3))"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 7. Thread-first
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "cek-thread-first"
|
||||
(deftest "simple thread"
|
||||
(assert-equal 3
|
||||
(cek-eval "(-> 1 (+ 2))")))
|
||||
|
||||
(deftest "multi-step thread"
|
||||
(assert-equal 6
|
||||
(cek-eval "(-> 1 (+ 2) (* 2))"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 8. CEK-specific: stepping
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "cek-stepping"
|
||||
(deftest "single step literal"
|
||||
(let ((state (make-cek-state 42 (test-env) (list))))
|
||||
(let ((stepped (cek-step state)))
|
||||
(assert-equal "continue" (cek-phase stepped))
|
||||
(assert-equal 42 (cek-value stepped))
|
||||
(assert-true (cek-terminal? stepped)))))
|
||||
|
||||
(deftest "single step if pushes frame"
|
||||
(let ((state (make-cek-state (sx-parse-one "(if true 1 2)") (test-env) (list))))
|
||||
(let ((stepped (cek-step state)))
|
||||
(assert-equal "eval" (cek-phase stepped))
|
||||
;; Should have pushed an IfFrame
|
||||
(assert-true (> (len (cek-kont stepped)) 0))
|
||||
(assert-equal "if" (frame-type (first (cek-kont stepped))))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 9. Native continuations (shift/reset in CEK)
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "cek-continuations"
|
||||
(deftest "reset passthrough"
|
||||
(assert-equal 42
|
||||
(cek-eval "(reset 42)")))
|
||||
|
||||
(deftest "shift abort"
|
||||
(assert-equal 42
|
||||
(cek-eval "(reset (+ 1 (shift k 42)))")))
|
||||
|
||||
(deftest "shift with invoke"
|
||||
(assert-equal 11
|
||||
(cek-eval "(reset (+ 1 (shift k (k 10))))"))))
|
||||
140
spec/tests/test-continuations.sx
Normal file
140
spec/tests/test-continuations.sx
Normal file
@@ -0,0 +1,140 @@
|
||||
;; ==========================================================================
|
||||
;; test-continuations.sx — Tests for delimited continuations (shift/reset)
|
||||
;;
|
||||
;; Requires: test-framework.sx loaded, continuations extension enabled.
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 1. Basic shift/reset
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "basic-shift-reset"
|
||||
(deftest "reset passthrough"
|
||||
(assert-equal 42 (reset 42)))
|
||||
|
||||
(deftest "reset evaluates expression"
|
||||
(assert-equal 3 (reset (+ 1 2))))
|
||||
|
||||
(deftest "shift aborts to reset"
|
||||
(assert-equal 42 (reset (+ 1 (shift k 42)))))
|
||||
|
||||
(deftest "shift with single invoke"
|
||||
(assert-equal 11 (reset (+ 1 (shift k (k 10))))))
|
||||
|
||||
(deftest "shift with multiple invokes"
|
||||
(assert-equal (list 11 21)
|
||||
(reset (+ 1 (shift k (list (k 10) (k 20)))))))
|
||||
|
||||
(deftest "shift returns string"
|
||||
(assert-equal "aborted"
|
||||
(reset (+ 1 (shift k "aborted")))))
|
||||
|
||||
(deftest "shift returns nil"
|
||||
(assert-nil (reset (+ 1 (shift k nil)))))
|
||||
|
||||
(deftest "nested expression with shift"
|
||||
(assert-equal 16
|
||||
(+ 1 (reset (+ 10 (shift k (k 5))))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 2. Continuation predicates
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "continuation-predicates"
|
||||
(deftest "k is a continuation inside shift"
|
||||
(assert-true
|
||||
(reset (shift k (continuation? k)))))
|
||||
|
||||
(deftest "number is not a continuation"
|
||||
(assert-false (continuation? 42)))
|
||||
|
||||
(deftest "function is not a continuation"
|
||||
(assert-false (continuation? (fn (x) x))))
|
||||
|
||||
(deftest "nil is not a continuation"
|
||||
(assert-false (continuation? nil)))
|
||||
|
||||
(deftest "string is not a continuation"
|
||||
(assert-false (continuation? "hello"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3. Continuation as value
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "continuation-as-value"
|
||||
(deftest "k returned from reset"
|
||||
;; shift body returns k itself — reset returns the continuation
|
||||
(let ((k (reset (+ 1 (shift k k)))))
|
||||
(assert-true (continuation? k))
|
||||
(assert-equal 11 (k 10))))
|
||||
|
||||
(deftest "invoke returned k multiple times"
|
||||
(let ((k (reset (+ 1 (shift k k)))))
|
||||
(assert-equal 11 (k 10))
|
||||
(assert-equal 21 (k 20))
|
||||
(assert-equal 2 (k 1))))
|
||||
|
||||
(deftest "pass k to another function"
|
||||
(let ((apply-k (fn (k v) (k v))))
|
||||
(assert-equal 15
|
||||
(reset (+ 5 (shift k (apply-k k 10)))))))
|
||||
|
||||
(deftest "k in data structure"
|
||||
(let ((result (reset (+ 1 (shift k (list k 42))))))
|
||||
(assert-equal 42 (nth result 1))
|
||||
(assert-equal 100 ((first result) 99)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 4. Nested reset
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "nested-reset"
|
||||
(deftest "inner reset captures independently"
|
||||
(assert-equal 12
|
||||
(reset (+ 1 (reset (+ 10 (shift k (k 1))))))))
|
||||
|
||||
(deftest "inner abort outer continues"
|
||||
(assert-equal 43
|
||||
(reset (+ 1 (reset (+ 10 (shift k 42)))))))
|
||||
|
||||
(deftest "outer shift captures outer reset"
|
||||
(assert-equal 100
|
||||
(reset (+ 1 (shift k (k 99)))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 5. Interaction with scoped effects
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "continuations-with-scopes"
|
||||
(deftest "provide survives resume"
|
||||
(assert-equal "dark"
|
||||
(reset (provide "theme" "dark"
|
||||
(+ 0 (shift k (k 0)))
|
||||
(context "theme")))))
|
||||
|
||||
(deftest "scope and emit across shift"
|
||||
(assert-equal (list "a")
|
||||
(reset (scope "acc"
|
||||
(emit! "acc" "a")
|
||||
(+ 0 (shift k (k 0)))
|
||||
(emitted "acc"))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 6. TCO interaction
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "tco-interaction"
|
||||
(deftest "shift in tail position"
|
||||
(assert-equal 42
|
||||
(reset (if true (shift k (k 42)) 0))))
|
||||
|
||||
(deftest "shift in let body"
|
||||
(assert-equal 10
|
||||
(reset (let ((x 5))
|
||||
(+ x (shift k (k 5))))))))
|
||||
746
spec/tests/test-eval.sx
Normal file
746
spec/tests/test-eval.sx
Normal file
@@ -0,0 +1,746 @@
|
||||
;; ==========================================================================
|
||||
;; test-eval.sx — Tests for the core evaluator and primitives
|
||||
;;
|
||||
;; Requires: test-framework.sx loaded first.
|
||||
;; Modules tested: eval.sx, primitives.sx
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Literals and types
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "literals"
|
||||
(deftest "numbers are numbers"
|
||||
(assert-type "number" 42)
|
||||
(assert-type "number" 3.14)
|
||||
(assert-type "number" -1))
|
||||
|
||||
(deftest "strings are strings"
|
||||
(assert-type "string" "hello")
|
||||
(assert-type "string" ""))
|
||||
|
||||
(deftest "booleans are booleans"
|
||||
(assert-type "boolean" true)
|
||||
(assert-type "boolean" false))
|
||||
|
||||
(deftest "nil is nil"
|
||||
(assert-type "nil" nil)
|
||||
(assert-nil nil))
|
||||
|
||||
(deftest "lists are lists"
|
||||
(assert-type "list" (list 1 2 3))
|
||||
(assert-type "list" (list)))
|
||||
|
||||
(deftest "dicts are dicts"
|
||||
(assert-type "dict" {:a 1 :b 2})))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Arithmetic
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "arithmetic"
|
||||
(deftest "addition"
|
||||
(assert-equal 3 (+ 1 2))
|
||||
(assert-equal 0 (+ 0 0))
|
||||
(assert-equal -1 (+ 1 -2))
|
||||
(assert-equal 10 (+ 1 2 3 4)))
|
||||
|
||||
(deftest "subtraction"
|
||||
(assert-equal 1 (- 3 2))
|
||||
(assert-equal -1 (- 2 3)))
|
||||
|
||||
(deftest "multiplication"
|
||||
(assert-equal 6 (* 2 3))
|
||||
(assert-equal 0 (* 0 100))
|
||||
(assert-equal 24 (* 1 2 3 4)))
|
||||
|
||||
(deftest "division"
|
||||
(assert-equal 2 (/ 6 3))
|
||||
(assert-equal 2.5 (/ 5 2)))
|
||||
|
||||
(deftest "modulo"
|
||||
(assert-equal 1 (mod 7 3))
|
||||
(assert-equal 0 (mod 6 3))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Comparison
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "comparison"
|
||||
(deftest "equality"
|
||||
(assert-true (= 1 1))
|
||||
(assert-false (= 1 2))
|
||||
(assert-true (= "a" "a"))
|
||||
(assert-false (= "a" "b")))
|
||||
|
||||
(deftest "deep equality"
|
||||
(assert-true (equal? (list 1 2 3) (list 1 2 3)))
|
||||
(assert-false (equal? (list 1 2) (list 1 3)))
|
||||
(assert-true (equal? {:a 1} {:a 1}))
|
||||
(assert-false (equal? {:a 1} {:a 2})))
|
||||
|
||||
(deftest "ordering"
|
||||
(assert-true (< 1 2))
|
||||
(assert-false (< 2 1))
|
||||
(assert-true (> 2 1))
|
||||
(assert-true (<= 1 1))
|
||||
(assert-true (<= 1 2))
|
||||
(assert-true (>= 2 2))
|
||||
(assert-true (>= 3 2))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; String operations
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "strings"
|
||||
(deftest "str concatenation"
|
||||
(assert-equal "abc" (str "a" "b" "c"))
|
||||
(assert-equal "hello world" (str "hello" " " "world"))
|
||||
(assert-equal "42" (str 42))
|
||||
(assert-equal "" (str)))
|
||||
|
||||
(deftest "string-length"
|
||||
(assert-equal 5 (string-length "hello"))
|
||||
(assert-equal 0 (string-length "")))
|
||||
|
||||
(deftest "substring"
|
||||
(assert-equal "ell" (substring "hello" 1 4))
|
||||
(assert-equal "hello" (substring "hello" 0 5)))
|
||||
|
||||
(deftest "string-contains?"
|
||||
(assert-true (string-contains? "hello world" "world"))
|
||||
(assert-false (string-contains? "hello" "xyz")))
|
||||
|
||||
(deftest "upcase and downcase"
|
||||
(assert-equal "HELLO" (upcase "hello"))
|
||||
(assert-equal "hello" (downcase "HELLO")))
|
||||
|
||||
(deftest "trim"
|
||||
(assert-equal "hello" (trim " hello "))
|
||||
(assert-equal "hello" (trim "hello")))
|
||||
|
||||
(deftest "split and join"
|
||||
(assert-equal (list "a" "b" "c") (split "a,b,c" ","))
|
||||
(assert-equal "a-b-c" (join "-" (list "a" "b" "c")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; List operations
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "lists"
|
||||
(deftest "constructors"
|
||||
(assert-equal (list 1 2 3) (list 1 2 3))
|
||||
(assert-equal (list) (list))
|
||||
(assert-length 3 (list 1 2 3)))
|
||||
|
||||
(deftest "first and rest"
|
||||
(assert-equal 1 (first (list 1 2 3)))
|
||||
(assert-equal (list 2 3) (rest (list 1 2 3)))
|
||||
(assert-nil (first (list)))
|
||||
(assert-equal (list) (rest (list))))
|
||||
|
||||
(deftest "nth"
|
||||
(assert-equal 1 (nth (list 1 2 3) 0))
|
||||
(assert-equal 2 (nth (list 1 2 3) 1))
|
||||
(assert-equal 3 (nth (list 1 2 3) 2)))
|
||||
|
||||
(deftest "last"
|
||||
(assert-equal 3 (last (list 1 2 3)))
|
||||
(assert-nil (last (list))))
|
||||
|
||||
(deftest "cons and append"
|
||||
(assert-equal (list 0 1 2) (cons 0 (list 1 2)))
|
||||
(assert-equal (list 1 2 3 4) (append (list 1 2) (list 3 4))))
|
||||
|
||||
(deftest "reverse"
|
||||
(assert-equal (list 3 2 1) (reverse (list 1 2 3)))
|
||||
(assert-equal (list) (reverse (list))))
|
||||
|
||||
(deftest "empty?"
|
||||
(assert-true (empty? (list)))
|
||||
(assert-false (empty? (list 1))))
|
||||
|
||||
(deftest "len"
|
||||
(assert-equal 0 (len (list)))
|
||||
(assert-equal 3 (len (list 1 2 3))))
|
||||
|
||||
(deftest "contains?"
|
||||
(assert-true (contains? (list 1 2 3) 2))
|
||||
(assert-false (contains? (list 1 2 3) 4)))
|
||||
|
||||
(deftest "flatten"
|
||||
(assert-equal (list 1 2 3 4) (flatten (list (list 1 2) (list 3 4))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Dict operations
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "dicts"
|
||||
(deftest "dict literal"
|
||||
(assert-type "dict" {:a 1 :b 2})
|
||||
(assert-equal 1 (get {:a 1} "a"))
|
||||
(assert-equal 2 (get {:a 1 :b 2} "b")))
|
||||
|
||||
(deftest "assoc"
|
||||
(assert-equal {:a 1 :b 2} (assoc {:a 1} "b" 2))
|
||||
(assert-equal {:a 99} (assoc {:a 1} "a" 99)))
|
||||
|
||||
(deftest "dissoc"
|
||||
(assert-equal {:b 2} (dissoc {:a 1 :b 2} "a")))
|
||||
|
||||
(deftest "keys and vals"
|
||||
(let ((d {:a 1 :b 2}))
|
||||
(assert-length 2 (keys d))
|
||||
(assert-length 2 (vals d))
|
||||
(assert-contains "a" (keys d))
|
||||
(assert-contains "b" (keys d))))
|
||||
|
||||
(deftest "has-key?"
|
||||
(assert-true (has-key? {:a 1} "a"))
|
||||
(assert-false (has-key? {:a 1} "b")))
|
||||
|
||||
(deftest "merge"
|
||||
(assert-equal {:a 1 :b 2 :c 3}
|
||||
(merge {:a 1 :b 2} {:c 3}))
|
||||
(assert-equal {:a 99 :b 2}
|
||||
(merge {:a 1 :b 2} {:a 99}))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Predicates
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "predicates"
|
||||
(deftest "nil?"
|
||||
(assert-true (nil? nil))
|
||||
(assert-false (nil? 0))
|
||||
(assert-false (nil? false))
|
||||
(assert-false (nil? "")))
|
||||
|
||||
(deftest "number?"
|
||||
(assert-true (number? 42))
|
||||
(assert-true (number? 3.14))
|
||||
(assert-false (number? "42")))
|
||||
|
||||
(deftest "string?"
|
||||
(assert-true (string? "hello"))
|
||||
(assert-false (string? 42)))
|
||||
|
||||
(deftest "list?"
|
||||
(assert-true (list? (list 1 2)))
|
||||
(assert-false (list? "not a list")))
|
||||
|
||||
(deftest "dict?"
|
||||
(assert-true (dict? {:a 1}))
|
||||
(assert-false (dict? (list 1))))
|
||||
|
||||
(deftest "boolean?"
|
||||
(assert-true (boolean? true))
|
||||
(assert-true (boolean? false))
|
||||
(assert-false (boolean? nil))
|
||||
(assert-false (boolean? 0)))
|
||||
|
||||
(deftest "not"
|
||||
(assert-true (not false))
|
||||
(assert-true (not nil))
|
||||
(assert-false (not true))
|
||||
(assert-false (not 1))
|
||||
(assert-false (not "x"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Special forms
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "special-forms"
|
||||
(deftest "if"
|
||||
(assert-equal "yes" (if true "yes" "no"))
|
||||
(assert-equal "no" (if false "yes" "no"))
|
||||
(assert-equal "no" (if nil "yes" "no"))
|
||||
(assert-nil (if false "yes")))
|
||||
|
||||
(deftest "when"
|
||||
(assert-equal "yes" (when true "yes"))
|
||||
(assert-nil (when false "yes")))
|
||||
|
||||
(deftest "cond"
|
||||
(assert-equal "a" (cond true "a" :else "b"))
|
||||
(assert-equal "b" (cond false "a" :else "b"))
|
||||
(assert-equal "c" (cond
|
||||
false "a"
|
||||
false "b"
|
||||
:else "c")))
|
||||
|
||||
(deftest "cond with 2-element predicate as first test"
|
||||
;; Regression: cond misclassifies Clojure-style as scheme-style when
|
||||
;; the first test is a 2-element list like (nil? x) or (empty? x).
|
||||
;; The evaluator checks: is first arg a 2-element list? If yes, treats
|
||||
;; as scheme-style ((test body) ...) — returning the arg instead of
|
||||
;; evaluating the predicate call.
|
||||
(assert-equal 0 (cond (nil? nil) 0 :else 1))
|
||||
(assert-equal 1 (cond (nil? "x") 0 :else 1))
|
||||
(assert-equal "empty" (cond (empty? (list)) "empty" :else "not-empty"))
|
||||
(assert-equal "not-empty" (cond (empty? (list 1)) "empty" :else "not-empty"))
|
||||
(assert-equal "yes" (cond (not false) "yes" :else "no"))
|
||||
(assert-equal "no" (cond (not true) "yes" :else "no")))
|
||||
|
||||
(deftest "cond with 2-element predicate and no :else"
|
||||
;; Same bug, but without :else — this is the worst case because the
|
||||
;; bootstrapper heuristic also breaks (all clauses are 2-element lists).
|
||||
(assert-equal "found"
|
||||
(cond (nil? nil) "found"
|
||||
(nil? "x") "other"))
|
||||
(assert-equal "b"
|
||||
(cond (nil? "x") "a"
|
||||
(not false) "b")))
|
||||
|
||||
(deftest "and"
|
||||
(assert-true (and true true))
|
||||
(assert-false (and true false))
|
||||
(assert-false (and false true))
|
||||
(assert-equal 3 (and 1 2 3)))
|
||||
|
||||
(deftest "or"
|
||||
(assert-equal 1 (or 1 2))
|
||||
(assert-equal 2 (or false 2))
|
||||
(assert-equal "fallback" (or nil false "fallback"))
|
||||
(assert-false (or false false)))
|
||||
|
||||
(deftest "let"
|
||||
(assert-equal 3 (let ((x 1) (y 2)) (+ x y)))
|
||||
(assert-equal "hello world"
|
||||
(let ((a "hello") (b " world")) (str a b))))
|
||||
|
||||
(deftest "let clojure-style"
|
||||
(assert-equal 3 (let (x 1 y 2) (+ x y))))
|
||||
|
||||
(deftest "do / begin"
|
||||
(assert-equal 3 (do 1 2 3))
|
||||
(assert-equal "last" (begin "first" "middle" "last")))
|
||||
|
||||
(deftest "define"
|
||||
(define x 42)
|
||||
(assert-equal 42 x))
|
||||
|
||||
(deftest "set!"
|
||||
(define x 1)
|
||||
(set! x 2)
|
||||
(assert-equal 2 x)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Lambda and closures
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "lambdas"
|
||||
(deftest "basic lambda"
|
||||
(let ((add (fn (a b) (+ a b))))
|
||||
(assert-equal 3 (add 1 2))))
|
||||
|
||||
(deftest "closure captures env"
|
||||
(let ((x 10))
|
||||
(let ((add-x (fn (y) (+ x y))))
|
||||
(assert-equal 15 (add-x 5)))))
|
||||
|
||||
(deftest "lambda as argument"
|
||||
(assert-equal (list 2 4 6)
|
||||
(map (fn (x) (* x 2)) (list 1 2 3))))
|
||||
|
||||
(deftest "recursive lambda via define"
|
||||
(define factorial
|
||||
(fn (n) (if (<= n 1) 1 (* n (factorial (- n 1))))))
|
||||
(assert-equal 120 (factorial 5)))
|
||||
|
||||
(deftest "higher-order returns lambda"
|
||||
(let ((make-adder (fn (n) (fn (x) (+ n x)))))
|
||||
(let ((add5 (make-adder 5)))
|
||||
(assert-equal 8 (add5 3)))))
|
||||
|
||||
(deftest "multi-body lambda returns last value"
|
||||
;; All body expressions must execute. Return value is the last.
|
||||
;; Catches: sf-lambda using nth(args,1) instead of rest(args).
|
||||
(let ((f (fn (x) (+ x 1) (+ x 2) (+ x 3))))
|
||||
(assert-equal 13 (f 10))))
|
||||
|
||||
(deftest "multi-body lambda side effects via dict mutation"
|
||||
;; Verify all body expressions run by mutating a shared dict.
|
||||
(let ((state (dict "a" 0 "b" 0)))
|
||||
(let ((f (fn ()
|
||||
(dict-set! state "a" 1)
|
||||
(dict-set! state "b" 2)
|
||||
"done")))
|
||||
(assert-equal "done" (f))
|
||||
(assert-equal 1 (get state "a"))
|
||||
(assert-equal 2 (get state "b")))))
|
||||
|
||||
(deftest "multi-body lambda two expressions"
|
||||
;; Simplest case: two body expressions, return value is second.
|
||||
(assert-equal 20
|
||||
((fn (x) (+ x 1) (* x 2)) 10))
|
||||
;; And with zero-arg lambda
|
||||
(assert-equal 42
|
||||
((fn () (+ 1 2) 42)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Higher-order forms
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "higher-order"
|
||||
(deftest "map"
|
||||
(assert-equal (list 2 4 6)
|
||||
(map (fn (x) (* x 2)) (list 1 2 3)))
|
||||
(assert-equal (list) (map (fn (x) x) (list))))
|
||||
|
||||
(deftest "filter"
|
||||
(assert-equal (list 2 4)
|
||||
(filter (fn (x) (= (mod x 2) 0)) (list 1 2 3 4)))
|
||||
(assert-equal (list)
|
||||
(filter (fn (x) false) (list 1 2 3))))
|
||||
|
||||
(deftest "reduce"
|
||||
(assert-equal 10 (reduce (fn (acc x) (+ acc x)) 0 (list 1 2 3 4)))
|
||||
(assert-equal 0 (reduce (fn (acc x) (+ acc x)) 0 (list))))
|
||||
|
||||
(deftest "some"
|
||||
(assert-true (some (fn (x) (> x 3)) (list 1 2 3 4 5)))
|
||||
(assert-false (some (fn (x) (> x 10)) (list 1 2 3))))
|
||||
|
||||
(deftest "every?"
|
||||
(assert-true (every? (fn (x) (> x 0)) (list 1 2 3)))
|
||||
(assert-false (every? (fn (x) (> x 2)) (list 1 2 3))))
|
||||
|
||||
(deftest "map-indexed"
|
||||
(assert-equal (list "0:a" "1:b" "2:c")
|
||||
(map-indexed (fn (i x) (str i ":" x)) (list "a" "b" "c")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Components
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "components"
|
||||
(deftest "defcomp creates component"
|
||||
(defcomp ~test-comp (&key title)
|
||||
(div title))
|
||||
(assert-true (not (nil? ~test-comp))))
|
||||
|
||||
(deftest "component renders with keyword args"
|
||||
(defcomp ~greeting (&key name)
|
||||
(span (str "Hello, " name "!")))
|
||||
(assert-true (not (nil? ~greeting))))
|
||||
|
||||
(deftest "component with children"
|
||||
(defcomp ~box (&key &rest children)
|
||||
(div :class "box" children))
|
||||
(assert-true (not (nil? ~box))))
|
||||
|
||||
(deftest "component with default via or"
|
||||
(defcomp ~label (&key text)
|
||||
(span (or text "default")))
|
||||
(assert-true (not (nil? ~label))))
|
||||
|
||||
(deftest "defcomp default affinity is auto"
|
||||
(defcomp ~aff-default (&key x)
|
||||
(div x))
|
||||
(assert-equal "auto" (component-affinity ~aff-default)))
|
||||
|
||||
(deftest "defcomp affinity client"
|
||||
(defcomp ~aff-client (&key x)
|
||||
:affinity :client
|
||||
(div x))
|
||||
(assert-equal "client" (component-affinity ~aff-client)))
|
||||
|
||||
(deftest "defcomp affinity server"
|
||||
(defcomp ~aff-server (&key x)
|
||||
:affinity :server
|
||||
(div x))
|
||||
(assert-equal "server" (component-affinity ~aff-server)))
|
||||
|
||||
(deftest "defcomp affinity preserves body"
|
||||
(defcomp ~aff-body (&key val)
|
||||
:affinity :client
|
||||
(span val))
|
||||
;; Component should still render correctly
|
||||
(assert-equal "client" (component-affinity ~aff-body))
|
||||
(assert-true (not (nil? ~aff-body)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Macros
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "macros"
|
||||
(deftest "defmacro creates macro"
|
||||
(defmacro unless (cond &rest body)
|
||||
`(if (not ,cond) (do ,@body)))
|
||||
(assert-equal "yes" (unless false "yes"))
|
||||
(assert-nil (unless true "no")))
|
||||
|
||||
(deftest "quasiquote and unquote"
|
||||
(let ((x 42))
|
||||
(assert-equal (list 1 42 3) `(1 ,x 3))))
|
||||
|
||||
(deftest "splice-unquote"
|
||||
(let ((xs (list 2 3 4)))
|
||||
(assert-equal (list 1 2 3 4 5) `(1 ,@xs 5)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Threading macro
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "threading"
|
||||
(deftest "thread-first"
|
||||
(assert-equal 8 (-> 5 (+ 1) (+ 2)))
|
||||
(assert-equal "HELLO" (-> "hello" upcase))
|
||||
(assert-equal "HELLO WORLD"
|
||||
(-> "hello"
|
||||
(str " world")
|
||||
upcase))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Truthiness
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "truthiness"
|
||||
(deftest "truthy values"
|
||||
(assert-true (if 1 true false))
|
||||
(assert-true (if "x" true false))
|
||||
(assert-true (if (list 1) true false))
|
||||
(assert-true (if true true false)))
|
||||
|
||||
(deftest "falsy values"
|
||||
(assert-false (if false true false))
|
||||
(assert-false (if nil true false)))
|
||||
|
||||
;; NOTE: empty list, zero, and empty string truthiness is
|
||||
;; platform-dependent. Python treats all three as falsy.
|
||||
;; JavaScript treats [] as truthy but 0 and "" as falsy.
|
||||
;; These tests are omitted — each bootstrapper should emit
|
||||
;; platform-specific truthiness tests instead.
|
||||
)
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Edge cases and regression tests
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "edge-cases"
|
||||
(deftest "nested let scoping"
|
||||
(let ((x 1))
|
||||
(let ((x 2))
|
||||
(assert-equal 2 x))
|
||||
;; outer x should be unchanged by inner let
|
||||
;; (this tests that let creates a new scope)
|
||||
))
|
||||
|
||||
(deftest "recursive map"
|
||||
(assert-equal (list (list 2 4) (list 6 8))
|
||||
(map (fn (sub) (map (fn (x) (* x 2)) sub))
|
||||
(list (list 1 2) (list 3 4)))))
|
||||
|
||||
(deftest "keyword as value"
|
||||
(assert-equal "class" :class)
|
||||
(assert-equal "id" :id))
|
||||
|
||||
(deftest "dict with evaluated values"
|
||||
(let ((x 42))
|
||||
(assert-equal 42 (get {:val x} "val"))))
|
||||
|
||||
(deftest "nil propagation"
|
||||
(assert-nil (get {:a 1} "missing"))
|
||||
(assert-equal "default" (or (get {:a 1} "missing") "default")))
|
||||
|
||||
(deftest "empty operations"
|
||||
(assert-equal (list) (map (fn (x) x) (list)))
|
||||
(assert-equal (list) (filter (fn (x) true) (list)))
|
||||
(assert-equal 0 (reduce (fn (acc x) (+ acc x)) 0 (list)))
|
||||
(assert-equal 0 (len (list)))
|
||||
(assert-equal "" (str))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Server-only tests — skip in browser (defpage, streaming functions)
|
||||
;; These require forms.sx which is only loaded server-side.
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(when (get (try-call (fn () stream-chunk-id)) "ok")
|
||||
|
||||
(defsuite "defpage"
|
||||
(deftest "basic defpage returns page-def"
|
||||
(let ((p (defpage test-basic :path "/test" :auth :public :content (div "hello"))))
|
||||
(assert-true (not (nil? p)))
|
||||
(assert-equal "test-basic" (get p "name"))
|
||||
(assert-equal "/test" (get p "path"))
|
||||
(assert-equal "public" (get p "auth"))))
|
||||
|
||||
(deftest "defpage content expr is unevaluated AST"
|
||||
(let ((p (defpage test-content :path "/c" :auth :public :content (~my-comp :title "hi"))))
|
||||
(assert-true (not (nil? (get p "content"))))))
|
||||
|
||||
(deftest "defpage with :stream"
|
||||
(let ((p (defpage test-stream :path "/s" :auth :public :stream true :content (div "x"))))
|
||||
(assert-equal true (get p "stream"))))
|
||||
|
||||
(deftest "defpage with :shell"
|
||||
(let ((p (defpage test-shell :path "/sh" :auth :public :stream true
|
||||
:shell (~my-layout (~suspense :id "data" :fallback (div "loading...")))
|
||||
:content (~my-streamed :data data-val))))
|
||||
(assert-true (not (nil? (get p "shell"))))
|
||||
(assert-true (not (nil? (get p "content"))))))
|
||||
|
||||
(deftest "defpage with :fallback"
|
||||
(let ((p (defpage test-fallback :path "/f" :auth :public :stream true
|
||||
:fallback (div :class "skeleton" "loading")
|
||||
:content (div "done"))))
|
||||
(assert-true (not (nil? (get p "fallback"))))))
|
||||
|
||||
(deftest "defpage with :data"
|
||||
(let ((p (defpage test-data :path "/d" :auth :public
|
||||
:data (fetch-items)
|
||||
:content (~items-list :items items))))
|
||||
(assert-true (not (nil? (get p "data"))))))
|
||||
|
||||
(deftest "defpage missing fields are nil"
|
||||
(let ((p (defpage test-minimal :path "/m" :auth :public :content (div "x"))))
|
||||
(assert-nil (get p "data"))
|
||||
(assert-nil (get p "filter"))
|
||||
(assert-nil (get p "aside"))
|
||||
(assert-nil (get p "menu"))
|
||||
(assert-nil (get p "shell"))
|
||||
(assert-nil (get p "fallback"))
|
||||
(assert-equal false (get p "stream")))))
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Multi-stream data protocol (from forms.sx)
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "stream-chunk-id"
|
||||
(deftest "extracts stream-id from chunk"
|
||||
(assert-equal "my-slot" (stream-chunk-id {"stream-id" "my-slot" "x" 1})))
|
||||
|
||||
(deftest "defaults to stream-content when missing"
|
||||
(assert-equal "stream-content" (stream-chunk-id {"x" 1 "y" 2}))))
|
||||
|
||||
(defsuite "stream-chunk-bindings"
|
||||
(deftest "removes stream-id from chunk"
|
||||
(let ((bindings (stream-chunk-bindings {"stream-id" "slot" "name" "alice" "age" 30})))
|
||||
(assert-equal "alice" (get bindings "name"))
|
||||
(assert-equal 30 (get bindings "age"))
|
||||
(assert-nil (get bindings "stream-id"))))
|
||||
|
||||
(deftest "returns all keys when no stream-id"
|
||||
(let ((bindings (stream-chunk-bindings {"a" 1 "b" 2})))
|
||||
(assert-equal 1 (get bindings "a"))
|
||||
(assert-equal 2 (get bindings "b")))))
|
||||
|
||||
(defsuite "normalize-binding-key"
|
||||
(deftest "converts underscores to hyphens"
|
||||
(assert-equal "my-key" (normalize-binding-key "my_key")))
|
||||
|
||||
(deftest "leaves hyphens unchanged"
|
||||
(assert-equal "my-key" (normalize-binding-key "my-key")))
|
||||
|
||||
(deftest "handles multiple underscores"
|
||||
(assert-equal "a-b-c" (normalize-binding-key "a_b_c"))))
|
||||
|
||||
(defsuite "bind-stream-chunk"
|
||||
(deftest "creates fresh env with bindings"
|
||||
(let ((base {"existing" 42})
|
||||
(chunk {"stream-id" "slot" "user-name" "bob" "count" 5})
|
||||
(env (bind-stream-chunk chunk base)))
|
||||
;; Base env bindings are preserved
|
||||
(assert-equal 42 (get env "existing"))
|
||||
;; Chunk bindings are added (stream-id removed)
|
||||
(assert-equal "bob" (get env "user-name"))
|
||||
(assert-equal 5 (get env "count"))
|
||||
;; stream-id is not in env
|
||||
(assert-nil (get env "stream-id"))))
|
||||
|
||||
(deftest "isolates env from base — bindings don't leak to base"
|
||||
(let ((base {"x" 1})
|
||||
(chunk {"stream-id" "s" "y" 2})
|
||||
(env (bind-stream-chunk chunk base)))
|
||||
;; Chunk bindings should not appear in base
|
||||
(assert-nil (get base "y"))
|
||||
;; Base bindings should be in derived env
|
||||
(assert-equal 1 (get env "x")))))
|
||||
|
||||
(defsuite "validate-stream-data"
|
||||
(deftest "valid: list of dicts"
|
||||
(assert-true (validate-stream-data
|
||||
(list {"stream-id" "a" "x" 1}
|
||||
{"stream-id" "b" "y" 2}))))
|
||||
|
||||
(deftest "valid: empty list"
|
||||
(assert-true (validate-stream-data (list))))
|
||||
|
||||
(deftest "invalid: single dict (not a list)"
|
||||
(assert-equal false (validate-stream-data {"x" 1})))
|
||||
|
||||
(deftest "invalid: list containing non-dict"
|
||||
(assert-equal false (validate-stream-data (list {"x" 1} "oops" {"y" 2})))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Multi-stream end-to-end scenarios
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "multi-stream routing"
|
||||
(deftest "stream-chunk-id routes different chunks to different slots"
|
||||
(let ((chunks (list
|
||||
{"stream-id" "stream-fast" "msg" "quick"}
|
||||
{"stream-id" "stream-medium" "msg" "steady"}
|
||||
{"stream-id" "stream-slow" "msg" "slow"}))
|
||||
(ids (map stream-chunk-id chunks)))
|
||||
(assert-equal "stream-fast" (nth ids 0))
|
||||
(assert-equal "stream-medium" (nth ids 1))
|
||||
(assert-equal "stream-slow" (nth ids 2))))
|
||||
|
||||
(deftest "bind-stream-chunk creates isolated envs per chunk"
|
||||
(let ((base {"layout" "main"})
|
||||
(chunk-a {"stream-id" "a" "title" "First" "count" 1})
|
||||
(chunk-b {"stream-id" "b" "title" "Second" "count" 2})
|
||||
(env-a (bind-stream-chunk chunk-a base))
|
||||
(env-b (bind-stream-chunk chunk-b base)))
|
||||
;; Each env has its own bindings
|
||||
(assert-equal "First" (get env-a "title"))
|
||||
(assert-equal "Second" (get env-b "title"))
|
||||
(assert-equal 1 (get env-a "count"))
|
||||
(assert-equal 2 (get env-b "count"))
|
||||
;; Both share base
|
||||
(assert-equal "main" (get env-a "layout"))
|
||||
(assert-equal "main" (get env-b "layout"))
|
||||
;; Neither leaks into base
|
||||
(assert-nil (get base "title"))))
|
||||
|
||||
(deftest "normalize-binding-key applied to chunk keys"
|
||||
(let ((chunk {"stream-id" "s" "user_name" "alice" "item_count" 3})
|
||||
(bindings (stream-chunk-bindings chunk)))
|
||||
;; Keys with underscores need normalizing for SX env
|
||||
(assert-equal "alice" (get bindings "user_name"))
|
||||
;; normalize-binding-key converts them
|
||||
(assert-equal "user-name" (normalize-binding-key "user_name"))
|
||||
(assert-equal "item-count" (normalize-binding-key "item_count"))))
|
||||
|
||||
(deftest "defpage stream flag defaults to false"
|
||||
(let ((p (defpage test-no-stream :path "/ns" :auth :public :content (div "x"))))
|
||||
(assert-equal false (get p "stream"))))
|
||||
|
||||
(deftest "defpage stream true recorded in page-def"
|
||||
(let ((p (defpage test-with-stream :path "/ws" :auth :public
|
||||
:stream true
|
||||
:shell (~layout (~suspense :id "data"))
|
||||
:content (~chunk :val val))))
|
||||
(assert-equal true (get p "stream"))
|
||||
(assert-true (not (nil? (get p "shell")))))))
|
||||
|
||||
) ;; end (when has-server-forms?)
|
||||
86
spec/tests/test-framework.sx
Normal file
86
spec/tests/test-framework.sx
Normal file
@@ -0,0 +1,86 @@
|
||||
;; ==========================================================================
|
||||
;; test-framework.sx — Reusable test macros and assertion helpers
|
||||
;;
|
||||
;; Loaded first by all test runners. Provides deftest, defsuite, and
|
||||
;; assertion helpers. Requires 5 platform functions from the host:
|
||||
;;
|
||||
;; try-call (thunk) -> {:ok true} | {:ok false :error "msg"}
|
||||
;; report-pass (name) -> platform-specific pass output
|
||||
;; report-fail (name error) -> platform-specific fail output
|
||||
;; push-suite (name) -> push suite name onto context stack
|
||||
;; pop-suite () -> pop suite name from context stack
|
||||
;;
|
||||
;; Any host that provides these 5 functions can run any test spec.
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 1. Test framework macros
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defmacro deftest (name &rest body)
|
||||
`(let ((result (try-call (fn () ,@body))))
|
||||
(if (get result "ok")
|
||||
(report-pass ,name)
|
||||
(report-fail ,name (get result "error")))))
|
||||
|
||||
(defmacro defsuite (name &rest items)
|
||||
`(do (push-suite ,name)
|
||||
,@items
|
||||
(pop-suite)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 2. Assertion helpers — defined in SX, available in test bodies
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(define assert-equal
|
||||
(fn (expected actual)
|
||||
(assert (equal? expected actual)
|
||||
(str "Expected " (str expected) " but got " (str actual)))))
|
||||
|
||||
(define assert-not-equal
|
||||
(fn (a b)
|
||||
(assert (not (equal? a b))
|
||||
(str "Expected values to differ but both are " (str a)))))
|
||||
|
||||
(define assert-true
|
||||
(fn (val)
|
||||
(assert val (str "Expected truthy but got " (str val)))))
|
||||
|
||||
(define assert-false
|
||||
(fn (val)
|
||||
(assert (not val) (str "Expected falsy but got " (str val)))))
|
||||
|
||||
(define assert-nil
|
||||
(fn (val)
|
||||
(assert (nil? val) (str "Expected nil but got " (str val)))))
|
||||
|
||||
(define assert-type
|
||||
(fn ((expected-type :as string) val)
|
||||
(let ((actual-type
|
||||
(if (nil? val) "nil"
|
||||
(if (boolean? val) "boolean"
|
||||
(if (number? val) "number"
|
||||
(if (string? val) "string"
|
||||
(if (list? val) "list"
|
||||
(if (dict? val) "dict"
|
||||
"unknown"))))))))
|
||||
(assert (= expected-type actual-type)
|
||||
(str "Expected type " expected-type " but got " actual-type)))))
|
||||
|
||||
(define assert-length
|
||||
(fn ((expected-len :as number) (col :as list))
|
||||
(assert (= (len col) expected-len)
|
||||
(str "Expected length " expected-len " but got " (len col)))))
|
||||
|
||||
(define assert-contains
|
||||
(fn (item (col :as list))
|
||||
(assert (some (fn (x) (equal? x item)) col)
|
||||
(str "Expected collection to contain " (str item)))))
|
||||
|
||||
(define assert-throws
|
||||
(fn ((thunk :as lambda))
|
||||
(let ((result (try-call thunk)))
|
||||
(assert (not (get result "ok"))
|
||||
"Expected an error to be thrown but none was"))))
|
||||
259
spec/tests/test-parser.sx
Normal file
259
spec/tests/test-parser.sx
Normal file
@@ -0,0 +1,259 @@
|
||||
;; ==========================================================================
|
||||
;; test-parser.sx — Tests for the SX parser and serializer
|
||||
;;
|
||||
;; Requires: test-framework.sx loaded first.
|
||||
;; Modules tested: parser.sx
|
||||
;;
|
||||
;; Platform functions required (beyond test framework):
|
||||
;; sx-parse (source) -> list of AST expressions
|
||||
;; sx-serialize (expr) -> SX source string
|
||||
;; make-symbol (name) -> Symbol value
|
||||
;; make-keyword (name) -> Keyword value
|
||||
;; symbol-name (sym) -> string
|
||||
;; keyword-name (kw) -> string
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Literal parsing
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "parser-literals"
|
||||
(deftest "parse integers"
|
||||
(assert-equal (list 42) (sx-parse "42"))
|
||||
(assert-equal (list 0) (sx-parse "0"))
|
||||
(assert-equal (list -7) (sx-parse "-7")))
|
||||
|
||||
(deftest "parse floats"
|
||||
(assert-equal (list 3.14) (sx-parse "3.14"))
|
||||
(assert-equal (list -0.5) (sx-parse "-0.5")))
|
||||
|
||||
(deftest "parse strings"
|
||||
(assert-equal (list "hello") (sx-parse "\"hello\""))
|
||||
(assert-equal (list "") (sx-parse "\"\"")))
|
||||
|
||||
(deftest "parse escape: newline"
|
||||
(assert-equal (list "a\nb") (sx-parse "\"a\\nb\"")))
|
||||
|
||||
(deftest "parse escape: tab"
|
||||
(assert-equal (list "a\tb") (sx-parse "\"a\\tb\"")))
|
||||
|
||||
(deftest "parse escape: quote"
|
||||
(assert-equal (list "a\"b") (sx-parse "\"a\\\"b\"")))
|
||||
|
||||
(deftest "parse booleans"
|
||||
(assert-equal (list true) (sx-parse "true"))
|
||||
(assert-equal (list false) (sx-parse "false")))
|
||||
|
||||
(deftest "parse nil"
|
||||
(assert-equal (list nil) (sx-parse "nil")))
|
||||
|
||||
(deftest "parse keywords"
|
||||
(let ((result (sx-parse ":hello")))
|
||||
(assert-length 1 result)
|
||||
(assert-equal "hello" (keyword-name (first result)))))
|
||||
|
||||
(deftest "parse symbols"
|
||||
(let ((result (sx-parse "foo")))
|
||||
(assert-length 1 result)
|
||||
(assert-equal "foo" (symbol-name (first result))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Composite parsing
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "parser-lists"
|
||||
(deftest "parse empty list"
|
||||
(let ((result (sx-parse "()")))
|
||||
(assert-length 1 result)
|
||||
(assert-equal (list) (first result))))
|
||||
|
||||
(deftest "parse list of numbers"
|
||||
(let ((result (sx-parse "(1 2 3)")))
|
||||
(assert-length 1 result)
|
||||
(assert-equal (list 1 2 3) (first result))))
|
||||
|
||||
(deftest "parse nested lists"
|
||||
(let ((result (sx-parse "(1 (2 3) 4)")))
|
||||
(assert-length 1 result)
|
||||
(assert-equal (list 1 (list 2 3) 4) (first result))))
|
||||
|
||||
(deftest "parse square brackets as list"
|
||||
(let ((result (sx-parse "[1 2 3]")))
|
||||
(assert-length 1 result)
|
||||
(assert-equal (list 1 2 3) (first result))))
|
||||
|
||||
(deftest "parse mixed types"
|
||||
(let ((result (sx-parse "(42 \"hello\" true nil)")))
|
||||
(assert-length 1 result)
|
||||
(let ((lst (first result)))
|
||||
(assert-equal 42 (nth lst 0))
|
||||
(assert-equal "hello" (nth lst 1))
|
||||
(assert-equal true (nth lst 2))
|
||||
(assert-nil (nth lst 3))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Dict parsing
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "parser-dicts"
|
||||
(deftest "parse empty dict"
|
||||
(let ((result (sx-parse "{}")))
|
||||
(assert-length 1 result)
|
||||
(assert-type "dict" (first result))))
|
||||
|
||||
(deftest "parse dict with keyword keys"
|
||||
(let ((result (sx-parse "{:a 1 :b 2}")))
|
||||
(assert-length 1 result)
|
||||
(let ((d (first result)))
|
||||
(assert-type "dict" d)
|
||||
(assert-equal 1 (get d "a"))
|
||||
(assert-equal 2 (get d "b")))))
|
||||
|
||||
(deftest "parse dict with string values"
|
||||
(let ((result (sx-parse "{:name \"alice\"}")))
|
||||
(assert-length 1 result)
|
||||
(assert-equal "alice" (get (first result) "name")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Comments and whitespace
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "parser-whitespace"
|
||||
(deftest "skip line comments"
|
||||
(assert-equal (list 42) (sx-parse ";; comment\n42"))
|
||||
(assert-equal (list 1 2) (sx-parse "1 ;; middle\n2")))
|
||||
|
||||
(deftest "skip whitespace"
|
||||
(assert-equal (list 42) (sx-parse " 42 "))
|
||||
(assert-equal (list 1 2) (sx-parse " 1 \n\t 2 ")))
|
||||
|
||||
(deftest "parse multiple top-level expressions"
|
||||
(assert-length 3 (sx-parse "1 2 3"))
|
||||
(assert-equal (list 1 2 3) (sx-parse "1 2 3")))
|
||||
|
||||
(deftest "empty input"
|
||||
(assert-equal (list) (sx-parse "")))
|
||||
|
||||
(deftest "only comments"
|
||||
(assert-equal (list) (sx-parse ";; just a comment\n;; another"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Quote sugar
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "parser-quote-sugar"
|
||||
(deftest "quasiquote"
|
||||
(let ((result (sx-parse "`foo")))
|
||||
(assert-length 1 result)
|
||||
(let ((expr (first result)))
|
||||
(assert-type "list" expr)
|
||||
(assert-equal "quasiquote" (symbol-name (first expr))))))
|
||||
|
||||
(deftest "unquote"
|
||||
(let ((result (sx-parse ",foo")))
|
||||
(assert-length 1 result)
|
||||
(let ((expr (first result)))
|
||||
(assert-type "list" expr)
|
||||
(assert-equal "unquote" (symbol-name (first expr))))))
|
||||
|
||||
(deftest "splice-unquote"
|
||||
(let ((result (sx-parse ",@foo")))
|
||||
(assert-length 1 result)
|
||||
(let ((expr (first result)))
|
||||
(assert-type "list" expr)
|
||||
(assert-equal "splice-unquote" (symbol-name (first expr)))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Serializer
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "serializer"
|
||||
(deftest "serialize number"
|
||||
(assert-equal "42" (sx-serialize 42)))
|
||||
|
||||
(deftest "serialize string"
|
||||
(assert-equal "\"hello\"" (sx-serialize "hello")))
|
||||
|
||||
(deftest "serialize boolean"
|
||||
(assert-equal "true" (sx-serialize true))
|
||||
(assert-equal "false" (sx-serialize false)))
|
||||
|
||||
(deftest "serialize nil"
|
||||
(assert-equal "nil" (sx-serialize nil)))
|
||||
|
||||
(deftest "serialize keyword"
|
||||
(assert-equal ":foo" (sx-serialize (make-keyword "foo"))))
|
||||
|
||||
(deftest "serialize symbol"
|
||||
(assert-equal "bar" (sx-serialize (make-symbol "bar"))))
|
||||
|
||||
(deftest "serialize list"
|
||||
(assert-equal "(1 2 3)" (sx-serialize (list 1 2 3))))
|
||||
|
||||
(deftest "serialize empty list"
|
||||
(assert-equal "()" (sx-serialize (list))))
|
||||
|
||||
(deftest "serialize nested"
|
||||
(assert-equal "(1 (2 3) 4)" (sx-serialize (list 1 (list 2 3) 4)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Round-trip: parse then serialize
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "parser-roundtrip"
|
||||
(deftest "roundtrip number"
|
||||
(assert-equal "42" (sx-serialize (first (sx-parse "42")))))
|
||||
|
||||
(deftest "roundtrip string"
|
||||
(assert-equal "\"hello\"" (sx-serialize (first (sx-parse "\"hello\"")))))
|
||||
|
||||
(deftest "roundtrip list"
|
||||
(assert-equal "(1 2 3)" (sx-serialize (first (sx-parse "(1 2 3)")))))
|
||||
|
||||
(deftest "roundtrip nested"
|
||||
(assert-equal "(a (b c))"
|
||||
(sx-serialize (first (sx-parse "(a (b c))"))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Reader macros
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "reader-macros"
|
||||
(deftest "datum comment discards expr"
|
||||
(assert-equal (list 42) (sx-parse "#;(ignored) 42")))
|
||||
|
||||
(deftest "datum comment in list"
|
||||
(assert-equal (list (list 1 3)) (sx-parse "(1 #;2 3)")))
|
||||
|
||||
(deftest "datum comment discards nested"
|
||||
(assert-equal (list 99) (sx-parse "#;(a (b c) d) 99")))
|
||||
|
||||
(deftest "raw string basic"
|
||||
(assert-equal (list "hello") (sx-parse "#|hello|")))
|
||||
|
||||
(deftest "raw string with quotes"
|
||||
(assert-equal (list "say \"hi\"") (sx-parse "#|say \"hi\"|")))
|
||||
|
||||
(deftest "raw string with backslashes"
|
||||
(assert-equal (list "a\\nb") (sx-parse "#|a\\nb|")))
|
||||
|
||||
(deftest "raw string empty"
|
||||
(assert-equal (list "") (sx-parse "#||")))
|
||||
|
||||
(deftest "quote shorthand symbol"
|
||||
(let ((result (first (sx-parse "#'foo"))))
|
||||
(assert-equal "quote" (symbol-name (first result)))
|
||||
(assert-equal "foo" (symbol-name (nth result 1)))))
|
||||
|
||||
(deftest "quote shorthand list"
|
||||
(let ((result (first (sx-parse "#'(1 2 3)"))))
|
||||
(assert-equal "quote" (symbol-name (first result)))
|
||||
(assert-equal (list 1 2 3) (nth result 1)))))
|
||||
230
spec/tests/test-render.sx
Normal file
230
spec/tests/test-render.sx
Normal file
@@ -0,0 +1,230 @@
|
||||
;; ==========================================================================
|
||||
;; test-render.sx — Tests for the HTML rendering adapter
|
||||
;;
|
||||
;; Requires: test-framework.sx loaded first.
|
||||
;; Modules tested: render.sx, adapter-html.sx
|
||||
;;
|
||||
;; Platform functions required (beyond test framework):
|
||||
;; render-html (sx-source) -> HTML string
|
||||
;; Parses the sx-source string, evaluates via render-to-html in a
|
||||
;; fresh env, and returns the resulting HTML string.
|
||||
;; (This is a test-only convenience that wraps parse + render-to-html.)
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Basic element rendering
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "render-elements"
|
||||
(deftest "simple div"
|
||||
(assert-equal "<div>hello</div>"
|
||||
(render-html "(div \"hello\")")))
|
||||
|
||||
(deftest "nested elements"
|
||||
(assert-equal "<div><span>hi</span></div>"
|
||||
(render-html "(div (span \"hi\"))")))
|
||||
|
||||
(deftest "multiple children"
|
||||
(assert-equal "<div><p>a</p><p>b</p></div>"
|
||||
(render-html "(div (p \"a\") (p \"b\"))")))
|
||||
|
||||
(deftest "text content"
|
||||
(assert-equal "<p>hello world</p>"
|
||||
(render-html "(p \"hello\" \" world\")")))
|
||||
|
||||
(deftest "number content"
|
||||
(assert-equal "<span>42</span>"
|
||||
(render-html "(span 42)"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Attributes
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "render-attrs"
|
||||
(deftest "string attribute"
|
||||
(let ((html (render-html "(div :id \"main\" \"content\")")))
|
||||
(assert-true (string-contains? html "id=\"main\""))
|
||||
(assert-true (string-contains? html "content"))))
|
||||
|
||||
(deftest "class attribute"
|
||||
(let ((html (render-html "(div :class \"foo bar\" \"x\")")))
|
||||
(assert-true (string-contains? html "class=\"foo bar\""))))
|
||||
|
||||
(deftest "multiple attributes"
|
||||
(let ((html (render-html "(a :href \"/home\" :class \"link\" \"Home\")")))
|
||||
(assert-true (string-contains? html "href=\"/home\""))
|
||||
(assert-true (string-contains? html "class=\"link\""))
|
||||
(assert-true (string-contains? html "Home")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Void elements
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "render-void"
|
||||
(deftest "br is self-closing"
|
||||
(assert-equal "<br />" (render-html "(br)")))
|
||||
|
||||
(deftest "img with attrs"
|
||||
(let ((html (render-html "(img :src \"pic.jpg\" :alt \"A pic\")")))
|
||||
(assert-true (string-contains? html "<img"))
|
||||
(assert-true (string-contains? html "src=\"pic.jpg\""))
|
||||
(assert-true (string-contains? html "/>"))
|
||||
;; void elements should not have a closing tag
|
||||
(assert-false (string-contains? html "</img>"))))
|
||||
|
||||
(deftest "input is self-closing"
|
||||
(let ((html (render-html "(input :type \"text\" :name \"q\")")))
|
||||
(assert-true (string-contains? html "<input"))
|
||||
(assert-true (string-contains? html "/>")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Boolean attributes
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "render-boolean-attrs"
|
||||
(deftest "true boolean attr emits name only"
|
||||
(let ((html (render-html "(input :disabled true :type \"text\")")))
|
||||
(assert-true (string-contains? html "disabled"))
|
||||
;; Should NOT have disabled="true"
|
||||
(assert-false (string-contains? html "disabled=\""))))
|
||||
|
||||
(deftest "false boolean attr omitted"
|
||||
(let ((html (render-html "(input :disabled false :type \"text\")")))
|
||||
(assert-false (string-contains? html "disabled")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Fragments
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "render-fragments"
|
||||
(deftest "fragment renders children without wrapper"
|
||||
(assert-equal "<p>a</p><p>b</p>"
|
||||
(render-html "(<> (p \"a\") (p \"b\"))")))
|
||||
|
||||
(deftest "empty fragment"
|
||||
(assert-equal ""
|
||||
(render-html "(<>)"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; HTML escaping
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "render-escaping"
|
||||
(deftest "text content is escaped"
|
||||
(let ((html (render-html "(p \"<script>alert(1)</script>\")")))
|
||||
(assert-false (string-contains? html "<script>"))
|
||||
(assert-true (string-contains? html "<script>"))))
|
||||
|
||||
(deftest "attribute values are escaped"
|
||||
(let ((html (render-html "(div :title \"a\\\"b\" \"x\")")))
|
||||
(assert-true (string-contains? html "title=")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Control flow in render context
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "render-control-flow"
|
||||
(deftest "if renders correct branch"
|
||||
(assert-equal "<p>yes</p>"
|
||||
(render-html "(if true (p \"yes\") (p \"no\"))"))
|
||||
(assert-equal "<p>no</p>"
|
||||
(render-html "(if false (p \"yes\") (p \"no\"))")))
|
||||
|
||||
(deftest "when renders or skips"
|
||||
(assert-equal "<p>ok</p>"
|
||||
(render-html "(when true (p \"ok\"))"))
|
||||
(assert-equal ""
|
||||
(render-html "(when false (p \"ok\"))")))
|
||||
|
||||
(deftest "map renders list"
|
||||
(assert-equal "<li>1</li><li>2</li><li>3</li>"
|
||||
(render-html "(map (fn (x) (li x)) (list 1 2 3))")))
|
||||
|
||||
(deftest "let in render context"
|
||||
(assert-equal "<p>hello</p>"
|
||||
(render-html "(let ((x \"hello\")) (p x))")))
|
||||
|
||||
(deftest "cond with 2-element predicate test"
|
||||
;; Regression: cond misclassifies (nil? x) as scheme-style clause.
|
||||
(assert-equal "<p>yes</p>"
|
||||
(render-html "(cond (nil? nil) (p \"yes\") :else (p \"no\"))"))
|
||||
(assert-equal "<p>no</p>"
|
||||
(render-html "(cond (nil? \"x\") (p \"yes\") :else (p \"no\"))")))
|
||||
|
||||
(deftest "let preserves outer scope bindings"
|
||||
;; Regression: process-bindings must preserve parent env scope chain.
|
||||
;; Using merge() on Env objects returns empty dict (Env is not dict subclass).
|
||||
(assert-equal "<p>outer</p>"
|
||||
(render-html "(do (define theme \"outer\") (let ((x 1)) (p theme)))")))
|
||||
|
||||
(deftest "nested let preserves outer scope"
|
||||
(assert-equal "<div><span>hello</span><span>world</span></div>"
|
||||
(render-html "(do (define a \"hello\")
|
||||
(define b \"world\")
|
||||
(div (let ((x 1)) (span a))
|
||||
(let ((y 2)) (span b))))"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Component rendering
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "render-components"
|
||||
(deftest "component with keyword args"
|
||||
(assert-equal "<h1>Hello</h1>"
|
||||
(render-html "(do (defcomp ~title (&key text) (h1 text)) (~title :text \"Hello\"))")))
|
||||
|
||||
(deftest "component with children"
|
||||
(let ((html (render-html "(do (defcomp ~box (&key &rest children) (div :class \"box\" children)) (~box (p \"inside\")))")))
|
||||
(assert-true (string-contains? html "class=\"box\""))
|
||||
(assert-true (string-contains? html "<p>inside</p>")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Map/filter producing multiple children (aser-adjacent regression tests)
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "render-map-children"
|
||||
(deftest "map producing multiple children inside tag"
|
||||
(assert-equal "<ul><li>a</li><li>b</li><li>c</li></ul>"
|
||||
(render-html "(do (define items (list \"a\" \"b\" \"c\"))
|
||||
(ul (map (fn (x) (li x)) items)))")))
|
||||
|
||||
(deftest "map with other siblings"
|
||||
(assert-equal "<ul><li>first</li><li>a</li><li>b</li></ul>"
|
||||
(render-html "(do (define items (list \"a\" \"b\"))
|
||||
(ul (li \"first\") (map (fn (x) (li x)) items)))")))
|
||||
|
||||
(deftest "filter with nil results inside tag"
|
||||
(assert-equal "<ul><li>a</li><li>c</li></ul>"
|
||||
(render-html "(do (define items (list \"a\" nil \"c\"))
|
||||
(ul (map (fn (x) (li x))
|
||||
(filter (fn (x) (not (nil? x))) items))))")))
|
||||
|
||||
(deftest "nested map inside let"
|
||||
(assert-equal "<div><span>1</span><span>2</span></div>"
|
||||
(render-html "(let ((nums (list 1 2)))
|
||||
(div (map (fn (n) (span n)) nums)))")))
|
||||
|
||||
(deftest "component with &rest receiving mapped results"
|
||||
(let ((html (render-html "(do (defcomp ~list-box (&key &rest children) (div :class \"lb\" children))
|
||||
(define items (list \"x\" \"y\"))
|
||||
(~list-box (map (fn (x) (p x)) items)))")))
|
||||
(assert-true (string-contains? html "class=\"lb\""))
|
||||
(assert-true (string-contains? html "<p>x</p>"))
|
||||
(assert-true (string-contains? html "<p>y</p>"))))
|
||||
|
||||
(deftest "map-indexed renders with index"
|
||||
(assert-equal "<li>0: a</li><li>1: b</li>"
|
||||
(render-html "(map-indexed (fn (i x) (li (str i \": \" x))) (list \"a\" \"b\"))")))
|
||||
|
||||
(deftest "for-each renders each item"
|
||||
(assert-equal "<p>1</p><p>2</p>"
|
||||
(render-html "(for-each (fn (x) (p x)) (list 1 2))"))))
|
||||
652
spec/tests/test-types.sx
Normal file
652
spec/tests/test-types.sx
Normal file
@@ -0,0 +1,652 @@
|
||||
;; ==========================================================================
|
||||
;; test-types.sx — Tests for the SX gradual type system
|
||||
;;
|
||||
;; Requires: test-framework.sx loaded first.
|
||||
;; Modules tested: types.sx (subtype?, infer-type, check-component, etc.)
|
||||
;;
|
||||
;; Platform functions required (beyond test framework):
|
||||
;; All type system functions from types.sx must be loaded.
|
||||
;; test-prim-types — a dict of primitive return types for testing.
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Subtype checking
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "subtype-basics"
|
||||
(deftest "any accepts everything"
|
||||
(assert-true (subtype? "number" "any"))
|
||||
(assert-true (subtype? "string" "any"))
|
||||
(assert-true (subtype? "nil" "any"))
|
||||
(assert-true (subtype? "boolean" "any"))
|
||||
(assert-true (subtype? "any" "any")))
|
||||
|
||||
(deftest "never is subtype of everything"
|
||||
(assert-true (subtype? "never" "number"))
|
||||
(assert-true (subtype? "never" "string"))
|
||||
(assert-true (subtype? "never" "any"))
|
||||
(assert-true (subtype? "never" "nil")))
|
||||
|
||||
(deftest "identical types"
|
||||
(assert-true (subtype? "number" "number"))
|
||||
(assert-true (subtype? "string" "string"))
|
||||
(assert-true (subtype? "boolean" "boolean"))
|
||||
(assert-true (subtype? "nil" "nil")))
|
||||
|
||||
(deftest "different base types are not subtypes"
|
||||
(assert-false (subtype? "number" "string"))
|
||||
(assert-false (subtype? "string" "number"))
|
||||
(assert-false (subtype? "boolean" "number"))
|
||||
(assert-false (subtype? "string" "boolean")))
|
||||
|
||||
(deftest "any is not subtype of specific type"
|
||||
(assert-false (subtype? "any" "number"))
|
||||
(assert-false (subtype? "any" "string"))))
|
||||
|
||||
|
||||
(defsuite "subtype-nullable"
|
||||
(deftest "nil is subtype of nullable types"
|
||||
(assert-true (subtype? "nil" "string?"))
|
||||
(assert-true (subtype? "nil" "number?"))
|
||||
(assert-true (subtype? "nil" "dict?"))
|
||||
(assert-true (subtype? "nil" "boolean?")))
|
||||
|
||||
(deftest "base is subtype of its nullable"
|
||||
(assert-true (subtype? "string" "string?"))
|
||||
(assert-true (subtype? "number" "number?"))
|
||||
(assert-true (subtype? "dict" "dict?")))
|
||||
|
||||
(deftest "nullable is not subtype of base"
|
||||
(assert-false (subtype? "string?" "string"))
|
||||
(assert-false (subtype? "number?" "number")))
|
||||
|
||||
(deftest "different nullable types are not subtypes"
|
||||
(assert-false (subtype? "number" "string?"))
|
||||
(assert-false (subtype? "string" "number?"))))
|
||||
|
||||
|
||||
(defsuite "subtype-unions"
|
||||
(deftest "member is subtype of union"
|
||||
(assert-true (subtype? "number" (list "or" "number" "string")))
|
||||
(assert-true (subtype? "string" (list "or" "number" "string"))))
|
||||
|
||||
(deftest "non-member is not subtype of union"
|
||||
(assert-false (subtype? "boolean" (list "or" "number" "string"))))
|
||||
|
||||
(deftest "union is subtype if all members are"
|
||||
(assert-true (subtype? (list "or" "number" "string")
|
||||
(list "or" "number" "string" "boolean")))
|
||||
(assert-true (subtype? (list "or" "number" "string") "any")))
|
||||
|
||||
(deftest "union is not subtype if any member is not"
|
||||
(assert-false (subtype? (list "or" "number" "string") "number"))))
|
||||
|
||||
|
||||
(defsuite "subtype-list-of"
|
||||
(deftest "list-of covariance"
|
||||
(assert-true (subtype? (list "list-of" "number") (list "list-of" "number")))
|
||||
(assert-true (subtype? (list "list-of" "number") (list "list-of" "any"))))
|
||||
|
||||
(deftest "list-of is subtype of list"
|
||||
(assert-true (subtype? (list "list-of" "number") "list")))
|
||||
|
||||
(deftest "list is subtype of list-of any"
|
||||
(assert-true (subtype? "list" (list "list-of" "any")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Type union
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "type-union"
|
||||
(deftest "same types"
|
||||
(assert-equal "number" (type-union "number" "number"))
|
||||
(assert-equal "string" (type-union "string" "string")))
|
||||
|
||||
(deftest "any absorbs"
|
||||
(assert-equal "any" (type-union "any" "number"))
|
||||
(assert-equal "any" (type-union "number" "any")))
|
||||
|
||||
(deftest "never is identity"
|
||||
(assert-equal "number" (type-union "never" "number"))
|
||||
(assert-equal "string" (type-union "string" "never")))
|
||||
|
||||
(deftest "nil + base creates nullable"
|
||||
(assert-equal "string?" (type-union "nil" "string"))
|
||||
(assert-equal "number?" (type-union "number" "nil")))
|
||||
|
||||
(deftest "subtype collapses"
|
||||
(assert-equal "string?" (type-union "string" "string?"))
|
||||
(assert-equal "string?" (type-union "string?" "string")))
|
||||
|
||||
(deftest "incompatible creates union"
|
||||
(let ((result (type-union "number" "string")))
|
||||
(assert-true (= (type-of result) "list"))
|
||||
(assert-equal "or" (first result))
|
||||
(assert-true (contains? result "number"))
|
||||
(assert-true (contains? result "string")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Type narrowing
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "type-narrowing"
|
||||
(deftest "nil? narrows to nil in then branch"
|
||||
(let ((result (narrow-type "string?" "nil?")))
|
||||
(assert-equal "nil" (first result))
|
||||
(assert-equal "string" (nth result 1))))
|
||||
|
||||
(deftest "nil? narrows any stays any"
|
||||
(let ((result (narrow-type "any" "nil?")))
|
||||
(assert-equal "nil" (first result))
|
||||
(assert-equal "any" (nth result 1))))
|
||||
|
||||
(deftest "string? narrows to string in then branch"
|
||||
(let ((result (narrow-type "any" "string?")))
|
||||
(assert-equal "string" (first result))
|
||||
;; else branch — can't narrow any
|
||||
(assert-equal "any" (nth result 1))))
|
||||
|
||||
(deftest "nil? on nil type narrows to never in else"
|
||||
(let ((result (narrow-type "nil" "nil?")))
|
||||
(assert-equal "nil" (first result))
|
||||
(assert-equal "never" (nth result 1)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Type inference
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "infer-literals"
|
||||
(deftest "number literal"
|
||||
(assert-equal "number" (infer-type 42 (dict) (test-prim-types))))
|
||||
|
||||
(deftest "string literal"
|
||||
(assert-equal "string" (infer-type "hello" (dict) (test-prim-types))))
|
||||
|
||||
(deftest "boolean literal"
|
||||
(assert-equal "boolean" (infer-type true (dict) (test-prim-types))))
|
||||
|
||||
(deftest "nil"
|
||||
(assert-equal "nil" (infer-type nil (dict) (test-prim-types)))))
|
||||
|
||||
|
||||
(defsuite "infer-calls"
|
||||
(deftest "known primitive return type"
|
||||
;; (+ 1 2) → number
|
||||
(let ((expr (sx-parse "(+ 1 2)")))
|
||||
(assert-equal "number"
|
||||
(infer-type (first expr) (dict) (test-prim-types)))))
|
||||
|
||||
(deftest "str returns string"
|
||||
(let ((expr (sx-parse "(str 1 2)")))
|
||||
(assert-equal "string"
|
||||
(infer-type (first expr) (dict) (test-prim-types)))))
|
||||
|
||||
(deftest "comparison returns boolean"
|
||||
(let ((expr (sx-parse "(= 1 2)")))
|
||||
(assert-equal "boolean"
|
||||
(infer-type (first expr) (dict) (test-prim-types)))))
|
||||
|
||||
(deftest "component call returns element"
|
||||
(let ((expr (sx-parse "(~card :title \"hi\")")))
|
||||
(assert-equal "element"
|
||||
(infer-type (first expr) (dict) (test-prim-types)))))
|
||||
|
||||
(deftest "unknown function returns any"
|
||||
(let ((expr (sx-parse "(unknown-fn 1 2)")))
|
||||
(assert-equal "any"
|
||||
(infer-type (first expr) (dict) (test-prim-types))))))
|
||||
|
||||
|
||||
(defsuite "infer-special-forms"
|
||||
(deftest "if produces union of branches"
|
||||
(let ((expr (sx-parse "(if true 42 \"hello\")")))
|
||||
(let ((t (infer-type (first expr) (dict) (test-prim-types))))
|
||||
;; number | string — should be a union
|
||||
(assert-true (or (= t (list "or" "number" "string"))
|
||||
(= t "any"))))))
|
||||
|
||||
(deftest "if with no else includes nil"
|
||||
(let ((expr (sx-parse "(if true 42)")))
|
||||
(let ((t (infer-type (first expr) (dict) (test-prim-types))))
|
||||
(assert-equal "number?" t))))
|
||||
|
||||
(deftest "when includes nil"
|
||||
(let ((expr (sx-parse "(when true 42)")))
|
||||
(let ((t (infer-type (first expr) (dict) (test-prim-types))))
|
||||
(assert-equal "number?" t))))
|
||||
|
||||
(deftest "do returns last type"
|
||||
(let ((expr (sx-parse "(do 1 2 \"hello\")")))
|
||||
(assert-equal "string"
|
||||
(infer-type (first expr) (dict) (test-prim-types)))))
|
||||
|
||||
(deftest "let infers binding types"
|
||||
(let ((expr (sx-parse "(let ((x 42)) x)")))
|
||||
(assert-equal "number"
|
||||
(infer-type (first expr) (dict) (test-prim-types)))))
|
||||
|
||||
(deftest "lambda returns lambda"
|
||||
(let ((expr (sx-parse "(fn (x) (+ x 1))")))
|
||||
(assert-equal "lambda"
|
||||
(infer-type (first expr) (dict) (test-prim-types))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Component call checking
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "check-component-calls"
|
||||
(deftest "type mismatch produces error"
|
||||
;; Create a component with typed params, then check a bad call
|
||||
(let ((env (test-env)))
|
||||
;; Define a typed component
|
||||
(do
|
||||
(define dummy-env env)
|
||||
(defcomp ~typed-card (&key title price) (div title price))
|
||||
(component-set-param-types! ~typed-card
|
||||
{:title "string" :price "number"}))
|
||||
;; Check a call with wrong type
|
||||
(let ((diagnostics
|
||||
(check-component-call "~typed-card" ~typed-card
|
||||
(rest (first (sx-parse "(~typed-card :title 42 :price \"bad\")")))
|
||||
(dict) (test-prim-types))))
|
||||
(assert-true (> (len diagnostics) 0))
|
||||
(assert-equal "error" (dict-get (first diagnostics) "level")))))
|
||||
|
||||
(deftest "correct call produces no errors"
|
||||
(let ((env (test-env)))
|
||||
(do
|
||||
(define dummy-env env)
|
||||
(defcomp ~ok-card (&key title price) (div title price))
|
||||
(component-set-param-types! ~ok-card
|
||||
{:title "string" :price "number"}))
|
||||
(let ((diagnostics
|
||||
(check-component-call "~ok-card" ~ok-card
|
||||
(rest (first (sx-parse "(~ok-card :title \"hi\" :price 42)")))
|
||||
(dict) (test-prim-types))))
|
||||
(assert-equal 0 (len diagnostics)))))
|
||||
|
||||
(deftest "unknown kwarg produces warning"
|
||||
(let ((env (test-env)))
|
||||
(do
|
||||
(define dummy-env env)
|
||||
(defcomp ~warn-card (&key title) (div title))
|
||||
(component-set-param-types! ~warn-card
|
||||
{:title "string"}))
|
||||
(let ((diagnostics
|
||||
(check-component-call "~warn-card" ~warn-card
|
||||
(rest (first (sx-parse "(~warn-card :title \"hi\" :colour \"red\")")))
|
||||
(dict) (test-prim-types))))
|
||||
(assert-true (> (len diagnostics) 0))
|
||||
(assert-equal "warning" (dict-get (first diagnostics) "level"))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Annotation syntax: (name :as type) in defcomp params
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "typed-defcomp"
|
||||
(deftest "typed params are parsed and stored"
|
||||
(let ((env (test-env)))
|
||||
(defcomp ~typed-widget (&key (title :as string) (count :as number)) (div title count))
|
||||
(let ((pt (component-param-types ~typed-widget)))
|
||||
(assert-true (not (nil? pt)))
|
||||
(assert-equal "string" (dict-get pt "title"))
|
||||
(assert-equal "number" (dict-get pt "count")))))
|
||||
|
||||
(deftest "mixed typed and untyped params"
|
||||
(let ((env (test-env)))
|
||||
(defcomp ~mixed-widget (&key (title :as string) subtitle) (div title subtitle))
|
||||
(let ((pt (component-param-types ~mixed-widget)))
|
||||
(assert-true (not (nil? pt)))
|
||||
(assert-equal "string" (dict-get pt "title"))
|
||||
;; subtitle has no annotation — should not be in param-types
|
||||
(assert-false (has-key? pt "subtitle")))))
|
||||
|
||||
(deftest "untyped defcomp has nil param-types"
|
||||
(let ((env (test-env)))
|
||||
(defcomp ~plain-widget (&key title subtitle) (div title subtitle))
|
||||
(assert-true (nil? (component-param-types ~plain-widget)))))
|
||||
|
||||
(deftest "typed component catches type error on call"
|
||||
(let ((env (test-env)))
|
||||
(defcomp ~strict-card (&key (title :as string) (price :as number)) (div title price))
|
||||
;; Call with wrong types
|
||||
(let ((diagnostics
|
||||
(check-component-call "~strict-card" ~strict-card
|
||||
(rest (first (sx-parse "(~strict-card :title 42 :price \"bad\")")))
|
||||
(dict) (test-prim-types))))
|
||||
;; Should have errors for both wrong-type args
|
||||
(assert-true (>= (len diagnostics) 1))
|
||||
(assert-equal "error" (dict-get (first diagnostics) "level")))))
|
||||
|
||||
(deftest "typed component passes correct call"
|
||||
(let ((env (test-env)))
|
||||
(defcomp ~ok-widget (&key (name :as string) (age :as number)) (div name age))
|
||||
(let ((diagnostics
|
||||
(check-component-call "~ok-widget" ~ok-widget
|
||||
(rest (first (sx-parse "(~ok-widget :name \"Alice\" :age 30)")))
|
||||
(dict) (test-prim-types))))
|
||||
(assert-equal 0 (len diagnostics)))))
|
||||
|
||||
(deftest "nullable type accepts nil"
|
||||
(let ((env (test-env)))
|
||||
(defcomp ~nullable-widget (&key (title :as string) (subtitle :as string?)) (div title subtitle))
|
||||
;; Passing nil for nullable param should be fine
|
||||
(let ((diagnostics
|
||||
(check-component-call "~nullable-widget" ~nullable-widget
|
||||
(rest (first (sx-parse "(~nullable-widget :title \"hi\" :subtitle nil)")))
|
||||
(dict) (test-prim-types))))
|
||||
(assert-equal 0 (len diagnostics))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; Primitive call checking (Phase 5)
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "check-primitive-calls"
|
||||
(deftest "correct types produce no errors"
|
||||
(let ((ppt (test-prim-param-types)))
|
||||
(let ((diagnostics
|
||||
(check-primitive-call "+" (rest (first (sx-parse "(+ 1 2 3)")))
|
||||
(dict) (test-prim-types) ppt nil)))
|
||||
(assert-equal 0 (len diagnostics)))))
|
||||
|
||||
(deftest "string arg to numeric primitive produces error"
|
||||
(let ((ppt (test-prim-param-types)))
|
||||
(let ((diagnostics
|
||||
(check-primitive-call "+" (rest (first (sx-parse "(+ 1 \"hello\")")))
|
||||
(dict) (test-prim-types) ppt nil)))
|
||||
(assert-true (> (len diagnostics) 0))
|
||||
(assert-equal "error" (get (first diagnostics) "level")))))
|
||||
|
||||
(deftest "number arg to string primitive produces error"
|
||||
(let ((ppt (test-prim-param-types)))
|
||||
(let ((diagnostics
|
||||
(check-primitive-call "upper" (rest (first (sx-parse "(upper 42)")))
|
||||
(dict) (test-prim-types) ppt nil)))
|
||||
(assert-true (> (len diagnostics) 0))
|
||||
(assert-equal "error" (get (first diagnostics) "level")))))
|
||||
|
||||
(deftest "positional and rest params both checked"
|
||||
;; (- "bad" 1) — first positional arg is string, expects number
|
||||
(let ((ppt (test-prim-param-types)))
|
||||
(let ((diagnostics
|
||||
(check-primitive-call "-" (rest (first (sx-parse "(- \"bad\" 1)")))
|
||||
(dict) (test-prim-types) ppt nil)))
|
||||
(assert-true (> (len diagnostics) 0)))))
|
||||
|
||||
(deftest "dict arg to keys is valid"
|
||||
(let ((ppt (test-prim-param-types)))
|
||||
(let ((diagnostics
|
||||
(check-primitive-call "keys" (rest (first (sx-parse "(keys {:a 1})")))
|
||||
(dict) (test-prim-types) ppt nil)))
|
||||
(assert-equal 0 (len diagnostics)))))
|
||||
|
||||
(deftest "number arg to keys produces error"
|
||||
(let ((ppt (test-prim-param-types)))
|
||||
(let ((diagnostics
|
||||
(check-primitive-call "keys" (rest (first (sx-parse "(keys 42)")))
|
||||
(dict) (test-prim-types) ppt nil)))
|
||||
(assert-true (> (len diagnostics) 0)))))
|
||||
|
||||
(deftest "variable with known type passes check"
|
||||
;; Variable n is known to be number in type-env
|
||||
(let ((ppt (test-prim-param-types))
|
||||
(tenv {"n" "number"}))
|
||||
(let ((diagnostics
|
||||
(check-primitive-call "inc" (rest (first (sx-parse "(inc n)")))
|
||||
tenv (test-prim-types) ppt nil)))
|
||||
(assert-equal 0 (len diagnostics)))))
|
||||
|
||||
(deftest "variable with wrong type fails check"
|
||||
;; Variable s is known to be string in type-env
|
||||
(let ((ppt (test-prim-param-types))
|
||||
(tenv {"s" "string"}))
|
||||
(let ((diagnostics
|
||||
(check-primitive-call "inc" (rest (first (sx-parse "(inc s)")))
|
||||
tenv (test-prim-types) ppt nil)))
|
||||
(assert-true (> (len diagnostics) 0)))))
|
||||
|
||||
(deftest "any-typed variable skips check"
|
||||
;; Variable x has type any — should not produce errors
|
||||
(let ((ppt (test-prim-param-types))
|
||||
(tenv {"x" "any"}))
|
||||
(let ((diagnostics
|
||||
(check-primitive-call "upper" (rest (first (sx-parse "(upper x)")))
|
||||
tenv (test-prim-types) ppt nil)))
|
||||
(assert-equal 0 (len diagnostics)))))
|
||||
|
||||
(deftest "body-walk catches primitive errors in component"
|
||||
;; Manually build a component and check it via check-body-walk directly
|
||||
(let ((ppt (test-prim-param-types))
|
||||
(body (first (sx-parse "(div (+ name 1))")))
|
||||
(type-env {"name" "string"})
|
||||
(diagnostics (list)))
|
||||
(check-body-walk body "~bad-math" type-env (test-prim-types) ppt (test-env) diagnostics nil nil)
|
||||
(assert-true (> (len diagnostics) 0))
|
||||
(assert-equal "error" (get (first diagnostics) "level")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; deftype — type aliases
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "deftype-alias"
|
||||
(deftest "simple alias resolves"
|
||||
(let ((registry {"price" {:name "price" :params () :body "number"}}))
|
||||
(assert-equal "number" (resolve-type "price" registry))))
|
||||
|
||||
(deftest "alias chain resolves"
|
||||
(let ((registry {"price" {:name "price" :params () :body "number"}
|
||||
"cost" {:name "cost" :params () :body "price"}}))
|
||||
(assert-equal "number" (resolve-type "cost" registry))))
|
||||
|
||||
(deftest "unknown type passes through"
|
||||
(let ((registry {"price" {:name "price" :params () :body "number"}}))
|
||||
(assert-equal "string" (resolve-type "string" registry))))
|
||||
|
||||
(deftest "subtype-resolved? works through alias"
|
||||
(let ((registry {"price" {:name "price" :params () :body "number"}}))
|
||||
(assert-true (subtype-resolved? "price" "number" registry))
|
||||
(assert-true (subtype-resolved? "number" "price" registry)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; deftype — union types
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "deftype-union"
|
||||
(deftest "union resolves"
|
||||
(let ((registry {"status" {:name "status" :params () :body ("or" "string" "number")}}))
|
||||
(let ((resolved (resolve-type "status" registry)))
|
||||
(assert-true (= (type-of resolved) "list"))
|
||||
(assert-equal "or" (first resolved)))))
|
||||
|
||||
(deftest "subtype through named union"
|
||||
(let ((registry {"status" {:name "status" :params () :body ("or" "string" "number")}}))
|
||||
(assert-true (subtype-resolved? "string" "status" registry))
|
||||
(assert-true (subtype-resolved? "number" "status" registry))
|
||||
(assert-false (subtype-resolved? "boolean" "status" registry)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; deftype — record types
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "deftype-record"
|
||||
(deftest "record resolves to dict"
|
||||
(let ((registry {"card-props" {:name "card-props" :params ()
|
||||
:body {"title" "string" "price" "number"}}}))
|
||||
(let ((resolved (resolve-type "card-props" registry)))
|
||||
(assert-equal "dict" (type-of resolved))
|
||||
(assert-equal "string" (get resolved "title"))
|
||||
(assert-equal "number" (get resolved "price")))))
|
||||
|
||||
(deftest "record structural subtyping"
|
||||
(let ((registry {"card-props" {:name "card-props" :params ()
|
||||
:body {"title" "string" "price" "number"}}
|
||||
"titled" {:name "titled" :params ()
|
||||
:body {"title" "string"}}}))
|
||||
;; card-props has title+price, titled has just title
|
||||
;; card-props <: titled (has all required fields)
|
||||
(assert-true (subtype-resolved? "card-props" "titled" registry))))
|
||||
|
||||
(deftest "get infers field type from record"
|
||||
(let ((registry {"card-props" {:name "card-props" :params ()
|
||||
:body {"title" "string" "price" "number"}}})
|
||||
(type-env {"d" "card-props"})
|
||||
(expr (first (sx-parse "(get d :title)"))))
|
||||
(assert-equal "string"
|
||||
(infer-type expr type-env (test-prim-types) registry)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; deftype — parameterized types
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "deftype-parameterized"
|
||||
(deftest "maybe instantiation"
|
||||
(let ((registry {"maybe" {:name "maybe" :params ("a")
|
||||
:body ("or" "a" "nil")}}))
|
||||
(let ((resolved (resolve-type (list "maybe" "string") registry)))
|
||||
(assert-true (= (type-of resolved) "list"))
|
||||
(assert-equal "or" (first resolved))
|
||||
(assert-true (contains? resolved "string"))
|
||||
(assert-true (contains? resolved "nil")))))
|
||||
|
||||
(deftest "subtype through parameterized type"
|
||||
(let ((registry {"maybe" {:name "maybe" :params ("a")
|
||||
:body ("or" "a" "nil")}}))
|
||||
(assert-true (subtype-resolved? "string" (list "maybe" "string") registry))
|
||||
(assert-true (subtype-resolved? "nil" (list "maybe" "string") registry))
|
||||
(assert-false (subtype-resolved? "number" (list "maybe" "string") registry))))
|
||||
|
||||
(deftest "substitute-type-vars works"
|
||||
(let ((result (substitute-type-vars ("or" "a" "nil") (list "a") (list "number"))))
|
||||
(assert-equal "or" (first result))
|
||||
(assert-true (contains? result "number"))
|
||||
(assert-true (contains? result "nil")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; defeffect — effect basics
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "defeffect-basics"
|
||||
(deftest "get-effects returns nil for unannotated"
|
||||
(let ((anns {"fetch" ("io")}))
|
||||
(assert-true (nil? (get-effects "unknown" anns)))))
|
||||
|
||||
(deftest "get-effects returns effects for annotated"
|
||||
(let ((anns {"fetch" ("io")}))
|
||||
(assert-equal (list "io") (get-effects "fetch" anns))))
|
||||
|
||||
(deftest "nil annotations returns nil"
|
||||
(assert-true (nil? (get-effects "anything" nil)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; defeffect — effect checking
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "effect-checking"
|
||||
(deftest "pure cannot call io"
|
||||
(let ((anns {"~pure-comp" () "fetch" ("io")}))
|
||||
(let ((diagnostics (check-effect-call "fetch" (list) anns "~pure-comp")))
|
||||
(assert-true (> (len diagnostics) 0))
|
||||
(assert-equal "error" (get (first diagnostics) "level")))))
|
||||
|
||||
(deftest "io context allows io"
|
||||
(let ((anns {"~io-comp" ("io") "fetch" ("io")}))
|
||||
(let ((diagnostics (check-effect-call "fetch" (list "io") anns "~io-comp")))
|
||||
(assert-equal 0 (len diagnostics)))))
|
||||
|
||||
(deftest "unannotated caller allows everything"
|
||||
(let ((anns {"fetch" ("io")}))
|
||||
(let ((diagnostics (check-effect-call "fetch" nil anns "~unknown")))
|
||||
(assert-equal 0 (len diagnostics)))))
|
||||
|
||||
(deftest "unannotated callee skips check"
|
||||
(let ((anns {"~pure-comp" ()}))
|
||||
(let ((diagnostics (check-effect-call "unknown-fn" (list) anns "~pure-comp")))
|
||||
(assert-equal 0 (len diagnostics))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; defeffect — subset checking
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "effect-subset"
|
||||
(deftest "empty is subset of anything"
|
||||
(assert-true (effects-subset? (list) (list "io")))
|
||||
(assert-true (effects-subset? (list) (list))))
|
||||
|
||||
(deftest "io is subset of io"
|
||||
(assert-true (effects-subset? (list "io") (list "io" "async"))))
|
||||
|
||||
(deftest "io is not subset of pure"
|
||||
(assert-false (effects-subset? (list "io") (list))))
|
||||
|
||||
(deftest "nil callee skips check"
|
||||
(assert-true (effects-subset? nil (list))))
|
||||
|
||||
(deftest "nil caller allows all"
|
||||
(assert-true (effects-subset? (list "io") nil))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; build-effect-annotations
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "build-effect-annotations"
|
||||
(deftest "builds annotations from io declarations"
|
||||
(let ((decls (list {"name" "fetch"} {"name" "save!"}))
|
||||
(anns (build-effect-annotations decls)))
|
||||
(assert-equal (list "io") (get anns "fetch"))
|
||||
(assert-equal (list "io") (get anns "save!"))))
|
||||
|
||||
(deftest "skips entries without name"
|
||||
(let ((decls (list {"name" "fetch"} {"other" "x"}))
|
||||
(anns (build-effect-annotations decls)))
|
||||
(assert-true (has-key? anns "fetch"))
|
||||
(assert-false (has-key? anns "other"))))
|
||||
|
||||
(deftest "empty declarations produce empty dict"
|
||||
(let ((anns (build-effect-annotations (list))))
|
||||
(assert-equal 0 (len (keys anns))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; check-component-effects
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
;; Define test components at top level so they're in the main env
|
||||
(defcomp ~eff-pure-card () :effects []
|
||||
(div (fetch "url")))
|
||||
|
||||
(defcomp ~eff-io-card () :effects [io]
|
||||
(div (fetch "url")))
|
||||
|
||||
(defcomp ~eff-unannot-card ()
|
||||
(div (fetch "url")))
|
||||
|
||||
(defsuite "check-component-effects"
|
||||
(deftest "pure component calling io produces diagnostic"
|
||||
(let ((anns {"~eff-pure-card" () "fetch" ("io")})
|
||||
(diagnostics (check-component-effects "~eff-pure-card" (test-env) anns)))
|
||||
(assert-true (> (len diagnostics) 0))))
|
||||
|
||||
(deftest "io component calling io produces no diagnostic"
|
||||
(let ((anns {"~eff-io-card" ("io") "fetch" ("io")})
|
||||
(diagnostics (check-component-effects "~eff-io-card" (test-env) anns)))
|
||||
(assert-equal 0 (len diagnostics))))
|
||||
|
||||
(deftest "unannotated component skips check"
|
||||
(let ((anns {"fetch" ("io")})
|
||||
(diagnostics (check-component-effects "~eff-unannot-card" (test-env) anns)))
|
||||
(assert-equal 0 (len diagnostics)))))
|
||||
602
spec/tests/test.sx
Normal file
602
spec/tests/test.sx
Normal file
@@ -0,0 +1,602 @@
|
||||
;; ==========================================================================
|
||||
;; test.sx — Self-hosting SX test suite (backward-compatible entry point)
|
||||
;;
|
||||
;; This file includes the test framework and core eval tests inline.
|
||||
;; It exists for backward compatibility — runners that load "test.sx"
|
||||
;; get the same 81 tests as before.
|
||||
;;
|
||||
;; For modular testing, runners should instead load:
|
||||
;; 1. test-framework.sx (macros + assertions)
|
||||
;; 2. One or more test specs: test-eval.sx, test-parser.sx,
|
||||
;; test-router.sx, test-render.sx, etc.
|
||||
;;
|
||||
;; Platform functions required:
|
||||
;; try-call (thunk) -> {:ok true} | {:ok false :error "msg"}
|
||||
;; report-pass (name) -> platform-specific pass output
|
||||
;; report-fail (name error) -> platform-specific fail output
|
||||
;; push-suite (name) -> push suite name onto context stack
|
||||
;; pop-suite () -> pop suite name from context stack
|
||||
;;
|
||||
;; Usage:
|
||||
;; ;; Host injects platform functions into env, then:
|
||||
;; (eval-file "test.sx" env)
|
||||
;;
|
||||
;; The same test.sx runs on every host — Python, JavaScript, etc.
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 1. Test framework macros
|
||||
;; --------------------------------------------------------------------------
|
||||
;;
|
||||
;; deftest and defsuite are macros that make test.sx directly executable.
|
||||
;; The host provides try-call (error catching), reporting, and suite
|
||||
;; context — everything else is pure SX.
|
||||
|
||||
(defmacro deftest (name &rest body)
|
||||
`(let ((result (try-call (fn () ,@body))))
|
||||
(if (get result "ok")
|
||||
(report-pass ,name)
|
||||
(report-fail ,name (get result "error")))))
|
||||
|
||||
(defmacro defsuite (name &rest items)
|
||||
`(do (push-suite ,name)
|
||||
,@items
|
||||
(pop-suite)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 2. Assertion helpers — defined in SX, available in test bodies
|
||||
;; --------------------------------------------------------------------------
|
||||
;;
|
||||
;; These are regular functions (not special forms). They use the `assert`
|
||||
;; primitive underneath but provide better error messages.
|
||||
|
||||
(define assert-equal
|
||||
(fn (expected actual)
|
||||
(assert (equal? expected actual)
|
||||
(str "Expected " (str expected) " but got " (str actual)))))
|
||||
|
||||
(define assert-not-equal
|
||||
(fn (a b)
|
||||
(assert (not (equal? a b))
|
||||
(str "Expected values to differ but both are " (str a)))))
|
||||
|
||||
(define assert-true
|
||||
(fn (val)
|
||||
(assert val (str "Expected truthy but got " (str val)))))
|
||||
|
||||
(define assert-false
|
||||
(fn (val)
|
||||
(assert (not val) (str "Expected falsy but got " (str val)))))
|
||||
|
||||
(define assert-nil
|
||||
(fn (val)
|
||||
(assert (nil? val) (str "Expected nil but got " (str val)))))
|
||||
|
||||
(define assert-type
|
||||
(fn (expected-type val)
|
||||
;; Implemented via predicate dispatch since type-of is a platform
|
||||
;; function not available in all hosts. Uses nested if to avoid
|
||||
;; Scheme-style cond detection for 2-element predicate calls.
|
||||
;; Boolean checked before number (subtypes on some platforms).
|
||||
(let ((actual-type
|
||||
(if (nil? val) "nil"
|
||||
(if (boolean? val) "boolean"
|
||||
(if (number? val) "number"
|
||||
(if (string? val) "string"
|
||||
(if (list? val) "list"
|
||||
(if (dict? val) "dict"
|
||||
"unknown"))))))))
|
||||
(assert (= expected-type actual-type)
|
||||
(str "Expected type " expected-type " but got " actual-type)))))
|
||||
|
||||
(define assert-length
|
||||
(fn (expected-len col)
|
||||
(assert (= (len col) expected-len)
|
||||
(str "Expected length " expected-len " but got " (len col)))))
|
||||
|
||||
(define assert-contains
|
||||
(fn (item col)
|
||||
(assert (some (fn (x) (equal? x item)) col)
|
||||
(str "Expected collection to contain " (str item)))))
|
||||
|
||||
(define assert-throws
|
||||
(fn (thunk)
|
||||
(let ((result (try-call thunk)))
|
||||
(assert (not (get result "ok"))
|
||||
"Expected an error to be thrown but none was"))))
|
||||
|
||||
|
||||
;; ==========================================================================
|
||||
;; 3. Test suites — SX testing SX
|
||||
;; ==========================================================================
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3a. Literals and types
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "literals"
|
||||
(deftest "numbers are numbers"
|
||||
(assert-type "number" 42)
|
||||
(assert-type "number" 3.14)
|
||||
(assert-type "number" -1))
|
||||
|
||||
(deftest "strings are strings"
|
||||
(assert-type "string" "hello")
|
||||
(assert-type "string" ""))
|
||||
|
||||
(deftest "booleans are booleans"
|
||||
(assert-type "boolean" true)
|
||||
(assert-type "boolean" false))
|
||||
|
||||
(deftest "nil is nil"
|
||||
(assert-type "nil" nil)
|
||||
(assert-nil nil))
|
||||
|
||||
(deftest "lists are lists"
|
||||
(assert-type "list" (list 1 2 3))
|
||||
(assert-type "list" (list)))
|
||||
|
||||
(deftest "dicts are dicts"
|
||||
(assert-type "dict" {:a 1 :b 2})))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3b. Arithmetic
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "arithmetic"
|
||||
(deftest "addition"
|
||||
(assert-equal 3 (+ 1 2))
|
||||
(assert-equal 0 (+ 0 0))
|
||||
(assert-equal -1 (+ 1 -2))
|
||||
(assert-equal 10 (+ 1 2 3 4)))
|
||||
|
||||
(deftest "subtraction"
|
||||
(assert-equal 1 (- 3 2))
|
||||
(assert-equal -1 (- 2 3)))
|
||||
|
||||
(deftest "multiplication"
|
||||
(assert-equal 6 (* 2 3))
|
||||
(assert-equal 0 (* 0 100))
|
||||
(assert-equal 24 (* 1 2 3 4)))
|
||||
|
||||
(deftest "division"
|
||||
(assert-equal 2 (/ 6 3))
|
||||
(assert-equal 2.5 (/ 5 2)))
|
||||
|
||||
(deftest "modulo"
|
||||
(assert-equal 1 (mod 7 3))
|
||||
(assert-equal 0 (mod 6 3))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3c. Comparison
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "comparison"
|
||||
(deftest "equality"
|
||||
(assert-true (= 1 1))
|
||||
(assert-false (= 1 2))
|
||||
(assert-true (= "a" "a"))
|
||||
(assert-false (= "a" "b")))
|
||||
|
||||
(deftest "deep equality"
|
||||
(assert-true (equal? (list 1 2 3) (list 1 2 3)))
|
||||
(assert-false (equal? (list 1 2) (list 1 3)))
|
||||
(assert-true (equal? {:a 1} {:a 1}))
|
||||
(assert-false (equal? {:a 1} {:a 2})))
|
||||
|
||||
(deftest "ordering"
|
||||
(assert-true (< 1 2))
|
||||
(assert-false (< 2 1))
|
||||
(assert-true (> 2 1))
|
||||
(assert-true (<= 1 1))
|
||||
(assert-true (<= 1 2))
|
||||
(assert-true (>= 2 2))
|
||||
(assert-true (>= 3 2))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3d. String operations
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "strings"
|
||||
(deftest "str concatenation"
|
||||
(assert-equal "abc" (str "a" "b" "c"))
|
||||
(assert-equal "hello world" (str "hello" " " "world"))
|
||||
(assert-equal "42" (str 42))
|
||||
(assert-equal "" (str)))
|
||||
|
||||
(deftest "string-length"
|
||||
(assert-equal 5 (string-length "hello"))
|
||||
(assert-equal 0 (string-length "")))
|
||||
|
||||
(deftest "substring"
|
||||
(assert-equal "ell" (substring "hello" 1 4))
|
||||
(assert-equal "hello" (substring "hello" 0 5)))
|
||||
|
||||
(deftest "string-contains?"
|
||||
(assert-true (string-contains? "hello world" "world"))
|
||||
(assert-false (string-contains? "hello" "xyz")))
|
||||
|
||||
(deftest "upcase and downcase"
|
||||
(assert-equal "HELLO" (upcase "hello"))
|
||||
(assert-equal "hello" (downcase "HELLO")))
|
||||
|
||||
(deftest "trim"
|
||||
(assert-equal "hello" (trim " hello "))
|
||||
(assert-equal "hello" (trim "hello")))
|
||||
|
||||
(deftest "split and join"
|
||||
(assert-equal (list "a" "b" "c") (split "a,b,c" ","))
|
||||
(assert-equal "a-b-c" (join "-" (list "a" "b" "c")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3e. List operations
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "lists"
|
||||
(deftest "constructors"
|
||||
(assert-equal (list 1 2 3) (list 1 2 3))
|
||||
(assert-equal (list) (list))
|
||||
(assert-length 3 (list 1 2 3)))
|
||||
|
||||
(deftest "first and rest"
|
||||
(assert-equal 1 (first (list 1 2 3)))
|
||||
(assert-equal (list 2 3) (rest (list 1 2 3)))
|
||||
(assert-nil (first (list)))
|
||||
(assert-equal (list) (rest (list))))
|
||||
|
||||
(deftest "nth"
|
||||
(assert-equal 1 (nth (list 1 2 3) 0))
|
||||
(assert-equal 2 (nth (list 1 2 3) 1))
|
||||
(assert-equal 3 (nth (list 1 2 3) 2)))
|
||||
|
||||
(deftest "last"
|
||||
(assert-equal 3 (last (list 1 2 3)))
|
||||
(assert-nil (last (list))))
|
||||
|
||||
(deftest "cons and append"
|
||||
(assert-equal (list 0 1 2) (cons 0 (list 1 2)))
|
||||
(assert-equal (list 1 2 3 4) (append (list 1 2) (list 3 4))))
|
||||
|
||||
(deftest "reverse"
|
||||
(assert-equal (list 3 2 1) (reverse (list 1 2 3)))
|
||||
(assert-equal (list) (reverse (list))))
|
||||
|
||||
(deftest "empty?"
|
||||
(assert-true (empty? (list)))
|
||||
(assert-false (empty? (list 1))))
|
||||
|
||||
(deftest "len"
|
||||
(assert-equal 0 (len (list)))
|
||||
(assert-equal 3 (len (list 1 2 3))))
|
||||
|
||||
(deftest "contains?"
|
||||
(assert-true (contains? (list 1 2 3) 2))
|
||||
(assert-false (contains? (list 1 2 3) 4)))
|
||||
|
||||
(deftest "flatten"
|
||||
(assert-equal (list 1 2 3 4) (flatten (list (list 1 2) (list 3 4))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3f. Dict operations
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "dicts"
|
||||
(deftest "dict literal"
|
||||
(assert-type "dict" {:a 1 :b 2})
|
||||
(assert-equal 1 (get {:a 1} "a"))
|
||||
(assert-equal 2 (get {:a 1 :b 2} "b")))
|
||||
|
||||
(deftest "assoc"
|
||||
(assert-equal {:a 1 :b 2} (assoc {:a 1} "b" 2))
|
||||
(assert-equal {:a 99} (assoc {:a 1} "a" 99)))
|
||||
|
||||
(deftest "dissoc"
|
||||
(assert-equal {:b 2} (dissoc {:a 1 :b 2} "a")))
|
||||
|
||||
(deftest "keys and vals"
|
||||
(let ((d {:a 1 :b 2}))
|
||||
(assert-length 2 (keys d))
|
||||
(assert-length 2 (vals d))
|
||||
(assert-contains "a" (keys d))
|
||||
(assert-contains "b" (keys d))))
|
||||
|
||||
(deftest "has-key?"
|
||||
(assert-true (has-key? {:a 1} "a"))
|
||||
(assert-false (has-key? {:a 1} "b")))
|
||||
|
||||
(deftest "merge"
|
||||
(assert-equal {:a 1 :b 2 :c 3}
|
||||
(merge {:a 1 :b 2} {:c 3}))
|
||||
(assert-equal {:a 99 :b 2}
|
||||
(merge {:a 1 :b 2} {:a 99}))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3g. Predicates
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "predicates"
|
||||
(deftest "nil?"
|
||||
(assert-true (nil? nil))
|
||||
(assert-false (nil? 0))
|
||||
(assert-false (nil? false))
|
||||
(assert-false (nil? "")))
|
||||
|
||||
(deftest "number?"
|
||||
(assert-true (number? 42))
|
||||
(assert-true (number? 3.14))
|
||||
(assert-false (number? "42")))
|
||||
|
||||
(deftest "string?"
|
||||
(assert-true (string? "hello"))
|
||||
(assert-false (string? 42)))
|
||||
|
||||
(deftest "list?"
|
||||
(assert-true (list? (list 1 2)))
|
||||
(assert-false (list? "not a list")))
|
||||
|
||||
(deftest "dict?"
|
||||
(assert-true (dict? {:a 1}))
|
||||
(assert-false (dict? (list 1))))
|
||||
|
||||
(deftest "boolean?"
|
||||
(assert-true (boolean? true))
|
||||
(assert-true (boolean? false))
|
||||
(assert-false (boolean? nil))
|
||||
(assert-false (boolean? 0)))
|
||||
|
||||
(deftest "not"
|
||||
(assert-true (not false))
|
||||
(assert-true (not nil))
|
||||
(assert-false (not true))
|
||||
(assert-false (not 1))
|
||||
(assert-false (not "x"))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3h. Special forms
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "special-forms"
|
||||
(deftest "if"
|
||||
(assert-equal "yes" (if true "yes" "no"))
|
||||
(assert-equal "no" (if false "yes" "no"))
|
||||
(assert-equal "no" (if nil "yes" "no"))
|
||||
(assert-nil (if false "yes")))
|
||||
|
||||
(deftest "when"
|
||||
(assert-equal "yes" (when true "yes"))
|
||||
(assert-nil (when false "yes")))
|
||||
|
||||
(deftest "cond"
|
||||
(assert-equal "a" (cond true "a" :else "b"))
|
||||
(assert-equal "b" (cond false "a" :else "b"))
|
||||
(assert-equal "c" (cond
|
||||
false "a"
|
||||
false "b"
|
||||
:else "c")))
|
||||
|
||||
(deftest "and"
|
||||
(assert-true (and true true))
|
||||
(assert-false (and true false))
|
||||
(assert-false (and false true))
|
||||
(assert-equal 3 (and 1 2 3)))
|
||||
|
||||
(deftest "or"
|
||||
(assert-equal 1 (or 1 2))
|
||||
(assert-equal 2 (or false 2))
|
||||
(assert-equal "fallback" (or nil false "fallback"))
|
||||
(assert-false (or false false)))
|
||||
|
||||
(deftest "let"
|
||||
(assert-equal 3 (let ((x 1) (y 2)) (+ x y)))
|
||||
(assert-equal "hello world"
|
||||
(let ((a "hello") (b " world")) (str a b))))
|
||||
|
||||
(deftest "let clojure-style"
|
||||
(assert-equal 3 (let (x 1 y 2) (+ x y))))
|
||||
|
||||
(deftest "do / begin"
|
||||
(assert-equal 3 (do 1 2 3))
|
||||
(assert-equal "last" (begin "first" "middle" "last")))
|
||||
|
||||
(deftest "define"
|
||||
(define x 42)
|
||||
(assert-equal 42 x))
|
||||
|
||||
(deftest "set!"
|
||||
(define x 1)
|
||||
(set! x 2)
|
||||
(assert-equal 2 x)))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3i. Lambda and closures
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "lambdas"
|
||||
(deftest "basic lambda"
|
||||
(let ((add (fn (a b) (+ a b))))
|
||||
(assert-equal 3 (add 1 2))))
|
||||
|
||||
(deftest "closure captures env"
|
||||
(let ((x 10))
|
||||
(let ((add-x (fn (y) (+ x y))))
|
||||
(assert-equal 15 (add-x 5)))))
|
||||
|
||||
(deftest "lambda as argument"
|
||||
(assert-equal (list 2 4 6)
|
||||
(map (fn (x) (* x 2)) (list 1 2 3))))
|
||||
|
||||
(deftest "recursive lambda via define"
|
||||
(define factorial
|
||||
(fn (n) (if (<= n 1) 1 (* n (factorial (- n 1))))))
|
||||
(assert-equal 120 (factorial 5)))
|
||||
|
||||
(deftest "higher-order returns lambda"
|
||||
(let ((make-adder (fn (n) (fn (x) (+ n x)))))
|
||||
(let ((add5 (make-adder 5)))
|
||||
(assert-equal 8 (add5 3))))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3j. Higher-order forms
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "higher-order"
|
||||
(deftest "map"
|
||||
(assert-equal (list 2 4 6)
|
||||
(map (fn (x) (* x 2)) (list 1 2 3)))
|
||||
(assert-equal (list) (map (fn (x) x) (list))))
|
||||
|
||||
(deftest "filter"
|
||||
(assert-equal (list 2 4)
|
||||
(filter (fn (x) (= (mod x 2) 0)) (list 1 2 3 4)))
|
||||
(assert-equal (list)
|
||||
(filter (fn (x) false) (list 1 2 3))))
|
||||
|
||||
(deftest "reduce"
|
||||
(assert-equal 10 (reduce (fn (acc x) (+ acc x)) 0 (list 1 2 3 4)))
|
||||
(assert-equal 0 (reduce (fn (acc x) (+ acc x)) 0 (list))))
|
||||
|
||||
(deftest "some"
|
||||
(assert-true (some (fn (x) (> x 3)) (list 1 2 3 4 5)))
|
||||
(assert-false (some (fn (x) (> x 10)) (list 1 2 3))))
|
||||
|
||||
(deftest "every?"
|
||||
(assert-true (every? (fn (x) (> x 0)) (list 1 2 3)))
|
||||
(assert-false (every? (fn (x) (> x 2)) (list 1 2 3))))
|
||||
|
||||
(deftest "map-indexed"
|
||||
(assert-equal (list "0:a" "1:b" "2:c")
|
||||
(map-indexed (fn (i x) (str i ":" x)) (list "a" "b" "c")))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3k. Components
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "components"
|
||||
(deftest "defcomp creates component"
|
||||
(defcomp ~test-comp (&key title)
|
||||
(div title))
|
||||
;; Component is bound and not nil
|
||||
(assert-true (not (nil? ~test-comp))))
|
||||
|
||||
(deftest "component renders with keyword args"
|
||||
(defcomp ~greeting (&key name)
|
||||
(span (str "Hello, " name "!")))
|
||||
(assert-true (not (nil? ~greeting))))
|
||||
|
||||
(deftest "component with children"
|
||||
(defcomp ~box (&key &rest children)
|
||||
(div :class "box" children))
|
||||
(assert-true (not (nil? ~box))))
|
||||
|
||||
(deftest "component with default via or"
|
||||
(defcomp ~label (&key text)
|
||||
(span (or text "default")))
|
||||
(assert-true (not (nil? ~label)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3l. Macros
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "macros"
|
||||
(deftest "defmacro creates macro"
|
||||
(defmacro unless (cond &rest body)
|
||||
`(if (not ,cond) (do ,@body)))
|
||||
(assert-equal "yes" (unless false "yes"))
|
||||
(assert-nil (unless true "no")))
|
||||
|
||||
(deftest "quasiquote and unquote"
|
||||
(let ((x 42))
|
||||
(assert-equal (list 1 42 3) `(1 ,x 3))))
|
||||
|
||||
(deftest "splice-unquote"
|
||||
(let ((xs (list 2 3 4)))
|
||||
(assert-equal (list 1 2 3 4 5) `(1 ,@xs 5)))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3m. Threading macro
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "threading"
|
||||
(deftest "thread-first"
|
||||
(assert-equal 8 (-> 5 (+ 1) (+ 2)))
|
||||
(assert-equal "HELLO" (-> "hello" upcase))
|
||||
(assert-equal "HELLO WORLD"
|
||||
(-> "hello"
|
||||
(str " world")
|
||||
upcase))))
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3n. Truthiness
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "truthiness"
|
||||
(deftest "truthy values"
|
||||
(assert-true (if 1 true false))
|
||||
(assert-true (if "x" true false))
|
||||
(assert-true (if (list 1) true false))
|
||||
(assert-true (if true true false)))
|
||||
|
||||
(deftest "falsy values"
|
||||
(assert-false (if false true false))
|
||||
(assert-false (if nil true false)))
|
||||
|
||||
;; NOTE: empty list, zero, and empty string truthiness is
|
||||
;; platform-dependent. Python treats all three as falsy.
|
||||
;; JavaScript treats [] as truthy but 0 and "" as falsy.
|
||||
;; These tests are omitted — each bootstrapper should emit
|
||||
;; platform-specific truthiness tests instead.
|
||||
)
|
||||
|
||||
|
||||
;; --------------------------------------------------------------------------
|
||||
;; 3o. Edge cases and regression tests
|
||||
;; --------------------------------------------------------------------------
|
||||
|
||||
(defsuite "edge-cases"
|
||||
(deftest "nested let scoping"
|
||||
(let ((x 1))
|
||||
(let ((x 2))
|
||||
(assert-equal 2 x))
|
||||
;; outer x should be unchanged by inner let
|
||||
;; (this tests that let creates a new scope)
|
||||
))
|
||||
|
||||
(deftest "recursive map"
|
||||
(assert-equal (list (list 2 4) (list 6 8))
|
||||
(map (fn (sub) (map (fn (x) (* x 2)) sub))
|
||||
(list (list 1 2) (list 3 4)))))
|
||||
|
||||
(deftest "keyword as value"
|
||||
(assert-equal "class" :class)
|
||||
(assert-equal "id" :id))
|
||||
|
||||
(deftest "dict with evaluated values"
|
||||
(let ((x 42))
|
||||
(assert-equal 42 (get {:val x} "val"))))
|
||||
|
||||
(deftest "nil propagation"
|
||||
(assert-nil (get {:a 1} "missing"))
|
||||
(assert-equal "default" (or (get {:a 1} "missing") "default")))
|
||||
|
||||
(deftest "empty operations"
|
||||
(assert-equal (list) (map (fn (x) x) (list)))
|
||||
(assert-equal (list) (filter (fn (x) true) (list)))
|
||||
(assert-equal 0 (reduce (fn (acc x) (+ acc x)) 0 (list)))
|
||||
(assert-equal 0 (len (list)))
|
||||
(assert-equal "" (str))))
|
||||
Reference in New Issue
Block a user