giles
cfc7e74a56
Tests for cross-language type primitives: ->> (thread-last), as-> (thread-anywhere), define-protocol/implement/satisfies?. All features already implemented in evaluator, now covered by tests. Co-Authored-By: Claude Opus 4.6 (1M context) <noreply@anthropic.com>
129 lines
3.7 KiB
Plaintext
129 lines
3.7 KiB
Plaintext
;; Step 7: Cross-language type primitives
|
|
;; Threading variants, destructuring, protocols/traits, satisfies?
|
|
|
|
;; ── Thread-last (->>) ─────────────────────────────────────────────
|
|
|
|
(defsuite
|
|
"thread-last"
|
|
(deftest "basic thread-last" (assert= (->> 1 (+ 10)) 11))
|
|
(deftest
|
|
"thread-last multi-step"
|
|
(assert=
|
|
(->> (list 1 2 3 4) (filter odd?) (map (fn (x) (* x 10))))
|
|
(list 10 30)))
|
|
(deftest
|
|
"thread-last into collection ops"
|
|
(assert=
|
|
(->>
|
|
(list 1 2 3)
|
|
(map (fn (x) (* x 2)))
|
|
(filter even?)
|
|
(join ", "))
|
|
"2, 4, 6"))
|
|
(deftest "thread-last single form" (assert= (->> 5 (+ 1)) 6))
|
|
(deftest
|
|
"thread-last bare function"
|
|
(assert= (->> (list 3 1 2) reverse) (list 2 1 3))))
|
|
|
|
;; ── Thread-as (as->) ──────────────────────────────────────────────
|
|
|
|
(defsuite
|
|
"thread-as"
|
|
(deftest "basic as->" (assert= (as-> 10 x (+ x 1) (* x 2)) 22))
|
|
(deftest
|
|
"as-> mid-position"
|
|
(assert= (as-> (list 1 2 3) v (len v) (+ v 10)) 13))
|
|
(deftest
|
|
"as-> with string ops"
|
|
(assert= (as-> "hello" s (str s " world") (upper s)) "HELLO WORLD"))
|
|
(deftest "as-> single step" (assert= (as-> 5 x (* x x)) 25)))
|
|
|
|
;; ── define-protocol / implement ───────────────────────────────────
|
|
|
|
(define-protocol Greetable (greet self))
|
|
|
|
(define-protocol Measurable (measure self) (unit self))
|
|
|
|
(define-record-type
|
|
<person>
|
|
(make-person name age)
|
|
person?
|
|
(name person-name)
|
|
(age person-age))
|
|
|
|
(define-record-type
|
|
<box>
|
|
(make-box width height)
|
|
box?
|
|
(width box-width)
|
|
(height box-height))
|
|
|
|
(implement
|
|
Greetable
|
|
<person>
|
|
(greet self (str "Hello, " (person-name self) "!")))
|
|
|
|
(implement
|
|
Measurable
|
|
<box>
|
|
(measure self (* (box-width self) (box-height self)))
|
|
(unit self "sq-units"))
|
|
|
|
(defsuite
|
|
"protocol-basic"
|
|
(deftest
|
|
"protocol method dispatches on type"
|
|
(let
|
|
((p (make-person "Alice" 30)))
|
|
(assert= (greet p) "Hello, Alice!")))
|
|
(deftest
|
|
"protocol with multiple methods"
|
|
(let
|
|
((b (make-box 3 4)))
|
|
(assert= (measure b) 12)
|
|
(assert= (unit b) "sq-units")))
|
|
(deftest
|
|
"unimplemented protocol raises error"
|
|
(let
|
|
((b (make-box 5 5)) (raised false))
|
|
(guard (e (true (set! raised true))) (greet b))
|
|
(assert raised "should raise for unimplemented"))))
|
|
|
|
(defsuite
|
|
"protocol-satisfies"
|
|
(deftest
|
|
"satisfies? true for implemented"
|
|
(let ((p (make-person "Bob" 25))) (assert (satisfies? "Greetable" p))))
|
|
(deftest
|
|
"satisfies? false for not implemented"
|
|
(let
|
|
((p (make-person "Bob" 25)))
|
|
(assert (not (satisfies? "Measurable" p)))))
|
|
(deftest
|
|
"satisfies? true for second protocol"
|
|
(let ((b (make-box 1 1))) (assert (satisfies? "Measurable" b))))
|
|
(deftest
|
|
"satisfies? false for unknown protocol"
|
|
(let
|
|
((p (make-person "X" 1)))
|
|
(assert (not (satisfies? "Unknown" p))))))
|
|
|
|
;; ── Multiple implementations ──────────────────────────────────────
|
|
|
|
(implement
|
|
Greetable
|
|
<box>
|
|
(greet self (str "Box " (box-width self) "x" (box-height self))))
|
|
|
|
(defsuite
|
|
"protocol-multi-impl"
|
|
(deftest
|
|
"same protocol different types"
|
|
(let
|
|
((p (make-person "Eve" 20)) (b (make-box 2 3)))
|
|
(assert= (greet p) "Hello, Eve!")
|
|
(assert= (greet b) "Box 2x3")))
|
|
(deftest
|
|
"satisfies? after adding impl"
|
|
(let ((b (make-box 1 1))) (assert (satisfies? "Greetable" b)))))
|