1eb2843365
Round 2 of the persistent-collections work. Add a real 32-way branching-trie persistent vector (src/jolt/pv.janet) with a tail buffer: O(log32 n) conj/assoc/nth/pop, with unchanged subtrees shared by identity. Vector literals and vec/vector/conj/assoc/subvec/etc. now produce and maintain these in the default (immutable) build, replacing the old tuple-based vectors. Every core seq op, the destructurer, IFn application, the printers, =, and the evaluator's literal/splice paths were taught to handle the pvec type. Define several Clojure seq fns that were silently leaking to Janet builtins (some, keep, interleave, flatten, mapcat, interpose) and broke once vectors became tables; normalize collections through realize-for-iteration everywhere. Build-time JOLT_MUTABLE flag now selects fast Janet-native mutable collections: in that mode vectors are arrays (conj appends in place, vector? true, print []), sharing one representation with lists. Default build is immutable. Tests: conformance 206/206, features 71/71, jank 119 (baseline). Test helpers normalized so Janet-level = compares against tuple literals regardless of repr. The 2 test-load-sci failures (bit-clear/get-method) pre-date this work.
44 lines
1.9 KiB
Text
44 lines
1.9 KiB
Text
# Phase 8: Protocol System Tests
|
|
(use ../src/jolt/api)
|
|
(defn ct-eval [ctx s] (normalize-pvecs (eval-string ctx s)))
|
|
|
|
(print "35: defprotocol...")
|
|
(let [ctx (init)]
|
|
(ct-eval ctx "(defprotocol Greet (greet [this]))")
|
|
(let [p (ct-eval ctx "Greet")]
|
|
(assert (not (nil? p)) "protocol var exists")
|
|
(assert (= :jolt/protocol (get p :jolt/type)) "protocol type tag")
|
|
(assert (get (get p :methods) :greet) "protocol has greet method"))
|
|
(assert (or (function? (ct-eval ctx "greet")) (cfunction? (ct-eval ctx "greet"))) "method fn exists"))
|
|
(print " passed")
|
|
|
|
(print "36: extend-type...")
|
|
(let [ctx (init)]
|
|
(ct-eval ctx "(deftype Person [name])")
|
|
(ct-eval ctx "(defprotocol Namable (get-name [this]))")
|
|
(ct-eval ctx "(extend-type Person Namable (get-name [this] (.-name this)))")
|
|
(assert (= "Alice" (ct-eval ctx "(get-name (Person. \"Alice\"))")) "extend-type works"))
|
|
(print " passed")
|
|
|
|
(print "37: extend-protocol...")
|
|
(let [ctx (init)]
|
|
(ct-eval ctx "(deftype Dog [breed])")
|
|
(ct-eval ctx "(deftype Cat [color])")
|
|
(ct-eval ctx "(defprotocol Animal (speak [this]))")
|
|
(ct-eval ctx "(extend-protocol Animal
|
|
Dog (speak [this] (str \"woof from \" (.-breed this)))
|
|
Cat (speak [this] (str \"meow from \" (.-color this))))")
|
|
(assert (= "woof from poodle" (ct-eval ctx "(speak (Dog. \"poodle\"))")) "dog speak")
|
|
(assert (= "meow from black" (ct-eval ctx "(speak (Cat. \"black\"))")) "cat speak"))
|
|
(print " passed")
|
|
|
|
(print "38: satisfies?...")
|
|
(let [ctx (init)]
|
|
(ct-eval ctx "(deftype Point [x y])")
|
|
(ct-eval ctx "(defprotocol Locatable (location [this]))")
|
|
(ct-eval ctx "(extend-type Point Locatable (location [this] [(.-x this) (.-y this)]))")
|
|
(assert (= true (ct-eval ctx "(satisfies? Locatable (Point. 3 4))")) "satisfies? true")
|
|
(assert (= false (ct-eval ctx "(satisfies? Locatable {:x 1})")) "satisfies? false"))
|
|
(print " passed")
|
|
|
|
(print "\nAll Phase 8 tests passed!")
|