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

;; lib/common-lisp/tests/stdlib.sx — Phase 6: sequence, list, string functions

(define ev (fn (src) (cl-eval-str src (cl-make-env))))

(define passed 0)
(define failed 0)
(define failures (list))

(define
  check
  (fn
    (label got expected)
    (if
      (= got expected)
      (set! passed (+ passed 1))
      (begin
        (set! failed (+ failed 1))
        (set!
          failures
          (append
            failures
            (list
              (str
                "FAIL ["
                label
                "]: got="
                (inspect got)
                " expected="
                (inspect expected)))))))))

;; ── mapc ─────────────────────────────────────────────────────────

(check "mapc returns list"
  (ev "(mapc #'1+ '(1 2 3))")
  (list 1 2 3))

;; ── mapcan ───────────────────────────────────────────────────────

(check "mapcan basic"
  (ev "(mapcan (lambda (x) (list x (* x x))) '(1 2 3))")
  (list 1 1 2 4 3 9))

(check "mapcan filter-like"
  (ev "(mapcan (lambda (x) (if (evenp x) (list x) nil)) '(1 2 3 4 5 6))")
  (list 2 4 6))

;; ── reduce ───────────────────────────────────────────────────────

(check "reduce sum"
  (ev "(reduce #'+ '(1 2 3 4 5))")
  15)

(check "reduce with initial-value"
  (ev "(reduce #'+ '(1 2 3) :initial-value 10)")
  16)

(check "reduce max"
  (ev "(reduce (lambda (a b) (if (> a b) a b)) '(3 1 4 1 5 9 2 6))")
  9)

;; ── find ─────────────────────────────────────────────────────────

(check "find present"
  (ev "(find 3 '(1 2 3 4 5))")
  3)

(check "find absent"
  (ev "(find 9 '(1 2 3))")
  nil)

(check "find-if present"
  (ev "(find-if #'evenp '(1 3 4 7))")
  4)

(check "find-if absent"
  (ev "(find-if #'evenp '(1 3 5))")
  nil)

(check "find-if-not"
  (ev "(find-if-not #'evenp '(2 4 5 6))")
  5)

;; ── position ─────────────────────────────────────────────────────

(check "position found"
  (ev "(position 3 '(1 2 3 4 5))")
  2)

(check "position not found"
  (ev "(position 9 '(1 2 3))")
  nil)

(check "position-if"
  (ev "(position-if #'evenp '(1 3 4 8))")
  2)

;; ── count ────────────────────────────────────────────────────────

(check "count"
  (ev "(count 2 '(1 2 3 2 4 2))")
  3)

(check "count-if"
  (ev "(count-if #'evenp '(1 2 3 4 5 6))")
  3)

;; ── every / some / notany / notevery ─────────────────────────────

(check "every true"
  (ev "(every #'evenp '(2 4 6))")
  true)

(check "every false"
  (ev "(every #'evenp '(2 3 6))")
  nil)

(check "every empty"
  (ev "(every #'evenp '())")
  true)

(check "some truthy"
  (ev "(some #'evenp '(1 3 4))")
  true)

(check "some nil"
  (ev "(some #'evenp '(1 3 5))")
  nil)

(check "notany true"
  (ev "(notany #'evenp '(1 3 5))")
  true)

(check "notany false"
  (ev "(notany #'evenp '(1 2 5))")
  nil)

(check "notevery false"
  (ev "(notevery #'evenp '(2 4 6))")
  nil)

(check "notevery true"
  (ev "(notevery #'evenp '(2 3 6))")
  true)

;; ── remove ───────────────────────────────────────────────────────

(check "remove"
  (ev "(remove 3 '(1 2 3 4 3 5))")
  (list 1 2 4 5))

(check "remove-if"
  (ev "(remove-if #'evenp '(1 2 3 4 5 6))")
  (list 1 3 5))

(check "remove-if-not"
  (ev "(remove-if-not #'evenp '(1 2 3 4 5 6))")
  (list 2 4 6))

;; ── member ───────────────────────────────────────────────────────

(check "member found"
  (ev "(member 3 '(1 2 3 4 5))")
  (list 3 4 5))

(check "member not found"
  (ev "(member 9 '(1 2 3))")
  nil)

;; ── subst ────────────────────────────────────────────────────────

(check "subst flat"
  (ev "(subst 'b 'a '(a b c a))")
  (list "B" "B" "C" "B"))

(check "subst nested"
  (ev "(subst 99 1 '(1 (2 1) 3))")
  (list 99 (list 2 99) 3))

;; ── assoc ────────────────────────────────────────────────────────

(check "assoc found"
  (ev "(assoc 'b '((a 1) (b 2) (c 3)))")
  (list "B" 2))

(check "assoc not found"
  (ev "(assoc 'z '((a 1) (b 2)))")
  nil)

;; ── list ops ─────────────────────────────────────────────────────

(check "last"
  (ev "(last '(1 2 3 4))")
  (list 4))

(check "butlast"
  (ev "(butlast '(1 2 3 4))")
  (list 1 2 3))

(check "nthcdr"
  (ev "(nthcdr 2 '(a b c d))")
  (list "C" "D"))

(check "list*"
  (ev "(list* 1 2 '(3 4))")
  (list 1 2 3 4))

(check "cadr"
  (ev "(cadr '(1 2 3))")
  2)

(check "caddr"
  (ev "(caddr '(1 2 3))")
  3)

(check "cadddr"
  (ev "(cadddr '(1 2 3 4))")
  4)

(check "cddr"
  (ev "(cddr '(1 2 3 4))")
  (list 3 4))

;; ── subseq ───────────────────────────────────────────────────────

(check "subseq string"
  (ev "(subseq \"hello\" 1 3)")
  "el")

(check "subseq list"
  (ev "(subseq '(a b c d) 1 3)")
  (list "B" "C"))

(check "subseq no end"
  (ev "(subseq \"hello\" 2)")
  "llo")

;; ── FORMAT ─────────────────────────────────────────────────────────

(check "format ~A"
  (ev "(format nil \"hello ~A\" \"world\")")
  "hello world")

(check "format ~D"
  (ev "(format nil \"~D items\" 42)")
  "42 items")

(check "format two args"
  (ev "(format nil \"~A ~A\" 1 2)")
  "1 2")

(check "format ~A+~A=~A"
  (ev "(format nil \"~A + ~A = ~A\" 1 2 3)")
  "1 + 2 = 3")

(check "format iterate"
  (ev "(format nil \"~{~A~}\" (quote (1 2 3)))")
  "123")

(check "format iterate with space"
  (ev "(format nil \"(~{~A ~})\" (quote (1 2 3)))")
  "(1 2 3 )")

;; ── packages ─────────────────────────────────────────────────────

(check "defpackage returns name"
  (ev "(defpackage :my-pkg (:use :cl))")
  "MY-PKG")

(check "in-package"
  (ev "(progn (defpackage :test-pkg) (in-package :test-pkg) (package-name))")
  "TEST-PKG")

(check "package-qualified function"
  (ev "(cl:car (quote (1 2 3)))")
  1)

(check "package-qualified function 2"
  (ev "(cl:mapcar (function evenp) (quote (2 3 4)))")
  (list true nil true))

;; ── summary ──────────────────────────────────────────────────────

(define stdlib-passed passed)
(define stdlib-failed failed)
(define stdlib-failures failures)