stdlib: port clojure.data, rewrite clojure.zip; fix with-meta nil; add battery
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.
This commit is contained in:
Yogthos
parent
c975f5d1c3
commit
e623968b45
8 changed files with 812 additions and 95 deletions
98
src/jolt/clojure/data.clj
Normal file
98
src/jolt/clojure/data.clj
Normal file
|
|
@ -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))))
|
||||
|
|
@ -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 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 make-node [z node children]
|
||||
(let [m (assoc z :node node :changed? true)]
|
||||
(if children (assoc m :l (vec children)) m)))
|
||||
(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 path [z] (:pnodes z))
|
||||
(defn node "Returns the node at loc" [loc] (nth loc 0))
|
||||
|
||||
(defn left [z]
|
||||
(let [ls (:l z)]
|
||||
(if (and (branch? z) (seq ls))
|
||||
(assoc z :l (vec (rest ls)) :node (first ls)) nil)))
|
||||
(defn branch? "Returns true if the node at loc is a branch"
|
||||
[loc] ((:zip/branch? (meta loc)) (node loc)))
|
||||
|
||||
(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 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 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 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 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 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 leftmost [z]
|
||||
(let [p (up z)] (if p (down p) z)))
|
||||
(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 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 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 next [z]
|
||||
(if (= :end z) z
|
||||
(or (and (branch? z) (down z))
|
||||
(right z)
|
||||
(loop [p z]
|
||||
(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)))
|
||||
(assoc z :node :end))))))
|
||||
[(node p) :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 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? [z] (= :end (:node z)))
|
||||
(defn end? "Returns true if loc represents the end of a depth-first walk"
|
||||
[loc] (= :end (nth loc 1)))
|
||||
|
||||
(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]
|
||||
(zipper seq? identity (fn [node children] (with-meta children (meta node))) root))
|
||||
(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))))))
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
149
test/clojure-stdlib/clojure/data_test/diff.cljc
Normal file
149
test/clojure-stdlib/clojure/data_test/diff.cljc
Normal file
|
|
@ -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)))))
|
||||
107
test/clojure-stdlib/clojure/edn_test/read_string.cljc
Normal file
107
test/clojure-stdlib/clojure/edn_test/read_string.cljc
Normal file
|
|
@ -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")))))
|
||||
101
test/clojure-stdlib/clojure/walk_test/walk.cljc
Normal file
101
test/clojure-stdlib/clojure/walk_test/walk.cljc
Normal file
|
|
@ -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])))))
|
||||
122
test/clojure-stdlib/clojure/zip_test/zip.cljc
Normal file
122
test/clojure-stdlib/clojure/zip_test/zip.cljc
Normal file
|
|
@ -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)
|
||||
60
test/integration/clojure-stdlib-suite-test.janet
Normal file
60
test/integration/clojure-stdlib-suite-test.janet
Normal file
|
|
@ -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"))
|
||||
Loading…
Add table
Add a link
Reference in a new issue