kernel: $cond/$when/$unless + 12 tests [nothing]
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
Some checks failed
Test, Build, and Deploy / test-build-deploy (push) Failing after 28s
Standard Kernel control flow. $cond walks clauses in order with `else` catch-all; clauses past the first match are NOT evaluated. $when/$unless are simple guards. 12 tests, 242 total.
This commit is contained in:
@@ -285,4 +285,38 @@
|
||||
(ks-eval-in "`(a ,@x b)" env)))
|
||||
:raised)
|
||||
|
||||
;; ── $cond / $when / $unless ─────────────────────────────────────
|
||||
(ks-test "cond: first match"
|
||||
(ks-eval "($cond (#f 1) (#t 2) (#t 3))") 2)
|
||||
(ks-test "cond: else fallback"
|
||||
(ks-eval "($cond (#f 1) (else 99))") 99)
|
||||
(ks-test "cond: no match returns nil"
|
||||
(ks-eval "($cond (#f 1) (#f 2))") nil)
|
||||
(ks-test "cond: empty clauses returns nil"
|
||||
(ks-eval "($cond)") nil)
|
||||
(ks-test "cond: multi-expr body"
|
||||
(ks-eval "($cond (#t 1 2 3))") 3)
|
||||
(ks-test "cond: doesn't evaluate untaken clauses"
|
||||
;; If the second clause's test were evaluated, the unbound `nope` would error.
|
||||
(ks-eval "($cond (#t 7) (nope ignored))") 7)
|
||||
(ks-test "cond: predicate evaluation"
|
||||
(let ((env (kernel-standard-env)))
|
||||
(ks-eval-in "($define! n 5)" env)
|
||||
(ks-eval-in "($cond ((< n 0) ($quote negative)) ((= n 0) ($quote zero)) (else ($quote positive)))" env))
|
||||
"positive")
|
||||
|
||||
(ks-test "when: true runs body"
|
||||
(ks-eval "($when #t 1 2 3)") 3)
|
||||
(ks-test "when: false returns nil"
|
||||
(ks-eval "($when #f 1 2 3)") nil)
|
||||
(ks-test "when: skips body when false"
|
||||
(ks-eval "($when #f nope)") nil)
|
||||
|
||||
(ks-test "unless: false runs body"
|
||||
(ks-eval "($unless #f 99)") 99)
|
||||
(ks-test "unless: true returns nil"
|
||||
(ks-eval "($unless #t 99)") nil)
|
||||
(ks-test "unless: skips body when true"
|
||||
(ks-eval "($unless #t nope)") nil)
|
||||
|
||||
(define ks-tests-run! (fn () {:total (+ ks-test-pass ks-test-fail) :passed ks-test-pass :failed ks-test-fail :fails ks-test-fails}))
|
||||
|
||||
Reference in New Issue
Block a user