rose-ash/lib/common-lisp/tests/parse.sx

;; Common Lisp reader/parser tests

(define cl-test-pass 0)
(define cl-test-fail 0)
(define cl-test-fails (list))

(define
  cl-deep=
  (fn
    (a b)
    (cond
      ((= a b) true)
      ((and (dict? a) (dict? b))
        (let
          ((ak (keys a)) (bk (keys b)))
          (if
            (not (= (len ak) (len bk)))
            false
            (every?
              (fn (k) (and (has-key? b k) (cl-deep= (get a k) (get b k))))
              ak))))
      ((and (list? a) (list? b))
        (if
          (not (= (len a) (len b)))
          false
          (let
            ((i 0) (ok true))
            (define
              chk
              (fn
                ()
                (when
                  (and ok (< i (len a)))
                  (do
                    (when
                      (not (cl-deep= (nth a i) (nth b i)))
                      (set! ok false))
                    (set! i (+ i 1))
                    (chk)))))
            (chk)
            ok)))
      (:else false))))

(define
  cl-test
  (fn
    (name actual expected)
    (if
      (cl-deep= actual expected)
      (set! cl-test-pass (+ cl-test-pass 1))
      (do
        (set! cl-test-fail (+ cl-test-fail 1))
        (append! cl-test-fails {:name name :expected expected :actual actual})))))

;; ── atoms ─────────────────────────────────────────────────────────

(cl-test "integer: 42" (cl-read "42") 42)
(cl-test "integer: 0" (cl-read "0") 0)
(cl-test "integer: negative" (cl-read "-5") -5)
(cl-test "integer: positive sign" (cl-read "+3") 3)
(cl-test "integer: hex #xFF" (cl-read "#xFF") 255)
(cl-test "integer: hex #xAB" (cl-read "#xAB") 171)
(cl-test "integer: binary #b1010" (cl-read "#b1010") 10)
(cl-test "integer: octal #o17" (cl-read "#o17") 15)

(cl-test "float: type" (get (cl-read "3.14") "cl-type") "float")
(cl-test "float: value" (get (cl-read "3.14") "value") "3.14")
(cl-test "float: neg" (get (cl-read "-2.5") "value") "-2.5")
(cl-test "float: exp" (get (cl-read "1.0e10") "value") "1.0e10")

(cl-test "ratio: type" (get (cl-read "1/3") "cl-type") "ratio")
(cl-test "ratio: value" (get (cl-read "1/3") "value") "1/3")
(cl-test "ratio: 22/7" (get (cl-read "22/7") "value") "22/7")

(cl-test "string: basic" (cl-read "\"hello\"") {:cl-type "string" :value "hello"})
(cl-test "string: empty" (cl-read "\"\"") {:cl-type "string" :value ""})
(cl-test "string: with escape" (cl-read "\"a\\nb\"") {:cl-type "string" :value "a\nb"})

(cl-test "symbol: foo" (cl-read "foo") "FOO")
(cl-test "symbol: BAR" (cl-read "BAR") "BAR")
(cl-test "symbol: pkg:sym" (cl-read "cl:car") "CL:CAR")
(cl-test "symbol: pkg::sym" (cl-read "pkg::foo") "PKG::FOO")

(cl-test "nil: symbol" (cl-read "nil") nil)
(cl-test "nil: uppercase" (cl-read "NIL") nil)
(cl-test "t: symbol" (cl-read "t") true)
(cl-test "t: uppercase" (cl-read "T") true)

(cl-test "keyword: type" (get (cl-read ":foo") "cl-type") "keyword")
(cl-test "keyword: name" (get (cl-read ":foo") "name") "FOO")
(cl-test "keyword: :test" (get (cl-read ":test") "name") "TEST")

(cl-test "char: type" (get (cl-read "#\\a") "cl-type") "char")
(cl-test "char: value" (get (cl-read "#\\a") "value") "a")
(cl-test "char: Space" (get (cl-read "#\\Space") "value") " ")
(cl-test "char: Newline" (get (cl-read "#\\Newline") "value") "\n")

(cl-test "uninterned: type" (get (cl-read "#:foo") "cl-type") "uninterned")
(cl-test "uninterned: name" (get (cl-read "#:foo") "name") "FOO")

;; ── lists ─────────────────────────────────────────────────────────

(cl-test "list: empty" (cl-read "()") (list))
(cl-test "list: one element" (cl-read "(foo)") (list "FOO"))
(cl-test "list: two elements" (cl-read "(foo bar)") (list "FOO" "BAR"))
(cl-test "list: nested" (cl-read "((a b) c)") (list (list "A" "B") "C"))
(cl-test "list: with integer" (cl-read "(+ 1 2)") (list "+" 1 2))
(cl-test "list: with string" (cl-read "(print \"hi\")") (list "PRINT" {:cl-type "string" :value "hi"}))
(cl-test "list: nil element" (cl-read "(a nil b)") (list "A" nil "B"))
(cl-test "list: t element" (cl-read "(a t b)") (list "A" true "B"))

;; ── dotted pairs ──────────────────────────────────────────────<E29480><E29480>──

(cl-test "dotted: type" (get (cl-read "(a . b)") "cl-type") "cons")
(cl-test "dotted: car" (get (cl-read "(a . b)") "car") "A")
(cl-test "dotted: cdr" (get (cl-read "(a . b)") "cdr") "B")
(cl-test "dotted: number cdr" (get (cl-read "(x . 42)") "cdr") 42)

;; ── reader macros ────────────────────────────────────────────────<E29480><E29480>

(cl-test "quote: form" (cl-read "'x") (list "QUOTE" "X"))
(cl-test "quote: list" (cl-read "'(a b)") (list "QUOTE" (list "A" "B")))
(cl-test "backquote: form" (cl-read "`x") (list "QUASIQUOTE" "X"))
(cl-test "unquote: form" (cl-read ",x") (list "UNQUOTE" "X"))
(cl-test "comma-at: form" (cl-read ",@x") (list "UNQUOTE-SPLICING" "X"))
(cl-test "function: form" (cl-read "#'foo") (list "FUNCTION" "FOO"))

;; ── vector ────────────────────────────────────────────────────────

(cl-test "vector: type" (get (cl-read "#(1 2 3)") "cl-type") "vector")
(cl-test "vector: elements" (get (cl-read "#(1 2 3)") "elements") (list 1 2 3))
(cl-test "vector: empty" (get (cl-read "#()") "elements") (list))
(cl-test "vector: mixed" (get (cl-read "#(a 1 \"s\")") "elements") (list "A" 1 {:cl-type "string" :value "s"}))

;; ── cl-read-all ───────────────────────────────────────────────────

(cl-test
  "read-all: empty"
  (cl-read-all "")
  (list))

(cl-test
  "read-all: two forms"
  (cl-read-all "42 foo")
  (list 42 "FOO"))

(cl-test
  "read-all: three forms"
  (cl-read-all "(+ 1 2) (+ 3 4) hello")
  (list (list "+" 1 2) (list "+" 3 4) "HELLO"))

(cl-test
  "read-all: with comments"
  (cl-read-all "; this is a comment\n42 ; inline\nfoo")
  (list 42 "FOO"))

(cl-test
  "read-all: defun form"
  (nth (cl-read-all "(defun square (x) (* x x))") 0)
  (list "DEFUN" "SQUARE" (list "X") (list "*" "X" "X")))