test: fold phase ports into spec; promote compile-mode test

Mine the phase* port batteries into the spec layer and delete them (their
behavior is now covered by spec): phase5 (hierarchies), phase6 (tagged
literals/reader-conditionals), phase7 (lazy/sets), phase8+phase12 (protocols;
phase12 was a duplicate of phase8), phase10 (strings/set), phase13
(reify/walk). Unique cases mined into spec: reader #inst/#uuid/#?@ splice,
(Type. args) dot constructor, lazy-seq body-runs-once, keywordize-keys/
stringify-keys, custom :default key and explicit :hierarchy dispatch.

phase6-final tested the COMPILE-MODE path ({:compile? true}), distinct from the
interpreter-based spec — kept and renamed integration/compile-mode-test.

jpm test green, conformance 218/218.
This commit is contained in:
Yogthos 2026-06-05 01:07:09 -04:00
parent 3f5b42d784
commit bcd0e42b33
13 changed files with 19 additions and 338 deletions

View file

@ -1,4 +1,4 @@
(use ../../../src/jolt/api) (use ../../src/jolt/api)
(defn ct-eval [ctx s] (normalize-pvecs (eval-string ctx s))) (defn ct-eval [ctx s] (normalize-pvecs (eval-string ctx s)))

View file

@ -1,59 +0,0 @@
(use ../../../src/jolt/api)
(use ../../../src/jolt/reader)
(use ../../../src/jolt/evaluator)
(defn ct-eval [ctx s] (normalize-pvecs (eval-string ctx s)))
(defn load-clj [ctx filepath]
(def source (slurp filepath))
(var remaining source)
(while (> (length (string/trim remaining)) 0)
(def fr (parse-next remaining))
(def form (fr 0))
(set remaining (fr 1))
(when (not (nil? form))
(eval-form ctx @{} form))))
(print "40: clojure.string...")
(let [ctx (init)]
(load-clj ctx "src/jolt/clojure/string.clj")
(assert (= true (ct-eval ctx "(blank? nil)")) "blank? nil")
(assert (= true (ct-eval ctx "(blank? \" \")")) "blank? whitespace")
(assert (= false (ct-eval ctx "(blank? \"a\")")) "blank? non-empty")
(assert (= "Abc" (ct-eval ctx "(capitalize \"abc\")")) "capitalize")
(assert (= "hello" (ct-eval ctx "(lower-case \"HELLO\")")) "lower-case")
(assert (= "HELLO" (ct-eval ctx "(upper-case \"hello\")")) "upper-case")
(assert (= true (ct-eval ctx "(includes? \"hello\" \"ell\")")) "includes? true")
(assert (= "foo" (ct-eval ctx "(trim \"foo\")")) "trim")
(assert (= true (ct-eval ctx "(starts-with? \"hello\" \"he\")")) "starts-with? true")
(assert (= true (ct-eval ctx "(ends-with? \"hello\" \"lo\")")) "ends-with? true"))
(print " passed")
(print "41: clojure.set...")
(let [ctx (init)]
(load-clj ctx "src/jolt/clojure/set.clj")
(assert (= 3 (ct-eval ctx "(count (union #{1 2} #{2 3}))")) "union")
(assert (= 1 (ct-eval ctx "(count (intersection #{1 2} #{2 3}))")) "intersection")
(assert (= 1 (ct-eval ctx "(count (difference #{1 2} #{2 3}))")) "difference")
(assert (= true (ct-eval ctx "(subset? #{1} #{1 2 3})")) "subset? true")
(assert (= true (ct-eval ctx "(superset? #{1 2 3} #{1})")) "superset? true"))
(print " passed")
(print "42: clojure.walk/zip — modules loadable")
(let [ctx (init)] (load-clj ctx "src/jolt/clojure/walk.clj") (print " walk: loaded"))
(let [ctx (init)] (load-clj ctx "src/jolt/clojure/zip.clj") (print " zip: loaded"))
(print " passed")
(print "43: stdlib summary")
(print " clojure.string — 19 functions")
(print " clojure.set — 10 functions")
(print " clojure.walk — 7 functions")
(print " clojure.zip — zipper data structure")
(print " clojure.edn — EDN reader/writer stubs")
(print " clojure.java-io — file I/O wrappers")
(print " jolt.interop — Janet interop")
(print " jolt.shell — shell command execution")
(print " jolt.http — HTTP client")
(print " passed")
(print "All Phase 10 tests passed!")

View file

@ -1,50 +0,0 @@
# Phase 12: 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 "39: reify...")
(let [ctx (init)]
(ct-eval ctx "(defprotocol Stringable (to-str [this]))")
(assert (= "works" (ct-eval ctx "(to-str (reify Stringable (to-str [this] \"works\")))")) "reify single method"))
(print " passed")
(print "\nAll Phase 12 tests passed!")

View file

@ -1,44 +0,0 @@
(use ../../../src/jolt/api)
(use ../../../src/jolt/evaluator)
(use ../../../src/jolt/reader)
(defn ct-eval [ctx s] (normalize-pvecs (eval-string ctx s)))
(defn load-clj [ctx filepath]
(var s (slurp filepath))
(while (> (length (string/trim s)) 0)
(def [form rest] (parse-next s))
(set s rest)
(when (not (nil? form))
(eval-form ctx @{} form))))
(print "=== Phase 13: Protocol Completion ===")
(print "28: reify dispatch...")
(let [ctx (init)]
(ct-eval ctx "(defprotocol Greeter (say-hello [this]))")
(ct-eval ctx "(def r (reify Greeter (say-hello [this] \"hello reify\")))")
(assert (= "hello reify" (ct-eval ctx "(say-hello r)")) "reify dispatch"))
(print " ok")
(print "29: #() anon-fn reader...")
(let [ctx (init)]
(assert (= 2 (ct-eval ctx "(#(inc %) 1)")) "anon fn %")
(assert (= 3 (ct-eval ctx "(#(+ %1 %2) 1 2)")) "anon fn %1 %2")
(assert (= [1 2 3] (ct-eval ctx "(map #(inc %) [0 1 2])")) "anon fn map"))
(print " ok")
(print "30: extend-type full dispatch...")
(let [ctx (init)]
(ct-eval ctx "(defprotocol Greet (g [this]))")
(ct-eval ctx "(deftype Dog [name])")
(ct-eval ctx "(extend-type Dog Greet (g [this] (str \"woof \" (.-name this))))")
(assert (= "woof Rex" (ct-eval ctx "(g (Dog. \"Rex\"))")) "extend-type dog"))
(print " ok")
(print "31: clojure.walk loading...")
(let [ctx (init)]
(load-clj ctx "src/jolt/clojure/walk.clj")
(assert (function? (ct-eval ctx "keywordize-keys")) "keywordize-keys is fn"))
(print " ok")
(print "\nAll Phase 13 tests passed!")

View file

@ -1,75 +0,0 @@
# Phase 5: Multimethods + Hierarchy Tests
(use ../../../src/jolt/api)
(defn ct-eval [ctx s] (normalize-pvecs (eval-string ctx s)))
# 22. Hierarchy
(print "22: hierarchy...")
(let [ctx (init)]
(assert (= true (ct-eval ctx "(map? (make-hierarchy))")) "make-hierarchy returns map")
# 2-arity derive/isa? use the global hierarchy
(ct-eval ctx "(derive ::square ::shape)")
(assert (= true (ct-eval ctx "(isa? ::square ::shape)")) "isa? 2-arity via global hierarchy")
(assert (= true (ct-eval ctx "(isa? ::square ::square)")) "isa? reflexive"))
(print " passed")
# 23. Multimethods — basic dispatch
(print "23: basic multimethod dispatch...")
(let [ctx (init)]
(ct-eval ctx "(defmulti greet (fn [x] (:lang x)))")
(ct-eval ctx "(defmethod greet :en [_] \"hello\")")
(ct-eval ctx "(defmethod greet :fr [_] \"bonjour\")")
(assert (= "hello" (ct-eval ctx "(greet {:lang :en})")) "dispatch :en")
(assert (= "bonjour" (ct-eval ctx "(greet {:lang :fr})")) "dispatch :fr")
(assert (ct-eval ctx "(try (greet {:lang :es}) (catch Exception e true))") "missing dispatch errors"))
(print " passed")
# 24. Multimethods — :default dispatch
(print "24: :default dispatch...")
(let [ctx (init)]
(ct-eval ctx "(defmulti classify :type :default :unknown)")
(ct-eval ctx "(defmethod classify :a [_] :alpha)")
# :default :unknown renames the catch-all dispatch key; a method must be
# registered under it (Clojure semantics).
(ct-eval ctx "(defmethod classify :unknown [_] :unknown)")
(assert (= :alpha (ct-eval ctx "(classify {:type :a})")) "known dispatch")
(assert (= :unknown (ct-eval ctx "(classify {:type :z})")) "default fallback"))
(print " passed")
# 25. Multimethods — hierarchy dispatch
(print "25: hierarchy dispatch...")
(let [ctx (init)]
(ct-eval ctx "(def h (make-hierarchy))")
(ct-eval ctx "(def h (derive h ::dog ::mammal))")
(ct-eval ctx "(def h (derive h ::mammal ::animal))")
(ct-eval ctx "(defmulti animal-sound (fn [x] x) :default :unknown :hierarchy h)")
(ct-eval ctx "(defmethod animal-sound ::animal [_] \"rawr\")")
(ct-eval ctx "(defmethod animal-sound ::dog [_] \"woof\")")
# catch-all method registered under the renamed default key :unknown
(ct-eval ctx "(defmethod animal-sound :unknown [_] :unknown)")
(assert (= "woof" (ct-eval ctx "(animal-sound ::dog)")) "direct dispatch")
(assert (= "rawr" (ct-eval ctx "(animal-sound ::mammal)")) "hierarchy fallback")
(assert (= :unknown (ct-eval ctx "(animal-sound ::rock)")) "default fallback"))
(print " passed")
# 26. remove-method
(print "26: remove-method...")
(let [ctx (init)]
(ct-eval ctx "(defmulti rmtest :k)")
(ct-eval ctx "(defmethod rmtest :a [_] 1)")
(ct-eval ctx "(defmethod rmtest :b [_] 2)")
(assert (= 1 (ct-eval ctx "(rmtest {:k :a})")) "before remove")
(ct-eval ctx "(remove-method (var rmtest) :a)")
(assert (ct-eval ctx "(try (rmtest {:k :a}) (catch Exception e true))") "removed method errors"))
(print " passed")
# 27. remove-all-methods
(print "27: remove-all-methods...")
(let [ctx (init)]
(ct-eval ctx "(defmulti alltest :k)")
(ct-eval ctx "(defmethod alltest :a [_] 1)")
(ct-eval ctx "(defmethod alltest :b [_] 2)")
(ct-eval ctx "(remove-all-methods (var alltest))")
(assert (ct-eval ctx "(try (alltest {:k :a}) (catch Exception e true))") "all methods removed errors"))
(print " passed")
(print "\nAll Phase 5 tests passed!")

View file

@ -1,36 +0,0 @@
# Phase 6: Reader Extensions Tests
(use ../../../src/jolt/api)
(defn ct-eval [ctx s] (normalize-pvecs (eval-string ctx s)))
(print "28: #inst tagged literal...")
(let [ctx (init)]
(let [val (ct-eval ctx "#inst \"2024-01-15\"")]
(assert (= "2024-01-15" val) "#inst string"))
(let [val (ct-eval ctx "#inst \"2024-01-15T10:30:00Z\"")]
(assert (= "2024-01-15T10:30:00Z" val) "#inst timestamp")))
(print " passed")
(print "29: #uuid tagged literal...")
(let [ctx (init)]
(let [val (ct-eval ctx "#uuid \"550e8400-e29b-41d4-a716-446655440000\"")]
(assert (= "550e8400-e29b-41d4-a716-446655440000" val) "#uuid string")))
(print " passed")
(print "30: #? reader conditionals...")
(let [ctx (init)]
(assert (= :yes (ct-eval ctx "#?(:clj :yes :cljs :no)")) "#? selects :clj")
(assert (= :yes (ct-eval ctx "#?(:cljs :no :default :yes)")) "#? :default fallback")
(assert (= nil (ct-eval ctx "#?(:cljs :no)")) "#? nil on no match"))
(print " passed")
(print "31: #?@ splicing...")
(let [ctx (init)]
(assert (= [1 2 3] (ct-eval ctx "[#?@(:clj [1 2 3] :cljs [4 5 6])]"))
"#?@ splices :clj")
(assert (= [99] (ct-eval ctx "[#?@(:cljs [1] :default [99])]"))
"#?@ :default fallback")
(assert (= [] (ct-eval ctx "[#?@(:cljs [1 2])]"))
"#?@ nothing on no match"))
(print " passed")
(print "\nAll Phase 6 tests passed!")

View file

@ -1,25 +0,0 @@
# Phase 7: LazySeq + PersistentHashSet completion
(use ../../../src/jolt/api)
(defn ct-eval [ctx s] (normalize-pvecs (eval-string ctx s)))
(print "32: lazy-seq...")
(let [ctx (init)]
(let [ls (ct-eval ctx "(lazy-seq (cons 1 (lazy-seq (cons 2 nil))))")]
(assert (not (nil? ls)) "lazy-seq returns non-nil")
(assert (= 1 (ct-eval ctx "(first (lazy-seq (cons 1 nil)))")) "first of lazy"))
(assert (= true (ct-eval ctx "(= [1 2 3] (seq (lazy-seq [1 2 3])))")) "seq forces lazy")
(eval-string ctx "(def counter (atom 0))")
(def val (ct-eval ctx "(let [ls (lazy-seq (do (swap! counter inc) [1 2 3]))] (seq ls) (seq ls) @counter)"))
(assert (= 1 val) "realized once"))
(print " passed")
(print "33: PersistentHashSet...")
(let [ctx (init)]
(assert (= true (ct-eval ctx "(set? #{1 2 3})")) "set? true")
(assert (= false (ct-eval ctx "(set? [1 2 3])")) "set? false")
(assert (= 4 (ct-eval ctx "(count (conj #{1 2 3} 4))")) "conj add")
(assert (= 2 (ct-eval ctx "(count (disj #{1 2 3} 3))")) "disj")
(assert (= 3 (ct-eval ctx "(count #{1 2 3})")) "count")
(assert (= true (ct-eval ctx "(= #{1 2 3} #{3 2 1})")) "= order-independent"))
(print "\nAll Phase 7 tests passed!")

View file

@ -1,44 +0,0 @@
# 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!")

View file

@ -27,4 +27,5 @@
(defspec "lazy / realized?" (defspec "lazy / realized?"
["unrealized" "false" "(realized? (lazy-seq (cons 1 nil)))"] ["unrealized" "false" "(realized? (lazy-seq (cons 1 nil)))"]
["realized after" "true" "(let [s (lazy-seq (cons 1 nil))] (first s) (realized? s))"]) ["realized after" "true" "(let [s (lazy-seq (cons 1 nil))] (first s) (realized? s))"]
["body runs once" "1" "(let [c (atom 0) s (lazy-seq (do (swap! c inc) [1 2 3]))] (seq s) (seq s) @c)"])

View file

@ -25,4 +25,8 @@
["ancestors" "true" "(do (derive ::c ::p) (derive ::p ::g) (contains? (ancestors ::c) ::g))"] ["ancestors" "true" "(do (derive ::c ::p) (derive ::p ::g) (contains? (ancestors ::c) ::g))"]
["descendants" "true" "(do (derive ::c ::p) (contains? (descendants ::p) ::c))"] ["descendants" "true" "(do (derive ::c ::p) (contains? (descendants ::p) ::c))"]
["dispatch via hierarchy" "\"animal\"" ["dispatch via hierarchy" "\"animal\""
"(do (derive ::dog ::animal) (defmulti speak identity) (defmethod speak ::animal [_] \"animal\") (speak ::dog))"]) "(do (derive ::dog ::animal) (defmulti speak identity) (defmethod speak ::animal [_] \"animal\") (speak ::dog))"]
["custom :default key" ":unknown"
"(do (defmulti classify :type :default :other) (defmethod classify :a [_] :alpha) (defmethod classify :other [_] :unknown) (classify {:type :zzz}))"]
["explicit :hierarchy" "\"a\""
"(do (def h (derive (make-hierarchy) ::dog ::animal)) (defmulti snd identity :hierarchy h) (defmethod snd ::animal [_] \"a\") (snd ::dog))"])

View file

@ -24,4 +24,6 @@
["require :refer" "true" "(do (require '[clojure.string :refer [blank?]]) (blank? \"\"))"] ["require :refer" "true" "(do (require '[clojure.string :refer [blank?]]) (blank? \"\"))"]
["require :as + :refer" "true" "(do (require '[clojure.string :as s :refer [blank?]]) (and (blank? \"\") (= \"X\" (s/upper-case \"x\"))))"] ["require :as + :refer" "true" "(do (require '[clojure.string :as s :refer [blank?]]) (and (blank? \"\") (= \"X\" (s/upper-case \"x\"))))"]
["require clojure.set" "#{1 2 3}" "(do (require '[clojure.set :as set]) (set/union #{1 2} #{3}))"] ["require clojure.set" "#{1 2 3}" "(do (require '[clojure.set :as set]) (set/union #{1 2} #{3}))"]
["require clojure.walk" "{:a 2}" "(do (require '[clojure.walk :as w]) (w/postwalk (fn [x] (if (number? x) (inc x) x)) {:a 1}))"]) ["require clojure.walk" "{:a 2}" "(do (require '[clojure.walk :as w]) (w/postwalk (fn [x] (if (number? x) (inc x) x)) {:a 1}))"]
["walk keywordize-keys" "{:a 1}" "(do (require '[clojure.walk :as w]) (w/keywordize-keys {\"a\" 1}))"]
["walk stringify-keys" "true" "(do (require '[clojure.walk :as w]) (= {\"a\" 1} (w/stringify-keys {:a 1})))"])

View file

@ -43,4 +43,8 @@
["satisfies? false" "false" ["satisfies? false" "false"
"(do (defprotocol P (m [_])) (defrecord R []) (satisfies? P (->R)))"] "(do (defprotocol P (m [_])) (defrecord R []) (satisfies? P (->R)))"]
["instance? record" "true" ["instance? record" "true"
"(do (defrecord R [a]) (instance? R (->R 1)))"]) "(do (defrecord R [a]) (instance? R (->R 1)))"]
["dot constructor" "5"
"(do (deftype P [n]) (.-n (P. 5)))"]
["dot ctor + method" "5"
"(do (defprotocol G (val-of [_])) (deftype P [n] G (val-of [_] n)) (val-of (P. 5)))"])

View file

@ -33,6 +33,9 @@
["discard #_" "[1 3]" "[1 #_2 3]"] ["discard #_" "[1 3]" "[1 #_2 3]"]
["regex literal" "true" "(= \"abc\" (re-find #\"abc\" \"xabcx\"))"] ["regex literal" "true" "(= \"abc\" (re-find #\"abc\" \"xabcx\"))"]
["reader conditional" "1" "#?(:clj 1 :cljs 2 :default 3)"] ["reader conditional" "1" "#?(:clj 1 :cljs 2 :default 3)"]
["reader cond splice" "[1 2 3]" "[#?@(:clj [1 2 3] :cljs [4 5])]"]
["inst literal reads" "true" "(some? #inst \"2020-01-01T00:00:00Z\")"]
["uuid literal" "\"550e8400-e29b-41d4-a716-446655440000\"" "(str #uuid \"550e8400-e29b-41d4-a716-446655440000\")"]
["tagged literal var" "true" "(var? #'+)"] ["tagged literal var" "true" "(var? #'+)"]
["deref sugar" "5" "(let [a (atom 5)] @a)"] ["deref sugar" "5" "(let [a (atom 5)] @a)"]
["meta sugar" "{:t 1}" "(meta ^{:t 1} [])"]) ["meta sugar" "{:t 1}" "(meta ^{:t 1} [])"])