giles
c67adaceaf
- Fix type-union assertion: use equal? for deep list comparison - Fix check-component-effects test: define components in local env so check function can find them (test-env returns base env copy) - Fix parser test paren balance (agent-generated file had extra parens) - Add apply primitive to test harness Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
525 lines
18 KiB
Plaintext
525 lines
18 KiB
Plaintext
;; ==========================================================================
|
|
;; 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))))
|
|
|
|
(deftest "apostrophe quote expands to (quote ...)"
|
|
(let ((result (sx-parse "'x")))
|
|
(assert-length 1 result)
|
|
(let ((expr (first result)))
|
|
(assert-type "list" expr)
|
|
(assert-equal "quote" (symbol-name (first expr)))
|
|
(assert-equal "x" (symbol-name (nth expr 1))))))
|
|
|
|
(deftest "apostrophe quote on list"
|
|
(let ((result (sx-parse "'(1 2 3)")))
|
|
(assert-length 1 result)
|
|
(let ((expr (first result)))
|
|
(assert-type "list" expr)
|
|
(assert-equal "quote" (symbol-name (first expr)))
|
|
(assert-equal (list 1 2 3) (nth expr 1)))))
|
|
|
|
(deftest "quasiquote with unquote inside"
|
|
(let ((result (sx-parse "`(a ,b)")))
|
|
(assert-length 1 result)
|
|
(let ((expr (first result)))
|
|
(assert-type "list" expr)
|
|
(assert-equal "quasiquote" (symbol-name (first expr)))
|
|
(let ((inner (nth expr 1)))
|
|
(assert-type "list" inner)
|
|
(assert-equal "a" (symbol-name (first inner)))
|
|
(let ((unquoted (nth inner 1)))
|
|
(assert-type "list" unquoted)
|
|
(assert-equal "unquote" (symbol-name (first unquoted)))))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Number formats
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "parser-numbers"
|
|
(deftest "integer zero"
|
|
(assert-equal (list 0) (sx-parse "0")))
|
|
|
|
(deftest "large integer"
|
|
(assert-equal (list 1000000) (sx-parse "1000000")))
|
|
|
|
(deftest "negative float"
|
|
(assert-equal (list -2.718) (sx-parse "-2.718")))
|
|
|
|
(deftest "exponent notation"
|
|
(let ((result (sx-parse "1e10")))
|
|
(assert-length 1 result)
|
|
(assert-type "number" (first result))
|
|
(assert-equal 10000000000 (first result))))
|
|
|
|
(deftest "negative exponent"
|
|
(let ((result (sx-parse "2.5e-1")))
|
|
(assert-length 1 result)
|
|
(assert-type "number" (first result))
|
|
(assert-equal 0.25 (first result))))
|
|
|
|
(deftest "uppercase exponent E"
|
|
(let ((result (sx-parse "1E3")))
|
|
(assert-length 1 result)
|
|
(assert-type "number" (first result))
|
|
(assert-equal 1000 (first result)))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Symbol naming conventions
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "parser-symbols"
|
|
(deftest "symbol with hyphens"
|
|
(let ((result (sx-parse "my-var")))
|
|
(assert-length 1 result)
|
|
(assert-equal "my-var" (symbol-name (first result)))))
|
|
|
|
(deftest "symbol with question mark"
|
|
(let ((result (sx-parse "nil?")))
|
|
(assert-length 1 result)
|
|
(assert-equal "nil?" (symbol-name (first result)))))
|
|
|
|
(deftest "symbol with exclamation"
|
|
(let ((result (sx-parse "set!")))
|
|
(assert-length 1 result)
|
|
(assert-equal "set!" (symbol-name (first result)))))
|
|
|
|
(deftest "symbol with tilde (component)"
|
|
(let ((result (sx-parse "~my-comp")))
|
|
(assert-length 1 result)
|
|
(assert-equal "~my-comp" (symbol-name (first result)))))
|
|
|
|
(deftest "symbol with arrow"
|
|
(let ((result (sx-parse "->")))
|
|
(assert-length 1 result)
|
|
(assert-equal "->" (symbol-name (first result)))))
|
|
|
|
(deftest "symbol with &"
|
|
(let ((result (sx-parse "&key")))
|
|
(assert-length 1 result)
|
|
(assert-equal "&key" (symbol-name (first result)))))
|
|
|
|
(deftest "symbol with every? style"
|
|
(let ((result (sx-parse "every?")))
|
|
(assert-length 1 result)
|
|
(assert-equal "every?" (symbol-name (first result)))))
|
|
|
|
(deftest "ellipsis is a symbol"
|
|
(let ((result (sx-parse "...")))
|
|
(assert-length 1 result)
|
|
(assert-equal "..." (symbol-name (first result))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Serializer — extended
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "serializer-extended"
|
|
(deftest "serialize negative number"
|
|
(assert-equal "-5" (sx-serialize -5)))
|
|
|
|
(deftest "serialize float"
|
|
(assert-equal "3.14" (sx-serialize 3.14)))
|
|
|
|
(deftest "serialize string with escaped quote"
|
|
(let ((s (sx-serialize "say \"hi\"")))
|
|
(assert-true (string-contains? s "\\\""))))
|
|
|
|
(deftest "serialize dict round-trips"
|
|
;; Parse a dict literal, serialize it, parse again — values survive.
|
|
(let ((d (first (sx-parse "{:x 1 :y 2}"))))
|
|
(let ((s (sx-serialize d)))
|
|
(assert-true (string-contains? s ":x"))
|
|
(assert-true (string-contains? s ":y"))
|
|
(let ((d2 (first (sx-parse s))))
|
|
(assert-equal 1 (get d2 "x"))
|
|
(assert-equal 2 (get d2 "y"))))))
|
|
|
|
(deftest "serialize symbol with hyphens"
|
|
(assert-equal "my-fn" (sx-serialize (make-symbol "my-fn"))))
|
|
|
|
(deftest "serialize keyword with hyphens"
|
|
(assert-equal ":my-key" (sx-serialize (make-keyword "my-key"))))
|
|
|
|
(deftest "serialize deeply nested list"
|
|
(assert-equal "(1 (2 (3)))"
|
|
(sx-serialize (list 1 (list 2 (list 3)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Round-trip — extended
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "parser-roundtrip-extended"
|
|
(deftest "roundtrip keyword"
|
|
(let ((parsed (first (sx-parse ":hello"))))
|
|
(assert-equal ":hello" (sx-serialize parsed))))
|
|
|
|
(deftest "roundtrip negative number"
|
|
(assert-equal "-7" (sx-serialize (first (sx-parse "-7")))))
|
|
|
|
(deftest "roundtrip float"
|
|
(assert-equal "3.14" (sx-serialize (first (sx-parse "3.14")))))
|
|
|
|
(deftest "roundtrip string with newline escape"
|
|
(let ((parsed (first (sx-parse "\"a\\nb\""))))
|
|
;; Parsed value contains a real newline character.
|
|
(assert-equal "a\nb" parsed)
|
|
;; Serialized form must escape it back.
|
|
(let ((serialized (sx-serialize parsed)))
|
|
(assert-true (string-contains? serialized "\\n")))))
|
|
|
|
(deftest "roundtrip symbol with question mark"
|
|
(let ((parsed (first (sx-parse "empty?"))))
|
|
(assert-equal "empty?" (sx-serialize parsed))))
|
|
|
|
(deftest "roundtrip component symbol"
|
|
(let ((parsed (first (sx-parse "~card"))))
|
|
(assert-equal "~card" (sx-serialize parsed))))
|
|
|
|
(deftest "roundtrip keyword arguments in list"
|
|
(let ((src "(~comp :title \"Hi\" :count 3)"))
|
|
(assert-equal src
|
|
(sx-serialize (first (sx-parse src))))))
|
|
|
|
(deftest "roundtrip empty list"
|
|
(assert-equal "()" (sx-serialize (first (sx-parse "()")))))
|
|
|
|
(deftest "roundtrip mixed-type list"
|
|
(let ((src "(1 \"hello\" true nil)"))
|
|
(assert-equal src
|
|
(sx-serialize (first (sx-parse src)))))))
|
|
|
|
|
|
;; --------------------------------------------------------------------------
|
|
;; Edge cases
|
|
;; --------------------------------------------------------------------------
|
|
|
|
(defsuite "parser-edge-cases"
|
|
(deftest "empty string parses to empty list"
|
|
(assert-equal (list) (sx-parse "")))
|
|
|
|
(deftest "whitespace-only parses to empty list"
|
|
(assert-equal (list) (sx-parse " \n\t ")))
|
|
|
|
(deftest "multiple top-level expressions"
|
|
(let ((result (sx-parse "1 2 3")))
|
|
(assert-length 3 result)
|
|
(assert-equal 1 (nth result 0))
|
|
(assert-equal 2 (nth result 1))
|
|
(assert-equal 3 (nth result 2))))
|
|
|
|
(deftest "multiple top-level mixed types"
|
|
(let ((result (sx-parse "42 \"hello\" true nil")))
|
|
(assert-length 4 result)
|
|
(assert-equal 42 (nth result 0))
|
|
(assert-equal "hello" (nth result 1))
|
|
(assert-equal true (nth result 2))
|
|
(assert-nil (nth result 3))))
|
|
|
|
(deftest "deeply nested list"
|
|
;; (((((1))))) — parser returns one top-level expression
|
|
(let ((result (sx-parse "(((((1)))))")))
|
|
(assert-length 1 result)))
|
|
|
|
(deftest "long string value"
|
|
(let ((long-str (join "" (map (fn (x) "abcdefghij") (range 0 10)))))
|
|
(let ((src (str "\"" long-str "\"")))
|
|
(assert-equal (list long-str) (sx-parse src)))))
|
|
|
|
(deftest "inline comment inside list"
|
|
(let ((result (sx-parse "(+ 1 ;; comment\n 2)")))
|
|
(assert-length 1 result)
|
|
(assert-equal (list (make-symbol "+") 1 2) (first result))))
|
|
|
|
(deftest "comment at end of file with no trailing newline"
|
|
(assert-equal (list 1) (sx-parse "1 ;; trailing comment")))
|
|
|
|
(deftest "keyword with numeric suffix"
|
|
(let ((result (sx-parse ":item-1")))
|
|
(assert-length 1 result)
|
|
(assert-equal "item-1" (keyword-name (first result)))))
|
|
|
|
(deftest "consecutive keywords parsed as separate atoms"
|
|
(let ((result (sx-parse ":a :b :c")))
|
|
(assert-length 3 result)
|
|
(assert-equal "a" (keyword-name (nth result 0)))
|
|
(assert-equal "b" (keyword-name (nth result 1)))
|
|
(assert-equal "c" (keyword-name (nth result 2)))))
|
|
|
|
(deftest "symbol immediately after opening paren"
|
|
(let ((result (first (sx-parse "(foo)"))))
|
|
(assert-length 1 result)
|
|
(assert-equal "foo" (symbol-name (first result)))))
|
|
|
|
(deftest "parse boolean true is not a symbol"
|
|
(let ((result (first (sx-parse "true"))))
|
|
(assert-type "boolean" result)
|
|
(assert-equal true result)))
|
|
|
|
(deftest "parse boolean false is not a symbol"
|
|
(let ((result (first (sx-parse "false"))))
|
|
(assert-type "boolean" result)
|
|
(assert-equal false result)))
|
|
|
|
(deftest "parse nil is not a symbol"
|
|
(let ((result (first (sx-parse "nil"))))
|
|
(assert-nil result))))
|