;; lib/common-lisp/tests/runtime.sx — tests for CL runtime layer

(load "lib/common-lisp/runtime.sx")

(defsuite
  "cl-types"
  (deftest "cl-null? nil" (assert= true (cl-null? nil)))
  (deftest "cl-null? false" (assert= false (cl-null? false)))
  (deftest
    "cl-consp? pair"
    (assert= true (cl-consp? (list 1 2))))
  (deftest "cl-consp? nil" (assert= false (cl-consp? nil)))
  (deftest "cl-listp? nil" (assert= true (cl-listp? nil)))
  (deftest
    "cl-listp? list"
    (assert= true (cl-listp? (list 1 2))))
  (deftest "cl-atom? nil" (assert= true (cl-atom? nil)))
  (deftest "cl-atom? pair" (assert= false (cl-atom? (list 1))))
  (deftest "cl-integerp?" (assert= true (cl-integerp? 42)))
  (deftest "cl-floatp?" (assert= true (cl-floatp? 3.14)))
  (deftest
    "cl-characterp?"
    (assert= true (cl-characterp? (integer->char 65))))
  (deftest "cl-stringp?" (assert= true (cl-stringp? "hello")))
  (deftest "cl-symbolp?" (assert= true (cl-symbolp? (quote foo)))))

(defsuite
  "cl-arithmetic"
  (deftest "cl-mod" (assert= 1 (cl-mod 10 3)))
  (deftest "cl-rem" (assert= 1 (cl-rem 10 3)))
  (deftest
    "cl-quotient"
    (assert= 3 (cl-quotient 10 3)))
  (deftest "cl-gcd" (assert= 4 (cl-gcd 12 8)))
  (deftest "cl-lcm" (assert= 12 (cl-lcm 4 6)))
  (deftest "cl-abs pos" (assert= 5 (cl-abs 5)))
  (deftest "cl-abs neg" (assert= 5 (cl-abs -5)))
  (deftest "cl-min" (assert= 2 (cl-min 2 7)))
  (deftest "cl-max" (assert= 7 (cl-max 2 7)))
  (deftest "cl-evenp? t" (assert= true (cl-evenp? 4)))
  (deftest "cl-evenp? f" (assert= false (cl-evenp? 3)))
  (deftest "cl-oddp? t" (assert= true (cl-oddp? 7)))
  (deftest "cl-zerop?" (assert= true (cl-zerop? 0)))
  (deftest "cl-plusp?" (assert= true (cl-plusp? 1)))
  (deftest "cl-minusp?" (assert= true (cl-minusp? -1)))
  (deftest "cl-signum pos" (assert= 1 (cl-signum 42)))
  (deftest "cl-signum neg" (assert= -1 (cl-signum -7)))
  (deftest "cl-signum zero" (assert= 0 (cl-signum 0))))

(defsuite
  "cl-chars"
  (deftest
    "cl-char-code"
    (assert= 65 (cl-char-code (integer->char 65))))
  (deftest "cl-code-char" (assert= true (char? (cl-code-char 65))))
  (deftest
    "cl-char-upcase"
    (assert=
      (integer->char 65)
      (cl-char-upcase (integer->char 97))))
  (deftest
    "cl-char-downcase"
    (assert=
      (integer->char 97)
      (cl-char-downcase (integer->char 65))))
  (deftest
    "cl-alpha-char-p"
    (assert= true (cl-alpha-char-p (integer->char 65))))
  (deftest
    "cl-digit-char-p"
    (assert= true (cl-digit-char-p (integer->char 48))))
  (deftest
    "cl-char=?"
    (assert=
      true
      (cl-char=? (integer->char 65) (integer->char 65))))
  (deftest
    "cl-char<?"
    (assert=
      true
      (cl-char<? (integer->char 65) (integer->char 90))))
  (deftest
    "cl-char space"
    (assert= (integer->char 32) cl-char-space))
  (deftest
    "cl-char newline"
    (assert= (integer->char 10) cl-char-newline)))

(defsuite
  "cl-format"
  (deftest
    "cl-format nil basic"
    (assert= "hello" (cl-format nil "~a" "hello")))
  (deftest
    "cl-format nil number"
    (assert= "42" (cl-format nil "~d" 42)))
  (deftest
    "cl-format nil hex"
    (assert= "ff" (cl-format nil "~x" 255)))
  (deftest
    "cl-format nil template"
    (assert= "x=3 y=4" (cl-format nil "x=~d y=~d" 3 4)))
  (deftest "cl-format nil tilde" (assert= "a~b" (cl-format nil "a~~b"))))

(defsuite
  "cl-gensym"
  (deftest
    "cl-gensym returns symbol"
    (assert= "symbol" (type-of (cl-gensym))))
  (deftest "cl-gensym unique" (assert= false (= (cl-gensym) (cl-gensym)))))

(defsuite
  "cl-sets"
  (deftest "cl-make-set empty" (assert= true (cl-set? (cl-make-set))))
  (deftest
    "cl-set-add/member"
    (let
      ((s (cl-make-set)))
      (do
        (cl-set-add s 1)
        (assert= true (cl-set-memberp s 1)))))
  (deftest
    "cl-set-memberp false"
    (assert= false (cl-set-memberp (cl-make-set) 42)))
  (deftest
    "cl-list->set"
    (let
      ((s (cl-list->set (list 1 2 3))))
      (assert= true (cl-set-memberp s 2)))))

(defsuite
  "cl-lists"
  (deftest
    "cl-nth 0"
    (assert=
      1
      (cl-nth 0 (list 1 2 3))))
  (deftest
    "cl-nth 2"
    (assert=
      3
      (cl-nth 2 (list 1 2 3))))
  (deftest
    "cl-last"
    (assert=
      (list 3)
      (cl-last (list 1 2 3))))
  (deftest
    "cl-butlast"
    (assert=
      (list 1 2)
      (cl-butlast (list 1 2 3))))
  (deftest
    "cl-nthcdr 1"
    (assert=
      (list 2 3)
      (cl-nthcdr 1 (list 1 2 3))))
  (deftest
    "cl-assoc hit"
    (assert=
      (list "b" 2)
      (cl-assoc "b" (list (list "a" 1) (list "b" 2)))))
  (deftest
    "cl-assoc miss"
    (assert= nil (cl-assoc "z" (list (list "a" 1)))))
  (deftest
    "cl-getf hit"
    (assert= 42 (cl-getf (list "x" 42 "y" 99) "x")))
  (deftest "cl-getf miss" (assert= nil (cl-getf (list "x" 42) "z")))
  (deftest
    "cl-adjoin new"
    (assert=
      (list 0 1 2)
      (cl-adjoin 0 (list 1 2))))
  (deftest
    "cl-adjoin dup"
    (assert=
      (list 1 2)
      (cl-adjoin 1 (list 1 2))))
  (deftest
    "cl-flatten"
    (assert=
      (list 1 2 3 4)
      (cl-flatten (list 1 (list 2 3) 4))))
  (deftest
    "cl-member hit"
    (assert=
      (list 2 3)
      (cl-member 2 (list 1 2 3))))
  (deftest
    "cl-member miss"
    (assert=
      nil
      (cl-member 9 (list 1 2 3)))))

(defsuite
  "cl-radix"
  (deftest "binary" (assert= "1010" (cl-format-binary 10)))
  (deftest "octal" (assert= "17" (cl-format-octal 15)))
  (deftest "hex" (assert= "ff" (cl-format-hex 255)))
  (deftest "decimal" (assert= "42" (cl-format-decimal 42)))
  (deftest
    "n->s r16"
    (assert= "1f" (cl-integer-to-string 31 16)))
  (deftest
    "s->n r16"
    (assert= 31 (cl-string-to-integer "1f" 16))))