diff --git a/spec/tests/test-cross-lang-types.sx b/spec/tests/test-cross-lang-types.sx new file mode 100644 index 00000000..d9a46f2b --- /dev/null +++ b/spec/tests/test-cross-lang-types.sx @@ -0,0 +1,128 @@ +;; 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 + + (make-person name age) + person? + (name person-name) + (age person-age)) + +(define-record-type + + (make-box width height) + box? + (width box-width) + (height box-height)) + +(implement + Greetable + + (greet self (str "Hello, " (person-name self) "!"))) + +(implement + Measurable + + (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 + + (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)))))