diff options
| -rw-r--r-- | cljlib-macros.fnl | 29 | ||||
| -rw-r--r-- | cljlib.fnl | 30 | ||||
| -rw-r--r-- | tests/core.fnl | 39 | ||||
| -rw-r--r-- | tests/test.fnl | 29 |
4 files changed, 103 insertions, 24 deletions
diff --git a/cljlib-macros.fnl b/cljlib-macros.fnl index 90f2c54..667a570 100644 --- a/cljlib-macros.fnl +++ b/cljlib-macros.fnl @@ -482,16 +482,25 @@ namespaced functions. See `fn*' for more info." (fn eq-fn [] `(fn eq# [a# b#] (if (and (= (type a#) :table) (= (type b#) :table)) - (do (var [res# count-a# count-b#] [true 0 0]) - (each [k# v# (pairs a#)] - (set res# (eq# v# (. b# k#))) - (set count-a# (+ count-a# 1)) - (when (not res#) (lua :break))) - (when res# - (each [_# _# (pairs b#)] - (set count-b# (+ count-b# 1))) - (set res# (and res# (= count-a# count-b#)))) - res#) + (let [oldmeta# (getmetatable b#)] + (setmetatable b# {:__index (fn [tbl# key#] + (var res# nil) + (each [k# v# (pairs tbl#)] + (when (eq# k# key#) + (set res# v#) + (lua :break))) + res#)}) + (var [res# count-a# count-b#] [true 0 0]) + (each [k# v# (pairs a#)] + (set res# (eq# v# (. b# k#))) + (set count-a# (+ count-a# 1)) + (when (not res#) (lua :break))) + (when res# + (each [_# _# (pairs b#)] + (set count-b# (+ count-b# 1))) + (set res# (= count-a# count-b#))) + (setmetatable b# oldmeta#) + res#) (= a# b#)))) (fn seq->table [seq] @@ -591,9 +591,33 @@ that would apply to that value, or `nil' if none apply and no default." ([x] true) ([x y] (if (and (= (type x) :table) (= (type y) :table)) - (and (reduce #(and $1 $2) true (mapv (fn [[k v]] (eq (. y k) v)) (kvseq x))) - (reduce #(and $1 $2) true (mapv (fn [[k v]] (eq (. x k) v)) (kvseq y)))) - (= x y))) + (let [oldmeta (getmetatable y)] + ;; In case if we'll get something like + ;; (eq {[1 2 3] {:a [1 2 3]}} {[1 2 3] {:a [1 2 3]}}) + ;; we have to do even deeper search + (setmetatable y {:__index (fn [tbl key] + (var res nil) + (each [k v (pairs tbl)] + (when (eq k key) + (set res v) + (lua :break))) + res)}) + (var [res count-a count-b] [true 0 0]) + (each [k v (pairs x)] + + + (set res (eq v (. y k))) + (set count-a (+ count-a 1)) + (when (not res) + (lua :break))) + (when res + (each [_ _ (pairs y)] + (set count-b (+ count-b 1))) + (set res (= count-a count-b))) + ;; restoring old metatable + (setmetatable y oldmeta) + res) + (= x y))) ([x y & xs] (reduce #(and $1 $2) (eq x y) (mapv #(eq x $) xs)))) diff --git a/tests/core.fnl b/tests/core.fnl index 1df3921..5fef66d 100644 --- a/tests/core.fnl +++ b/tests/core.fnl @@ -80,6 +80,16 @@ (assert-eq [] []) (assert-eq [] {}) (assert-eq [1 2] [1 2]) + (assert-eq [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] + [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]]) + (assert* (eq [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] + [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]])) + (assert* (eq [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] + [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] + [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]])) + (assert-not (eq [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] + [[1 [2 [3]] {[5] {:a [1 [1 [1 [1]]]]}}]] + [[1 [2 [3]] {[6] {:a [1 [1 [1 [1]]]]}}]])) (assert-ne [1] [1 2]) (assert-ne [1 2] [1]) (assert* (eq [1 [2]] [1 [2]] [1 [2]])) @@ -103,7 +113,34 @@ ;; nil 1])' both yield `{4 1}'. From Lua's point this is not the ;; same thing, for example because the sizes of these tables are ;; different. - (assert-eq {4 1} [nil nil nil 1]))) + (assert-eq {4 1} [nil nil nil 1])) + + (testing "eq metadata preservation" + (let [a (setmetatable + {[1] [1 1 1] + [2 3] [[2 3] [2 3] [2 3] [2 3]]} + {:__index (fn [tbl key] (. tbl key)) + :meta :data}) + b (setmetatable + {[1] [1 1 1] + [2 3] [[2 3] [2 3] [2 3] [2 3] [2 3]]} + {:__index (fn [tbl key] (. tbl key)) + :extra :metadata + :meta {:table :data}}) + meta-a (getmetatable a) + meta-b (getmetatable b) + index-a (. meta-a :__index) + index-b (. meta-b :__index)] + (eq a b) + (assert-eq meta-a (getmetatable a)) + (assert-eq meta-b (getmetatable b)) + (assert-eq index-a (. (getmetatable a) :__index)) + (assert-eq index-b (. (getmetatable b) :__index)) + (eq b a) + (assert-eq meta-a (getmetatable a)) + (assert-eq meta-b (getmetatable b)) + (assert-eq index-a (. (getmetatable a) :__index)) + (assert-eq index-b (. (getmetatable b) :__index))))) (testing "range" (assert-not (pcall range)) diff --git a/tests/test.fnl b/tests/test.fnl index f678b6b..d98e1fa 100644 --- a/tests/test.fnl +++ b/tests/test.fnl @@ -3,16 +3,25 @@ (fn eq-fn [] `(fn eq# [a# b#] (if (and (= (type a#) :table) (= (type b#) :table)) - (do (var [res# count-a# count-b#] [true 0 0]) - (each [k# v# (pairs a#)] - (set res# (eq# v# (. b# k#))) - (set count-a# (+ count-a# 1)) - (when (not res#) (lua :break))) - (when res# - (each [_# _# (pairs b#)] - (set count-b# (+ count-b# 1))) - (set res# (= count-a# count-b#))) - res#) + (let [oldmeta# (getmetatable b#)] + (setmetatable b# {:__index (fn [tbl# key#] + (var res# nil) + (each [k# v# (pairs tbl#)] + (when (eq# k# key#) + (set res# v#) + (lua :break))) + res#)}) + (var [res# count-a# count-b#] [true 0 0]) + (each [k# v# (pairs a#)] + (set res# (eq# v# (. b# k#))) + (set count-a# (+ count-a# 1)) + (when (not res#) (lua :break))) + (when res# + (each [_# _# (pairs b#)] + (set count-b# (+ count-b# 1))) + (set res# (= count-a# count-b#))) + (setmetatable b# oldmeta#) + res#) (= a# b#)))) (fn test.assert-eq |