diff options
| -rw-r--r-- | CONTRIBUTING.org | 4 | ||||
| -rw-r--r-- | cljlib-macros.fnl | 2 | ||||
| -rw-r--r-- | cljlib.fnl | 122 | ||||
| -rw-r--r-- | tests/core.fnl | 155 | ||||
| -rw-r--r-- | tests/test.fnl | 2 |
5 files changed, 204 insertions, 81 deletions
diff --git a/CONTRIBUTING.org b/CONTRIBUTING.org index fc48f4c..9acb924 100644 --- a/CONTRIBUTING.org +++ b/CONTRIBUTING.org @@ -37,9 +37,9 @@ For this particular project, please follow rules as described in [[https://githu If you see any inconsistencies with the style guide in the code, feel free to change these in a non-breaking way. If you've added new functions, each one must be covered with a set of tests. -For that purpose this project has special =test.fnl= module, that defines such macros as =assert*=, =assert-not=, =assert-eq=, =assert-ne=, =deftest=, and =testing=. +For that purpose this project has special =test.fnl= module, that defines such macros as =assert-is=, =assert-not=, =assert-eq=, =assert-ne=, =deftest=, and =testing=. Related tests should be grouped with the =deftest= macro, which defines a meaningful name for the test, and test itself must be defined within =testing= macros. -All assertions in tests must be one with one of =assert-eq=, =assert-ne=, =assert-not=, or =assert*= macros, as these provide human readable output in the log. +All assertions in tests must be one with one of =assert-eq=, =assert-ne=, =assert-not=, or =assert-is= macros, as these provide human readable output in the log. When changing existing functions make sure that all tests pass. If some tests do not pass, make sure that these tests are written to test this function. diff --git a/cljlib-macros.fnl b/cljlib-macros.fnl index 9352db4..1f7552c 100644 --- a/cljlib-macros.fnl +++ b/cljlib-macros.fnl @@ -978,7 +978,7 @@ calls will not override existing bindings: : defmethod : def : defonce - :_VERSION #"0.2.0" + :_VERSION #"0.3.0" :_LICENSE #"[MIT](https://gitlab.com/andreyorst/fennel-cljlib/-/raw/master/LICENSE)" :_COPYRIGHT #"Copyright (C) 2020 Andrey Orst" :_DESCRIPTION #"Macros for Cljlib that implement various facilities from Clojure."} @@ -1,4 +1,4 @@ -(local core {:_VERSION "0.2.0" +(local core {:_VERSION "0.3.0" :_LICENSE "[MIT](https://gitlab.com/andreyorst/fennel-cljlib/-/raw/master/LICENSE)" :_COPYRIGHT "Copyright (C) 2020 Andrey Orst" :_DESCRIPTION "Fennel-cljlib - functions from Clojure's core.clj implemented on top @@ -303,16 +303,17 @@ Additionally you can use [`conj`](#conj) and [`apply`](#apply) with [col] (let [res (empty [])] (match (type col) - :table (when-some [_ (next col)] - (var assoc? false) - (let [assoc-res (empty [])] - (each [k v (pairs col)] - (if (and (not assoc?) - (map? col)) - (set assoc? true)) - (insert res v) - (insert assoc-res [k v])) - (if assoc? assoc-res res))) + :table (let [m (or (getmetatable col) {})] + (when-some [_ ((or m.cljlib/next next) col)] + (var assoc? false) + (let [assoc-res (empty [])] + (each [k v (pairs col)] + (if (and (not assoc?) + (map? col)) + (set assoc? true)) + (insert res v) + (insert assoc-res [k v])) + (if assoc? assoc-res res)))) :string (let [char utf8.char] (each [_ b (utf8.codes col)] (insert res (char b))) @@ -882,7 +883,9 @@ 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)) - (let [oldmeta (getmetatable y)] + (let [x (or (. (or (getmetatable x) {}) :cljlib/inner) x) + y (or (. (or (getmetatable y) {}) :cljlib/inner) y) + 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 @@ -928,6 +931,101 @@ use." (tset memo args res) res)))))) + +(fn viewset [Set] + "Workaround for a bug https://todo.sr.ht/~technomancy/fennel/26" + (let [items [] + (res view) (pcall require :fennelview)] + (each [_ v (pairs Set)] + (insert items ((if res view tostring) v))) + (.. "[" (table.concat items " ") "]"))) + +(fn* core.ordered-set + "Create ordered set." + [& xs] + ;; set has to be able to contain deeply nested tables so we need a + ;; special index for it, that compares values deeply. + (let [Set (setmetatable {} {:__index (fn [tbl key] + (var res nil) + (each [k v (pairs tbl)] + (when (eq k key) + (set res v) + (lua :break))) + res)})] + (var i 1) + (each [_ val (ipairs xs)] + (when (not (. Set val)) + (tset Set val i) + (set i (+ 1 i)))) + (fn set-ipairs [] + "Returns stateless `ipairs` iterator for ordered set." + (fn iter [t i] + (fn loop [t k] + (local (k v) (next t k)) + (if v (if (= v (+ 1 i)) + (values v k) + (loop t k)))) + (loop t)) + (values iter Set 0)) + (setmetatable [] + {:cljlib/inner Set + :cljlib/next #(next Set $2) + :cljlib/table-type :ordered-set + :__len (fn [] + (var len 0) + (each [_ _ (pairs Set)] + (set len (+ 1 len))) + len) + :__index (fn [_ k] (if (. Set k) k)) + :__newindex (fn [t k] + (if (not (. Set k)) + (tset Set k (+ (length t) 1)))) + :__ipairs set-ipairs + :__pairs set-ipairs + :__name "ordered set" + :__fennelview viewset}))) + +(fn* core.hash-set + "Create hashed set." + [& xs] + ;; same trick as for ordered set + (let [Set (setmetatable {} {:__index (fn [tbl key] + (var res nil) + (each [k v (pairs tbl)] + (when (eq k key) + (set res v) + (lua :break))) + res)})] + (each [_ k (ipairs xs)] + (when (not (. Set k)) + (tset Set k true))) + (fn set-ipairs [] + "Returns stateful `ipairs` iterator for hashed set." + (var i 0) + (fn iter [t _] + (var (k v) (next t)) + (for [j 1 i] + (set (k v) (next t k))) + (if k (do (set i (+ i 1)) + (values i k)))) + (values iter Set nil)) + (setmetatable [] + {:cljlib/inner Set + :cljlib/next #(next Set $2) + :cljlib/table-type :hashed-set + :__len (fn [] + (var len 0) + (each [_ _ (pairs Set)] + (set len (+ 1 len))) + len) + :__index (fn [_ k] (if (. Set k) k)) + :__newindex (fn [_ k v] (tset Set k (if (not (nil? v)) true))) + :__ipairs set-ipairs + :__pairs set-ipairs + :__name "hashed set" + :__fennelview #(.. "#" (viewset $))}))) + + core ;; LocalWords: cljlib Clojure's clj lua PUC mapv concat Clojure fn zs diff --git a/tests/core.fnl b/tests/core.fnl index edd72f4..a4d4a4e 100644 --- a/tests/core.fnl +++ b/tests/core.fnl @@ -17,22 +17,22 @@ (assert-not (pcall eq)) (assert-eq 1 1) (assert-ne 1 2) - (assert* (eq 1 1 1 1 1)) + (assert-is (eq 1 1 1 1 1)) (assert-eq 1.0 1.0) - (assert* (eq 1.0 1.0 1.0)) - (assert* (eq 1.0 1.0 1.0)) - (assert* (eq "1" "1" "1" "1" "1"))) + (assert-is (eq 1.0 1.0 1.0)) + (assert-is (eq 1.0 1.0 1.0)) + (assert-is (eq "1" "1" "1" "1" "1"))) (testing "deep comparison" - (assert* (eq [])) + (assert-is (eq [])) (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]]]]}}]] + (assert-is (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]]]]}}]] + (assert-is (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]]]]}}]] @@ -40,8 +40,8 @@ [[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]])) - (assert* (eq [1 [2]] [1 [2]] [1 [2]])) + (assert-is (eq [1 [2]] [1 [2]] [1 [2]])) + (assert-is (eq [1 [2]] [1 [2]] [1 [2]])) (assert-not (eq [1 [2]] [1 [2]] [1 [2 [3]]])) (let [a {:a 1 :b 2} @@ -94,83 +94,83 @@ (deftest predicates (testing "zero?" - (assert* (zero? 0)) - (assert* (zero? -0)) + (assert-is (zero? 0)) + (assert-is (zero? -0)) (assert-not (zero? 1))) (testing "int?" - (assert* (int? 1)) + (assert-is (int? 1)) (assert-not (int? 1.1))) (testing "pos?" - (assert* (pos? 1)) - (assert* (and (not (pos? 0)) (not (pos? -1))))) + (assert-is (pos? 1)) + (assert-is (and (not (pos? 0)) (not (pos? -1))))) (testing "neg?" - (assert* (neg? -1)) - (assert* (and (not (neg? 0)) (not (neg? 1))))) + (assert-is (neg? -1)) + (assert-is (and (not (neg? 0)) (not (neg? 1))))) (testing "pos-int?" - (assert* (pos-int? 42)) + (assert-is (pos-int? 42)) (assert-not (pos-int? 4.2))) (testing "neg-int?" - (assert* (neg-int? -42)) + (assert-is (neg-int? -42)) (assert-not (neg-int? -4.2))) (testing "string?" - (assert* (string? :s))) + (assert-is (string? :s))) (testing "double?" - (assert* (double? 3.3)) + (assert-is (double? 3.3)) (assert-not (double? 3.0))) (testing "map?" - (assert* (map? {:a 1})) + (assert-is (map? {:a 1})) (assert-not (map? {})) - (assert* (map? (empty {}))) + (assert-is (map? (empty {}))) (assert-not (map? (empty [])))) (testing "vector?" (assert-not (vector? [])) - (assert* (vector? [{:a 1}])) + (assert-is (vector? [{:a 1}])) (assert-not (vector? {})) (assert-not (vector? {:a 1})) - (assert* (vector? (empty []))) + (assert-is (vector? (empty []))) (assert-not (vector? (empty {})))) (testing "nil?" - (assert* (nil?)) - (assert* (nil? nil)) + (assert-is (nil?)) + (assert-is (nil? nil)) (assert-not (nil? 1))) (testing "odd?" - (assert* (odd? 3)) - (assert* (odd? -3)) + (assert-is (odd? 3)) + (assert-is (odd? -3)) (assert-not (odd? 2)) (assert-not (odd? -2))) (testing "even?" - (assert* (even? 2)) - (assert* (even? -2)) + (assert-is (even? 2)) + (assert-is (even? -2)) (assert-not (even? 23)) (assert-not (even? -23))) (testing "true?" - (assert* (true? true)) + (assert-is (true? true)) (assert-not (true? false)) (assert-not (true? 10)) (assert-not (true? :true))) (testing "false?" - (assert* (false? false)) + (assert-is (false? false)) (assert-not (false? true)) (assert-not (false? 10)) (assert-not (false? :true))) (testing "boolean?" - (assert* (boolean? true)) - (assert* (boolean? false)) + (assert-is (boolean? true)) + (assert-is (boolean? false)) (assert-not (boolean? :false)) (assert-not (boolean? (fn [] true))))) @@ -350,15 +350,15 @@ (assert-eq (always-nil 1 2 3 4 "5") nil)) (let [always-true (constantly true)] - (assert* (always-true)) - (assert* (always-true false)))) + (assert-is (always-true)) + (assert-is (always-true false)))) (testing "complement" - (assert* ((complement #(do false)))) - (assert* ((complement nil?) 10)) - (assert* ((complement every?) double? [1 2 3 4])) - (assert* ((complement #(= $1 $2 $3)) 1 1 2 1)) - (assert* ((complement #(= $1 $2)) 1 2))) + (assert-is ((complement #(do false)))) + (assert-is ((complement nil?) 10)) + (assert-is ((complement every?) double? [1 2 3 4])) + (assert-is ((complement #(= $1 $2 $3)) 1 1 2 1)) + (assert-is ((complement #(= $1 $2)) 1 2))) (testing "apply" (fn* add @@ -402,15 +402,15 @@ (testing "some" (assert-not (pcall some)) (assert-not (pcall some pos-int?)) - (assert* (some pos-int? [-1 1.1 2.3 -5.5 42 10 -27])) + (assert-is (some pos-int? [-1 1.1 2.3 -5.5 42 10 -27])) (assert-not (some pos-int? {:a 1})) - (assert* (some pos-int? [{:a 1} "1" -1 1]))) + (assert-is (some pos-int? [{:a 1} "1" -1 1]))) (testing "not-any?" (assert-not (pcall not-any?)) (assert-not (pcall not-any? pos-int?)) - (assert* (not-any? pos-int? [-1 1.1 2.3 -5.5 -42 -10 -27])) - (assert* (not-any? pos-int? {:a 1})) + (assert-is (not-any? pos-int? [-1 1.1 2.3 -5.5 -42 -10 -27])) + (assert-is (not-any? pos-int? {:a 1})) (assert-not (not-any? pos-int? [1 2 3 4 5]))) (testing "every?" @@ -418,13 +418,13 @@ (assert-not (pcall every? pos-int?)) (assert-not (every? pos-int? [-1 1.1 2.3 -5.5 42 10 -27])) (assert-not (every? pos-int? {:a 1})) - (assert* (every? pos-int? [1 2 3 4 5]))) + (assert-is (every? pos-int? [1 2 3 4 5]))) (testing "empty?" (assert-not (pcall empty?)) - (assert* (empty? [])) - (assert* (empty? {})) - (assert* (empty? "")) + (assert-is (empty? [])) + (assert-is (empty? {})) + (assert-is (empty? "")) (assert-not (empty? "1")) (assert-not (empty? [1])) (assert-not (empty? {:a 1})) @@ -557,40 +557,40 @@ (deftest comparison-functions (testing "le" (assert-not (pcall le)) - (assert* (le 1)) - (assert* (le 1 2)) - (assert* (le 1 2 2)) - (assert* (le 1 2 3 4)) + (assert-is (le 1)) + (assert-is (le 1 2)) + (assert-is (le 1 2 2)) + (assert-is (le 1 2 3 4)) (assert-not (le 2 1)) (assert-not (le 2 1 3)) (assert-not (le 1 2 4 3))) (testing "lt" (assert-not (pcall lt)) - (assert* (lt 1)) - (assert* (lt 1 2)) - (assert* (lt 1 2 3)) - (assert* (lt 1 2 3 4)) + (assert-is (lt 1)) + (assert-is (lt 1 2)) + (assert-is (lt 1 2 3)) + (assert-is (lt 1 2 3 4)) (assert-not (lt 2 1)) (assert-not (lt 2 1 3)) (assert-not (lt 1 2 4 4))) (testing "ge" (assert-not (pcall ge)) - (assert* (ge 2)) - (assert* (ge 2 1)) - (assert* (ge 3 3 2)) - (assert* (ge 4 3 2 -1)) + (assert-is (ge 2)) + (assert-is (ge 2 1)) + (assert-is (ge 3 3 2)) + (assert-is (ge 4 3 2 -1)) (assert-not (ge 1 2)) (assert-not (ge 2 1 3)) (assert-not (ge 1 2 4 4))) (testing "gt" (assert-not (pcall gt)) - (assert* (gt 2)) - (assert* (gt 2 1)) - (assert* (gt 3 2 1)) - (assert* (gt 4 3 2 -1)) + (assert-is (gt 2)) + (assert-is (gt 2 1)) + (assert-is (gt 3 2 1)) + (assert-is (gt 4 3 2 -1)) (assert-not (gt 1 2)) (assert-not (gt 2 1 3)) (assert-not (gt 1 2 4 4)))) @@ -609,3 +609,28 @@ (assert-eq (hash-map :a 1) {:a 1}) (assert-eq (hash-map :a 1 :b 2 :c 3) {:a 1 :b 2 :c 3}) (assert-eq (getmetatable (hash-map)) {:cljlib/table-type :table}))) + +(deftest sets + (testing "hash-set" + (let [h1 (hash-set [1] [1] [2] [3] [:a]) + h2 (hash-set [1] [2] [3] [:a])] + (assert-is (eq h1 h2))) + + (let [h1 (hash-set [1] [1] [2] [3] [:a]) + h2 (hash-set [1] [1] [3] [:a])] + (assert-not (eq h1 h2))) + + (assert-eq (. (hash-set [1]) [1]) [1]) + (assert-eq (. (hash-set [1]) [2]) nil)) + + (testing "ordered-set" + (let [h1 (ordered-set [1] [1] [2] [3] [:a]) + h2 (ordered-set [1] [2] [3] [:a])] + (assert-is (eq h1 h2))) + + (let [h1 (ordered-set [1] [1] [2] [3] [:a]) + h2 (ordered-set [2] [1] [1] [3] [:a])] + (assert-not (eq h1 h2))) + + (assert-eq (. (ordered-set [1]) [1]) [1]) + (assert-eq (. (ordered-set [1]) [2]) nil))) diff --git a/tests/test.fnl b/tests/test.fnl index 5dc40c1..b250af4 100644 --- a/tests/test.fnl +++ b/tests/test.fnl @@ -55,7 +55,7 @@ the tables uses tables as keys." Left: " (tostr# left#) " Right: " (tostr# right#) "\n"))))) -(fn test.assert* +(fn test.assert-is [expr msg] `(assert ,expr (.. "assertion failed for " (or ,msg ,(tostring expr))))) |