From e623968b454cd7b897b508c053b0ef0125ed9658 Mon Sep 17 00:00:00 2001 From: Yogthos Date: Sat, 6 Jun 2026 19:02:26 -0400 Subject: [PATCH] stdlib: port clojure.data, rewrite clojure.zip; fix with-meta nil; add battery MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit clojure.data: ported from the ClojureScript impl (jolt-native equality-partition fn instead of host-type protocol dispatch). Verified against Clojure's own data-test (12/13 canonical; the 13th needs nil-valued-map support, jolt-c7h). Used mapv over the reference's (doall (map …)) — jolt's lazy multi-coll map + doall don't force as a reduce accumulator (jolt-dzh). clojure.zip: jolt's was a broken custom reimplementation; replaced with a port of real clojure.zip (metadata-based locs). Uses (nth loc …) instead of (loc …) because meta-bearing vectors aren't invocable as fns (jolt-vh5). core: with-meta now accepts nil metadata (Clojure allows (with-meta x nil)); it crashed calling keys on nil. This is what unblocked zip's make-node. New vendored battery (test/clojure-stdlib/, from clojurust's suite with fixtures corrected to match real Clojure): walk 34, zip 33, data 61 all clean; edn guarded at 43 (still a stub — jolt-b7y). Conformance 218/218 all modes; full suite green. --- src/jolt/clojure/data.clj | 98 +++++++ src/jolt/clojure/zip.clj | 265 ++++++++++++------ src/jolt/core.janet | 5 +- .../clojure/data_test/diff.cljc | 149 ++++++++++ .../clojure/edn_test/read_string.cljc | 107 +++++++ .../clojure/walk_test/walk.cljc | 101 +++++++ test/clojure-stdlib/clojure/zip_test/zip.cljc | 122 ++++++++ .../clojure-stdlib-suite-test.janet | 60 ++++ 8 files changed, 812 insertions(+), 95 deletions(-) create mode 100644 src/jolt/clojure/data.clj create mode 100644 test/clojure-stdlib/clojure/data_test/diff.cljc create mode 100644 test/clojure-stdlib/clojure/edn_test/read_string.cljc create mode 100644 test/clojure-stdlib/clojure/walk_test/walk.cljc create mode 100644 test/clojure-stdlib/clojure/zip_test/zip.cljc create mode 100644 test/integration/clojure-stdlib-suite-test.janet diff --git a/src/jolt/clojure/data.clj b/src/jolt/clojure/data.clj new file mode 100644 index 0000000..9d79c67 --- /dev/null +++ b/src/jolt/clojure/data.clj @@ -0,0 +1,98 @@ +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) +; which can be found in the file epl-v10.html at the root of this distribution. + +;; Ported from clojure.data (Stuart Halloway). The reference dispatches via the +;; EqualityPartition/Diff protocols extended over host types; Jolt uses a plain +;; equality-partition fn over its own predicates instead — same behaviour, no +;; host-type protocol plumbing. +(ns clojure.data + "Non-core data functions." + (:require [clojure.set :as set])) + +(declare diff) + +(defn- atom-diff [a b] + (if (= a b) [nil nil a] [a b nil])) + +;; Convert an associative-by-numeric-index collection into an equivalent vector, +;; with nil for any missing keys. +(defn- vectorize [m] + (when (seq m) + (reduce + (fn [result [k v]] (assoc result k v)) + (vec (repeat (apply max (keys m)) nil)) + m))) + +(defn- diff-associative-key + "Diff associative things a and b, comparing only the key k." + [a b k] + (let [va (get a k) + vb (get b k) + [a* b* ab] (diff va vb) + in-a (contains? a k) + in-b (contains? b k) + same (and in-a in-b + (or (not (nil? ab)) + (and (nil? va) (nil? vb))))] + [(when (and in-a (or (not (nil? a*)) (not same))) {k a*}) + (when (and in-b (or (not (nil? b*)) (not same))) {k b*}) + (when same {k ab})])) + +(defn- diff-associative + "Diff associative things a and b, comparing only keys in ks." + [a b ks] + (reduce + ;; mapv (eager) rather than the reference's (doall (map …)): jolt's + ;; multi-collection map is lazy and doesn't force reliably as a reduce + ;; accumulator here. + (fn [diff1 diff2] (mapv merge diff1 diff2)) + [nil nil nil] + (mapv (partial diff-associative-key a b) ks))) + +(defn- diff-sequential [a b] + (vec (mapv vectorize (diff-associative + (if (vector? a) a (vec a)) + (if (vector? b) b (vec b)) + (range (max (count a) (count b))))))) + +(defn- diff-set [a b] + [(not-empty (set/difference a b)) + (not-empty (set/difference b a)) + (not-empty (set/intersection a b))]) + +(defn- equality-partition [x] + (cond + (nil? x) :atom + (map? x) :map + (set? x) :set + (sequential? x) :sequential + :else :atom)) + +(defn- diff-similar [a b] + ((case (equality-partition a) + :atom atom-diff + :set diff-set + :sequential diff-sequential + :map (fn [a b] (diff-associative a b (set/union (keys a) (keys b))))) + a b)) + +(defn diff + "Recursively compares a and b, returning a tuple of + [things-only-in-a things-only-in-b things-in-both]. + Comparison rules: + + * For equal a and b, return [nil nil a]. + * Maps are subdiffed where keys match and values differ. + * Sets are never subdiffed. + * All sequential things are treated as associative collections + by their indexes, with results returned as vectors. + * Everything else (including strings!) is treated as + an atom and compared for equality." + [a b] + (if (= a b) + [nil nil a] + (if (= (equality-partition a) (equality-partition b)) + (diff-similar a b) + (atom-diff a b)))) diff --git a/src/jolt/clojure/zip.clj b/src/jolt/clojure/zip.clj index 528c4c8..914c90c 100644 --- a/src/jolt/clojure/zip.clj +++ b/src/jolt/clojure/zip.clj @@ -1,98 +1,177 @@ -; Jolt Standard Library: clojure.zip -; Functional zipper for tree navigation and editing. +; Copyright (c) Rich Hickey. All rights reserved. +; The use and distribution terms for this software are covered by the +; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) + +;; Ported from clojure.zip (Rich Hickey). A loc is a vector [node path] carrying +;; the zipper fns (:zip/branch? :zip/children :zip/make-node) as metadata. The +;; reference indexes a loc with (loc 0)/(loc 1); Jolt uses (nth loc ...) because a +;; metadata-bearing vector is not currently invocable as a fn (see jolt-vh5). +(ns clojure.zip + "Functional hierarchical zipper, with navigation, editing, and enumeration.") (defn zipper + "Creates a new zipper structure. branch? is a fn that, given a node, returns + true if it can have children. children returns a seq of a branch node's + children. make-node, given an existing node and a seq of children, returns a + new branch node. root is the root node." [branch? children make-node root] - (let [z {:l [] :r [] :node root :pnodes [] :ppath nil :changed? false}] - (if (branch? root) - (let [chs (children root)] - (assoc z :l (vec (rest chs)) :node (first chs) :pnodes (conj (:pnodes z) root))) - z))) + (with-meta [root nil] + {:zip/branch? branch? :zip/children children :zip/make-node make-node})) -(defn node [z] (:node z)) -(defn branch? [z] (and z (not (nil? (:node z))))) - -(defn make-node [z node children] - (let [m (assoc z :node node :changed? true)] - (if children (assoc m :l (vec children)) m))) - -(defn path [z] (:pnodes z)) - -(defn left [z] - (let [ls (:l z)] - (if (and (branch? z) (seq ls)) - (assoc z :l (vec (rest ls)) :node (first ls)) nil))) - -(defn right [z] - (if (and (branch? z) (seq (:r z))) - (assoc z :l (conj (:l z) (:node z)) :node (first (:r z)) :r (vec (rest (:r z)))) nil)) - -(defn up [z] - (if (seq (path z)) - (let [pn (peek (path z))] - (assoc z :l nil :r (vec (concat (conj (:l z) (:node z)) (:r z))) :node pn :pnodes (pop (path z)))) nil)) - -(defn down [z] - (when (branch? z) - (let [chs (children z)] - (when (seq chs) - (assoc z :node (first chs) :l [] :r (vec (rest chs)) :pnodes (conj (path z) (:node z))))))) - -(defn leftmost [z] - (let [p (up z)] (if p (down p) z))) - -(defn rightmost [z] - (let [p (up z)] - (if p - (let [chs (children p)] - (assoc z :node (last chs) :l (vec (butlast chs)) :r [] :pnodes (conj (pop (path z)) (:node p)))) z))) - -(defn next [z] - (if (= :end z) z - (or (and (branch? z) (down z)) - (right z) - (loop [p z] - (if (up p) - (or (right (up p)) (recur (up p))) - (assoc z :node :end)))))) - -(defn prev [z] - (if-let [l (left z)] - (loop [l l] - (if-let [d (and (branch? l) (down l))] - (recur (rightmost d)) l)) (up z))) - -(defn end? [z] (= :end (:node z))) - -(defn remove [z] - (if-let [p (up z)] - (let [chs (children p) - new-chs (remove #{(:node z)} chs)] - (up (make-node p (:node p) new-chs))) (assoc z :node nil))) - -(defn replace [z node] - (assoc z :node node :changed? true)) - -(defn edit [z f & args] - (replace z (apply f (:node z) args))) - -(defn insert-left [z item] - (assoc z :l (conj (:l z) item))) - -(defn insert-right [z item] - (assoc z :r (into [item] (:r z)))) - -(defn insert-child [z item] - (assoc z :l (into [item] (:l z)))) - -(defn append-child [z item] - (assoc z :l (conj (vec (:l z)) item))) - -(defn root [z] - (if (seq (path z)) (recur (up z)) (:node z))) - -(defn vector-zip [root] - (zipper vector? seq (fn [node children] (vec children)) root)) - -(defn seq-zip [root] +(defn seq-zip + "Returns a zipper for nested sequences, given a root sequence" + [root] (zipper seq? identity (fn [node children] (with-meta children (meta node))) root)) + +(defn vector-zip + "Returns a zipper for nested vectors, given a root vector" + [root] + (zipper vector? seq (fn [node children] (with-meta (vec children) (meta node))) root)) + +(defn node "Returns the node at loc" [loc] (nth loc 0)) + +(defn branch? "Returns true if the node at loc is a branch" + [loc] ((:zip/branch? (meta loc)) (node loc))) + +(defn children "Returns a seq of the children of node at loc, which must be a branch" + [loc] + (if (branch? loc) + ((:zip/children (meta loc)) (node loc)) + (throw "called children on a leaf node"))) + +(defn make-node "Returns a new branch node, given an existing node and new children." + [loc node children] ((:zip/make-node (meta loc)) node children)) + +(defn path "Returns a seq of nodes leading to this loc" [loc] (:pnodes (nth loc 1))) +(defn lefts "Returns a seq of the left siblings of this loc" [loc] (seq (:l (nth loc 1)))) +(defn rights "Returns a seq of the right siblings of this loc" [loc] (:r (nth loc 1))) + +(defn down "Returns the loc of the leftmost child of the node at this loc, or nil" + [loc] + (when (branch? loc) + (let [[node path] loc + [c & cnext :as cs] (children loc)] + (when cs + (with-meta [c {:l [] + :pnodes (if path (conj (:pnodes path) node) [node]) + :ppath path + :r cnext}] + (meta loc)))))) + +(defn up "Returns the loc of the parent of the node at this loc, or nil if at the top" + [loc] + (let [[node {l :l, ppath :ppath, pnodes :pnodes, r :r, changed? :changed?, :as path}] loc] + (when pnodes + (let [pnode (peek pnodes)] + (with-meta (if changed? + [(make-node loc pnode (concat l (cons node r))) + (and ppath (assoc ppath :changed? true))] + [pnode ppath]) + (meta loc)))))) + +(defn root "Zips all the way up and returns the root node, reflecting any changes." + [loc] + (if (= :end (nth loc 1)) + (node loc) + (let [p (up loc)] + (if p (recur p) (node loc))))) + +(defn right "Returns the loc of the right sibling of the node at this loc, or nil" + [loc] + (let [[node {l :l, [r & rnext :as rs] :r, :as path}] loc] + (when (and path rs) + (with-meta [r (assoc path :l (conj l node) :r rnext)] (meta loc))))) + +(defn rightmost "Returns the loc of the rightmost sibling of the node at this loc, or self" + [loc] + (let [[node {l :l r :r :as path}] loc] + (if (and path r) + (with-meta [(last r) (assoc path :l (apply conj l node (butlast r)) :r nil)] (meta loc)) + loc))) + +(defn left "Returns the loc of the left sibling of the node at this loc, or nil" + [loc] + (let [[node {l :l r :r :as path}] loc] + (when (and path (seq l)) + (with-meta [(peek l) (assoc path :l (pop l) :r (cons node r))] (meta loc))))) + +(defn leftmost "Returns the loc of the leftmost sibling of the node at this loc, or self" + [loc] + (let [[node {l :l r :r :as path}] loc] + (if (and path (seq l)) + (with-meta [(first l) (assoc path :l [] :r (concat (rest l) [node] r))] (meta loc)) + loc))) + +(defn insert-left "Inserts the item as the left sibling of the node at this loc, without moving" + [loc item] + (let [[node {l :l :as path}] loc] + (if (nil? path) + (throw "Insert at top") + (with-meta [node (assoc path :l (conj l item) :changed? true)] (meta loc))))) + +(defn insert-right "Inserts the item as the right sibling of the node at this loc, without moving" + [loc item] + (let [[node {r :r :as path}] loc] + (if (nil? path) + (throw "Insert at top") + (with-meta [node (assoc path :r (cons item r) :changed? true)] (meta loc))))) + +(defn replace "Replaces the node at this loc, without moving" + [loc node] + (let [[_ path] loc] + (with-meta [node (assoc path :changed? true)] (meta loc)))) + +(defn edit "Replaces the node at this loc with the value of (f node args)" + [loc f & args] + (replace loc (apply f (node loc) args))) + +(defn insert-child "Inserts the item as the leftmost child of the node at this loc, without moving" + [loc item] + (replace loc (make-node loc (node loc) (cons item (children loc))))) + +(defn append-child "Inserts the item as the rightmost child of the node at this loc, without moving" + [loc item] + (replace loc (make-node loc (node loc) (concat (children loc) [item])))) + +(defn next + "Moves to the next loc in the hierarchy, depth-first. At the end, returns a + distinguished loc detectable via end?; if already at the end, stays there." + [loc] + (if (= :end (nth loc 1)) + loc + (or + (and (branch? loc) (down loc)) + (right loc) + (loop [p loc] + (if (up p) + (or (right (up p)) (recur (up p))) + [(node p) :end]))))) + +(defn prev + "Moves to the previous loc in the hierarchy, depth-first. At the root, returns nil." + [loc] + (if-let [lloc (left loc)] + (loop [loc lloc] + (if-let [child (and (branch? loc) (down loc))] + (recur (rightmost child)) + loc)) + (up loc))) + +(defn end? "Returns true if loc represents the end of a depth-first walk" + [loc] (= :end (nth loc 1))) + +(defn remove + "Removes the node at loc, returning the loc that would have preceded it in a + depth-first walk." + [loc] + (let [[node {l :l, ppath :ppath, pnodes :pnodes, rs :r, :as path}] loc] + (if (nil? path) + (throw "Remove at top") + (if (pos? (count l)) + (loop [loc (with-meta [(peek l) (assoc path :l (pop l) :changed? true)] (meta loc))] + (if-let [child (and (branch? loc) (down loc))] + (recur (rightmost child)) + loc)) + (with-meta [(make-node loc (peek pnodes) rs) + (and ppath (assoc ppath :changed? true))] + (meta loc)))))) diff --git a/src/jolt/core.janet b/src/jolt/core.janet index a04b802..1580f02 100644 --- a/src/jolt/core.janet +++ b/src/jolt/core.janet @@ -2549,9 +2549,10 @@ (var new-obj @{}) (each k (keys obj) (put new-obj k (get obj k))) - # table/setproto requires a table, convert struct meta to table + # table/setproto requires a table, convert struct meta to table. meta may + # be nil (Clojure allows (with-meta obj nil) to clear metadata). (var meta-tab @{}) - (each k (keys meta) (put meta-tab k (get meta k))) + (when meta (each k (keys meta) (put meta-tab k (get meta k)))) (table/setproto new-obj meta-tab) (put new-obj :jolt/meta meta) new-obj))) diff --git a/test/clojure-stdlib/clojure/data_test/diff.cljc b/test/clojure-stdlib/clojure/data_test/diff.cljc new file mode 100644 index 0000000..0b0415a --- /dev/null +++ b/test/clojure-stdlib/clojure/data_test/diff.cljc @@ -0,0 +1,149 @@ +(ns clojure.data-test.diff + (:require [clojure.test :refer [deftest is testing]] +;; NOTE (jolt): sequential-diff expectations corrected to match real Clojure — +;; clojure.data pads only to the max differing index (e.g. (diff [1 2 3] [1 9 3]) +;; -> a=[nil 2], not [nil 2 nil]). The upstream clojurust fixtures had this wrong. + [clojure.data :refer [diff]])) + +;; ── Atoms ──────────────────────────────────────────────────────────────────── + +(deftest test-diff-equal-atoms + (testing "equal atoms" + (is (= [nil nil :a] (diff :a :a))) + (is (= [nil nil 1] (diff 1 1))) + (is (= [nil nil "hello"] (diff "hello" "hello"))) + (is (= [nil nil nil] (diff nil nil))) + (is (= [nil nil true] (diff true true))))) + +(deftest test-diff-unequal-atoms + (testing "unequal atoms" + (is (= [:a :b nil] (diff :a :b))) + (is (= [1 2 nil] (diff 1 2))) + (is (= ["a" "b" nil] (diff "a" "b"))) + (is (= [nil 1 nil] (diff nil 1))) + (is (= [true false nil] (diff true false))))) + +;; ── Maps ───────────────────────────────────────────────────────────────────── + +(deftest test-diff-equal-maps + (testing "equal maps" + (is (= [nil nil {:a 1 :b 2}] (diff {:a 1 :b 2} {:a 1 :b 2}))) + (is (= [nil nil {}] (diff {} {}))))) + +(deftest test-diff-maps-only-in-a + (testing "keys only in a" + (let [[a b both] (diff {:a 1 :b 2} {:a 1})] + (is (= {:b 2} a)) + (is (nil? b)) + (is (= {:a 1} both))))) + +(deftest test-diff-maps-only-in-b + (testing "keys only in b" + (let [[a b both] (diff {:a 1} {:a 1 :b 2})] + (is (nil? a)) + (is (= {:b 2} b)) + (is (= {:a 1} both))))) + +(deftest test-diff-maps-different-values + (testing "same keys, different values" + (let [[a b both] (diff {:a 1 :b 2} {:a 1 :b 9})] + (is (= {:b 2} a)) + (is (= {:b 9} b)) + (is (= {:a 1} both))))) + +(deftest test-diff-maps-nested + (testing "nested maps" + (let [[a b both] (diff {:a {:x 1 :y 2}} {:a {:x 1 :z 3}})] + (is (= {:a {:y 2}} a)) + (is (= {:a {:z 3}} b)) + (is (= {:a {:x 1}} both))))) + +(deftest test-diff-maps-disjoint + (testing "completely disjoint maps" + (let [[a b both] (diff {:a 1} {:b 2})] + (is (= {:a 1} a)) + (is (= {:b 2} b)) + (is (nil? both))))) + +;; ── Sets ───────────────────────────────────────────────────────────────────── + +(deftest test-diff-equal-sets + (testing "equal sets" + (is (= [nil nil #{1 2 3}] (diff #{1 2 3} #{1 2 3}))) + (is (= [nil nil #{}] (diff #{} #{}))))) + +(deftest test-diff-sets + (testing "overlapping sets" + (let [[a b both] (diff #{1 2 3} #{2 3 4})] + (is (= #{1} a)) + (is (= #{4} b)) + (is (= #{2 3} both))))) + +(deftest test-diff-disjoint-sets + (testing "disjoint sets" + (let [[a b both] (diff #{1 2} #{3 4})] + (is (= #{1 2} a)) + (is (= #{3 4} b)) + (is (nil? both))))) + +;; ── Vectors / Sequential ──────────────────────────────────────────────────── + +(deftest test-diff-equal-vectors + (testing "equal vectors" + (is (= [nil nil [1 2 3]] (diff [1 2 3] [1 2 3]))) + (is (= [nil nil []] (diff [] []))))) + +(deftest test-diff-vectors-same-length + (testing "same length, different elements" + (let [[a b both] (diff [1 2 3] [1 9 3])] + (is (= [nil 2] a)) + (is (= [nil 9] b)) + (is (= [1 nil 3] both))))) + +(deftest test-diff-vectors-different-length + (testing "different lengths" + (let [[a b both] (diff [1 2 3] [1 2])] + (is (= [nil nil 3] a)) + (is (nil? b)) + (is (= [1 2] both))) + (let [[a b both] (diff [1] [1 2 3])] + (is (nil? a)) + (is (= [nil 2 3] b)) + (is (= [1] both))))) + +(deftest test-diff-lists + (testing "lists treated as sequential" + (let [[a b both] (diff '(1 2 3) '(1 9 3))] + (is (= [nil 2] a)) + (is (= [nil 9] b)) + (is (= [1 nil 3] both))))) + +;; ── Mixed types ───────────────────────────────────────────────────────────── + +(deftest test-diff-mixed-types + (testing "different partition types treated as atoms" + (is (= [{:a 1} [1 2] nil] (diff {:a 1} [1 2]))) + (is (= [#{1} [1] nil] (diff #{1} [1]))) + (is (= [1 :a nil] (diff 1 :a))))) + +;; ── Nil handling ──────────────────────────────────────────────────────────── + +(deftest test-diff-nil + (testing "nil vs non-nil" + (is (= [nil 1 nil] (diff nil 1))) + (is (= [1 nil nil] (diff 1 nil))) + (is (= [nil {:a 1} nil] (diff nil {:a 1}))))) + +;; ── Deeply nested ─────────────────────────────────────────────────────────── + +(deftest test-diff-deeply-nested + (testing "deeply nested structures" + (let [[a b both] (diff {:a {:b {:c 1}}} {:a {:b {:c 2}}})] + (is (= {:a {:b {:c 1}}} a)) + (is (= {:a {:b {:c 2}}} b)) + (is (nil? both)))) + (testing "deeply nested with shared keys" + (let [[a b both] (diff {:a {:b 1 :c 2}} {:a {:b 1 :c 9}})] + (is (= {:a {:c 2}} a)) + (is (= {:a {:c 9}} b)) + (is (= {:a {:b 1}} both))))) diff --git a/test/clojure-stdlib/clojure/edn_test/read_string.cljc b/test/clojure-stdlib/clojure/edn_test/read_string.cljc new file mode 100644 index 0000000..515af5e --- /dev/null +++ b/test/clojure-stdlib/clojure/edn_test/read_string.cljc @@ -0,0 +1,107 @@ +(ns clojure.edn-test.read-string + (:require [clojure.edn :as edn] + [clojure.test :refer [are deftest is testing]])) + +(deftest test-read-string-scalars + (testing "nil, booleans" + (is (nil? (edn/read-string "nil"))) + (is (true? (edn/read-string "true"))) + (is (false? (edn/read-string "false")))) + + (testing "integers" + (is (= 0 (edn/read-string "0"))) + (is (= 42 (edn/read-string "42"))) + (is (= -1 (edn/read-string "-1"))) + (is (= 1000000000000 (edn/read-string "1000000000000")))) + + (testing "floats" + (is (= 3.14 (edn/read-string "3.14"))) + (is (= -0.5 (edn/read-string "-0.5"))) + (is (= 1.0 (edn/read-string "1.0")))) + + (testing "bigints" + (is (= 42N (edn/read-string "42N")))) + + (testing "bigdecimals" + (is (= 3.14M (edn/read-string "3.14M")))) + + (testing "strings" + (is (= "" (edn/read-string "\"\""))) + (is (= "hello" (edn/read-string "\"hello\""))) + (is (= "line1\nline2" (edn/read-string "\"line1\\nline2\""))) + (is (= "tab\there" (edn/read-string "\"tab\\there\"")))) + + (testing "characters" + (is (= \a (edn/read-string "\\a"))) + (is (= \newline (edn/read-string "\\newline"))) + (is (= \space (edn/read-string "\\space"))) + (is (= \tab (edn/read-string "\\tab")))) + + (testing "keywords" + (is (= :foo (edn/read-string ":foo"))) + (is (= :bar/baz (edn/read-string ":bar/baz")))) + + (testing "symbols" + (is (= 'foo (edn/read-string "foo"))) + (is (= 'bar/baz (edn/read-string "bar/baz"))))) + +(deftest test-read-string-collections + (testing "vectors" + (is (= [] (edn/read-string "[]"))) + (is (= [1 2 3] (edn/read-string "[1 2 3]"))) + (is (= [1 [2 3] 4] (edn/read-string "[1 [2 3] 4]")))) + + (testing "lists" + (is (= '() (edn/read-string "()"))) + (is (= '(1 2 3) (edn/read-string "(1 2 3)"))) + (is (= '(+ 1 2) (edn/read-string "(+ 1 2)")))) + + (testing "maps" + (is (= {} (edn/read-string "{}"))) + (is (= {:a 1} (edn/read-string "{:a 1}"))) + (is (= {:a 1 :b 2} (edn/read-string "{:a 1 :b 2}"))) + (is (= {:nested {:deep true}} (edn/read-string "{:nested {:deep true}}")))) + + (testing "sets" + (is (= #{} (edn/read-string "#{}"))) + (is (= #{1 2 3} (edn/read-string "#{1 2 3}")))) + + (testing "mixed nested" + (is (= {:users [{:name "Alice" :age 30} + {:name "Bob" :age 25}]} + (edn/read-string "{:users [{:name \"Alice\" :age 30} {:name \"Bob\" :age 25}]}"))))) + +(deftest test-read-string-tagged-literals + (testing "#uuid" + (let [u (edn/read-string "#uuid \"f81d4fae-7dec-11d0-a765-00a0c91e6bf6\"")] + (is (uuid? u)) + (is (= u (edn/read-string "#uuid \"f81d4fae-7dec-11d0-a765-00a0c91e6bf6\"")))))) + +(deftest test-read-string-eof + (testing "empty string with :eof option" + (is (= :eof (edn/read-string {:eof :eof} ""))) + (is (= nil (edn/read-string {:eof nil} ""))) + (is (= 42 (edn/read-string {:eof 42} "")))) + + (testing "whitespace-only with :eof option" + (is (= :done (edn/read-string {:eof :done} " ")))) + + (testing "nil input returns nil" + (is (nil? (edn/read-string nil))))) + +(deftest test-read-string-comments + (testing "comments are skipped" + (is (= 42 (edn/read-string "; this is a comment\n42")))) + + (testing "discard reader macro" + (is (= 2 (edn/read-string "#_ 1 2"))))) + +(deftest test-read-string-only-first-form + (testing "reads only the first form" + (is (= 1 (edn/read-string "1 2 3"))) + (is (= :a (edn/read-string ":a :b :c"))))) + +(deftest test-read-string-ratios + (testing "ratios" + (is (= 1/2 (edn/read-string "1/2"))) + (is (= 3/4 (edn/read-string "3/4"))))) diff --git a/test/clojure-stdlib/clojure/walk_test/walk.cljc b/test/clojure-stdlib/clojure/walk_test/walk.cljc new file mode 100644 index 0000000..49a584e --- /dev/null +++ b/test/clojure-stdlib/clojure/walk_test/walk.cljc @@ -0,0 +1,101 @@ +(ns clojure.walk-test.walk + (:require [clojure.test :refer [deftest is testing]] + [clojure.walk :as w])) + +(deftest test-walk + (testing "walk with identity" + (is (= [1 2 3] (w/walk identity identity [1 2 3]))) + (is (= '(1 2 3) (w/walk identity identity '(1 2 3)))) + (is (= #{1 2 3} (w/walk identity identity #{1 2 3})))) + + (testing "walk with inner transform" + (is (= [2 3 4] (w/walk inc identity [1 2 3]))) + (is (= [2 3 4] (w/walk inc vec [1 2 3])))) + + (testing "walk with outer transform" + (is (= [1 2 3] (w/walk identity vec '(1 2 3)))))) + +(deftest test-postwalk + (testing "postwalk with numbers" + (is (= [2 3 4] (w/postwalk #(if (number? %) (inc %) %) [1 2 3])))) + + (testing "postwalk with nested structures" + (is (= [2 [3 4] 5] + (w/postwalk #(if (number? %) (inc %) %) [1 [2 3] 4])))) + + (testing "postwalk preserves types" + (is (vector? (w/postwalk identity [1 2 3]))) + (is (list? (w/postwalk identity '(1 2 3)))) + (is (set? (w/postwalk identity #{1 2 3}))) + (is (map? (w/postwalk identity {:a 1 :b 2})))) + + (testing "postwalk on maps" + (is (= {:a 2 :b 3} + (w/postwalk #(if (number? %) (inc %) %) {:a 1 :b 2})))) + + (testing "postwalk on empty collections" + (is (= [] (w/postwalk identity []))) + (is (= {} (w/postwalk identity {}))) + (is (= #{} (w/postwalk identity #{}))) + (is (= '() (w/postwalk identity '()))))) + +(deftest test-prewalk + (testing "prewalk with numbers" + (is (= [2 3 4] (w/prewalk #(if (number? %) (inc %) %) [1 2 3])))) + + (testing "prewalk with nested structures" + (is (= [2 [3 4] 5] + (w/prewalk #(if (number? %) (inc %) %) [1 [2 3] 4])))) + + (testing "prewalk transforms before descending" + ;; prewalk applies f to the outer form first, so we can replace + ;; entire subtrees before they are walked + (is (= [:replaced] + (w/prewalk #(if (= % [1 2 3]) [:replaced] %) [1 2 3]))))) + +(deftest test-keywordize-keys + (testing "basic keywordize" + (is (= {:a 1 :b 2} (w/keywordize-keys {"a" 1 "b" 2})))) + + (testing "nested keywordize" + (is (= {:a {:b 2}} (w/keywordize-keys {"a" {"b" 2}})))) + + (testing "non-string keys unchanged" + (is (= {:a 1 42 2} (w/keywordize-keys {"a" 1 42 2})))) + + (testing "already keyword keys unchanged" + (is (= {:a 1} (w/keywordize-keys {:a 1}))))) + +(deftest test-stringify-keys + (testing "basic stringify" + (is (= {"a" 1 "b" 2} (w/stringify-keys {:a 1 :b 2})))) + + (testing "nested stringify" + (is (= {"a" {"b" 2}} (w/stringify-keys {:a {:b 2}})))) + + (testing "non-keyword keys unchanged" + (is (= {"a" 1 42 2} (w/stringify-keys {:a 1 42 2}))))) + +(deftest test-postwalk-replace + (testing "basic replacement" + (is (= [:x :y :c] (w/postwalk-replace {:a :x :b :y} [:a :b :c])))) + + (testing "nested replacement" + (is (= [:x [:y :c]] (w/postwalk-replace {:a :x :b :y} [:a [:b :c]])))) + + (testing "no matches" + (is (= [1 2 3] (w/postwalk-replace {:a :x} [1 2 3])))) + + (testing "empty smap" + (is (= [1 2 3] (w/postwalk-replace {} [1 2 3]))))) + +(deftest test-prewalk-replace + (testing "basic replacement" + (is (= [:x :y :c] (w/prewalk-replace {:a :x :b :y} [:a :b :c])))) + + (testing "nested replacement" + (is (= [:x [:y :c]] (w/prewalk-replace {:a :x :b :y} [:a [:b :c]])))) + + (testing "replaces before descending" + ;; prewalk-replace replaces the whole form first, then walks children + (is (= :replaced (w/prewalk-replace {[:a :b] :replaced} [:a :b]))))) diff --git a/test/clojure-stdlib/clojure/zip_test/zip.cljc b/test/clojure-stdlib/clojure/zip_test/zip.cljc new file mode 100644 index 0000000..076eb79 --- /dev/null +++ b/test/clojure-stdlib/clojure/zip_test/zip.cljc @@ -0,0 +1,122 @@ +(ns clojure.zip-test.zip + (:require [clojure.test :refer [deftest is testing run-tests]] + [clojure.zip :as zip])) + +(deftest test-vector-zip-navigation + (let [data [[1 2] [3 [4 5]]] + z (zip/vector-zip data)] + (testing "root node" + (is (= (zip/node z) [[1 2] [3 [4 5]]])) + (is (zip/branch? z))) + (testing "down" + (is (= (zip/node (zip/down z)) [1 2]))) + (testing "right" + (is (= (zip/node (zip/right (zip/down z))) [3 [4 5]]))) + (testing "down into nested" + (is (= (zip/node (zip/down (zip/right (zip/down z)))) 3))) + (testing "up returns parent" + (is (= (zip/node (zip/up (zip/down z))) [[1 2] [3 [4 5]]]))) + (testing "rights" + (is (= (zip/rights (zip/down z)) '([3 [4 5]])))) + (testing "lefts" + (is (= (zip/lefts (zip/right (zip/down z))) [[1 2]]))))) + +(deftest test-vector-zip-rightmost-leftmost + (let [z (zip/vector-zip [1 2 3])] + (testing "rightmost" + (is (= (zip/node (zip/rightmost (zip/down z))) 3))) + (testing "leftmost" + (is (= (zip/node (zip/leftmost (zip/rightmost (zip/down z)))) 1))))) + +(deftest test-seq-zip-navigation + (let [z (zip/seq-zip '(1 (2 3) 4))] + (testing "root" + (is (= (zip/node z) '(1 (2 3) 4)))) + (testing "down" + (is (= (zip/node (zip/down z)) 1))) + (testing "right" + (is (= (zip/node (zip/right (zip/down z))) '(2 3)))) + (testing "down into nested list" + (is (= (zip/node (zip/down (zip/right (zip/down z)))) 2))))) + +(deftest test-path + (let [z (zip/vector-zip [[1 2] [3 4]])] + (testing "path at root is nil" + (is (nil? (zip/path z)))) + (testing "path one level down" + (is (= (zip/path (zip/down z)) [[[1 2] [3 4]]]))) + (testing "path two levels down" + (is (= (zip/path (zip/down (zip/down z))) + [[[1 2] [3 4]] [1 2]]))))) + +(deftest test-edit + (let [z (zip/vector-zip [1 [2 3] [4 5]])] + (testing "edit a leaf" + (let [loc (-> z zip/down zip/right zip/down) + edited (zip/edit loc inc)] + (is (= (zip/root edited) [1 [3 3] [4 5]])))) + (testing "edit a branch" + (let [loc (-> z zip/down zip/right) + edited (zip/edit loc (fn [x] (vec (map inc x))))] + (is (= (zip/root edited) [1 [3 4] [4 5]])))))) + +(deftest test-replace + (let [z (zip/vector-zip '[a b c])] + (is (= (zip/root (zip/replace (zip/down z) 'x)) + '[x b c])))) + +(deftest test-insert-left-right + (let [z (zip/vector-zip [1 2 3]) + loc (-> z zip/down zip/right)] + (testing "insert-left" + (is (= (zip/root (zip/insert-left loc 'x)) [1 'x 2 3]))) + (testing "insert-right" + (is (= (zip/root (zip/insert-right loc 'y)) [1 2 'y 3]))))) + +(deftest test-insert-child-append-child + (let [z (zip/vector-zip [1 2 3])] + (testing "insert-child" + (is (= (zip/root (zip/insert-child z 0)) [0 1 2 3]))) + (testing "append-child" + (is (= (zip/root (zip/append-child z 4)) [1 2 3 4]))))) + +(deftest test-remove + (let [z (zip/vector-zip [1 2 3]) + loc (-> z zip/down zip/right)] + (is (= (zip/root (zip/remove loc)) [1 3])))) + +(deftest test-next-traversal + (let [z (zip/vector-zip [1 [2 3]])] + (testing "next enumerates depth-first" + (is (= (loop [loc z, acc []] + (if (zip/end? loc) + acc + (recur (zip/next loc) (conj acc (zip/node loc))))) + [[1 [2 3]] 1 [2 3] 2 3]))))) + +(deftest test-end? + (let [z (zip/vector-zip [1 2])] + (testing "not end at start" + (is (not (zip/end? z)))) + (testing "end after full traversal" + (is (zip/end? (-> z zip/next zip/next zip/next)))))) + +(deftest test-prev + (let [z (zip/vector-zip [1 [2 3]])] + (testing "prev from second child" + (let [loc (-> z zip/next zip/next)] + (is (= (zip/node loc) [2 3])) + (is (= (zip/node (zip/prev loc)) 1)))) + (testing "prev from leaf inside nested" + (let [loc (-> z zip/next zip/next zip/next)] + (is (= (zip/node loc) 2)) + (is (= (zip/node (zip/prev loc)) [2 3])))))) + +(deftest test-root-after-edits + (testing "root unwinds all the way after deep edits" + (let [z (zip/vector-zip [[1 2] [3 [4 5]]]) + loc (-> z zip/down zip/right zip/down zip/right zip/down) + edited (zip/edit loc inc)] + (is (= (zip/root edited) [[1 2] [3 [5 5]]]))))) + +(run-tests) diff --git a/test/integration/clojure-stdlib-suite-test.janet b/test/integration/clojure-stdlib-suite-test.janet new file mode 100644 index 0000000..d8f675f --- /dev/null +++ b/test/integration/clojure-stdlib-suite-test.janet @@ -0,0 +1,60 @@ +# Vendored stdlib-namespace battery (jolt-0mb). +# +# clojure.test suites for stdlib namespaces beyond clojure.core, vendored from +# clojurust's clojure-test-suite fork (test/clojure-stdlib/, with corrected +# fixtures where the upstream expectations disagreed with real Clojure). Each +# file runs in the shared per-file worker; we guard a minimum pass count so a +# regression is caught and improvements (e.g. finishing clojure.edn) can raise +# the floor. + +(def files + # [relative-path min-pass must-be-clean?] + [["clojure/walk_test/walk.cljc" 34 true] + ["clojure/zip_test/zip.cljc" 33 true] + ["clojure/data_test/diff.cljc" 61 true] + # clojure.edn is still a stub (no opts/:eof arity, broken set/nil handling); + # tracked separately. Guard its current passing subset so it can't regress. + ["clojure/edn_test/read_string.cljc" 43 false]]) + +(def root "test/clojure-stdlib") +(def per-file-timeout 6) + +(defn- run-file [path] + (def proc (os/spawn ["janet" "test/integration/suite-worker.janet" path] :p {:out :pipe})) + (def out (proc :out)) + (var data nil) + (def ok (try + (ev/with-deadline per-file-timeout + (set data (ev/read out 0x10000)) + (os/proc-wait proc) true) + ([err] false))) + (when (not ok) + (protect (os/proc-kill proc true)) + (protect (ev/with-deadline 2 (os/proc-wait proc)))) + (protect (:close out)) + (if (and ok data) (string data) nil)) + +(defn- counts [s] + (var r nil) + (each line (string/split "\n" (or s "")) + (when (string/has-prefix? "@@COUNTS " line) + (let [p (string/split " " (string/trim line))] + (when (= 4 (length p)) (set r [(scan-number (p 1)) (scan-number (p 2)) (scan-number (p 3))]))))) + r) + +(var failures 0) +(each [rel min-pass clean?] files + (def path (string root "/" rel)) + (def c (counts (run-file path))) + (if (nil? c) + (do (++ failures) (printf "FAIL %s: no result (crash/timeout)" rel)) + (let [[p f e] c] + (printf " %-34s pass=%d fail=%d err=%d" rel p f e) + (when (< p min-pass) + (++ failures) (printf "FAIL %s: pass %d < baseline %d" rel p min-pass)) + (when (and clean? (or (pos? f) (pos? e))) + (++ failures) (printf "FAIL %s: expected clean, got %d fail / %d err" rel f e))))) + +(if (pos? failures) + (do (printf "clojure-stdlib-suite: %d failure(s)" failures) (os/exit 1)) + (print "clojure-stdlib-suite: OK"))