diff options
| -rw-r--r-- | .depend.mk | 6 | ||||
| -rw-r--r-- | .luacov | 8 | ||||
| -rw-r--r-- | Makefile | 44 | ||||
| -rw-r--r-- | cljlib-macros.fnl | 212 | ||||
| -rw-r--r-- | cljlib.fnl | 12 | ||||
| -rw-r--r-- | tests/core.fnl (renamed from test/core.fnl) | 196 | ||||
| -rw-r--r-- | tests/fn.fnl (renamed from test/fn.fnl) | 2 | ||||
| -rw-r--r-- | tests/macros.fnl (renamed from test/macros.fnl) | 42 | ||||
| -rw-r--r-- | tests/test.fnl (renamed from test/test.fnl) | 10 |
9 files changed, 301 insertions, 231 deletions
@@ -1,4 +1,4 @@ cljlib.lua: cljlib.fnl cljlib-macros.fnl -test/core.lua: test/core.fnl cljlib-macros.fnl test/test.fnl -test/macros.lua: test/macros.fnl cljlib-macros.fnl test/test.fnl -test/fn.lua: test/fn.fnl cljlib-macros.fnl test/test.fnl +tests/core.lua: tests/core.fnl cljlib-macros.fnl tests/test.fnl cljlib.fnl +tests/macros.lua: tests/macros.fnl cljlib-macros.fnl tests/test.fnl +tests/fn.lua: tests/fn.fnl cljlib-macros.fnl tests/test.fnl @@ -3,10 +3,8 @@ -- see https://keplerproject.github.io/luacov/doc/modules/luacov.defaults.html return { - ["exclude"] = { - "src/fennel/macros.fnl" - }, + exclude = {"src/fennel/macros.fnl"}, runreport = true, - statsfile = "luacov.stats.out"; - reportfile = "luacov.report.out"; + statsfile = "luacov.stats"; + reportfile = "luacov.report"; } @@ -1,50 +1,44 @@ LUA ?= lua - -FNLSOURCES = cljlib.fnl test/core.fnl test/macros.fnl test/fn.fnl +FENNEL ?= fennel +FNLSOURCES = cljlib.fnl LUASOURCES = $(FNLSOURCES:.fnl=.lua) +FNLTESTS = tests/fn.fnl tests/macros.fnl tests/core.fnl +LUATESTS = $(FNLTESTS:.fnl=.lua) -all: $(LUASOURCES) +.PHONY: all clean distclean help test luacov luacov-console -.PHONY: clean help test coverage all +all: $(LUASOURCES) ${LUASOURCES}: $(FNLSOURCES) %.lua: %.fnl - fennel --lua $(LUA) --compile $< > $@ + $(FENNEL) --lua $(LUA) --compile $< > $@ clean: - rm -f *.lua - rm -f test/*.lua + find . -type f -name '*.lua' | xargs rm -f -clean-all: clean +distclean: clean rm -f luacov* -test: clean - @fennel --lua $(LUA) --metadata test/fn.fnl - @fennel --lua $(LUA) --metadata test/core.fnl - @fennel --lua $(LUA) --metadata test/macros.fnl +test: $(FNLTESTS) + @$(foreach test, $?, $(FENNEL) --lua $(LUA) --metadata $(test);) -luacov: | clean-all all luacov-stats +luacov: all $(LUATESTS) + @$(foreach test, $(LUATESTS), $(LUA) -lluarocks.loader -lluacov $(test);) luacov -luacov-console: | luacov - @mv test/core.lua test/core.lua.tmp - @mv test/macros.lua test/macros.lua.tmp - @mv test/fn.lua test/fn.lua.tmp +luacov-console: luacov + @$(foreach test, $(LUATESTS), mv $(test) $(test).tmp;) luacov-console . - @mv test/core.lua.tmp test/core.lua - @mv test/macros.lua.tmp test/macros.lua - @mv test/fn.lua.tmp test/fn.lua - -luacov-stats: test/core.lua test/macros.lua test/fn.lua - @$(foreach test, $?, $(LUA) -lluarocks.loader -lluacov $(test);) + @$(foreach test, $(LUATESTS), mv $(test).tmp $(test);) help: @echo "make -- run tests and create lua library" >&2 @echo "make test -- run tests" >&2 @echo "make clean -- remove lua files" >&2 - @echo "make luacov -- build coverage report (requires working tests)" >&2 - @echo "make luacov-console -- build coverage report for luacov-console (requires working tests)" >&2 + @echo "make distclean -- remove all unnecessary files" >&2 + @echo "make luacov -- build coverage report" >&2 + @echo "make luacov-console -- build coverage report for luacov-console" >&2 @echo "make help -- print this message and exit" >&2 -include .depend.mk diff --git a/cljlib-macros.fnl b/cljlib-macros.fnl index 908fd44..ae6f93e 100644 --- a/cljlib-macros.fnl +++ b/cljlib-macros.fnl @@ -280,7 +280,10 @@ namespaced functions. See `fn*' for more info." (assert-compile (= (length bindings) 2) "expected exactly two forms in binding vector." bindings))) (fn if-let [...] - (let [[bindings then else] [...]] + (let [[bindings then else] (match (select :# ...) + 2 [...] + 3 [...] + _ (error "wrong argument amount for if-some" 2))] (check-bindings bindings) (let [[form test] bindings] `(let [tmp# ,test] @@ -290,7 +293,8 @@ namespaced functions. See `fn*' for more info." ,else))))) (fn when-let [...] - (let [[bindings & body] [...]] + (let [[bindings & body] (if (> (select :# ...) 0) [...] + (error "wrong argument amount for when-let" 2))] (check-bindings bindings) (let [[form test] bindings] `(let [tmp# ,test] @@ -299,7 +303,10 @@ namespaced functions. See `fn*' for more info." ,(unpack body))))))) (fn if-some [...] - (let [[bindings then else] [...]] + (let [[bindings then else] (match (select :# ...) + 2 [...] + 3 [...] + _ (error "wrong argument amount for if-some" 2))] (check-bindings bindings) (let [[form test] bindings] `(let [tmp# ,test] @@ -309,7 +316,8 @@ namespaced functions. See `fn*' for more info." ,then)))))) (fn when-some [...] - (let [[bindings & body] [...]] + (let [[bindings & body] (if (> (select :# ...) 0) [...] + (error "wrong argument amount for when-some" 2))] (check-bindings bindings) (let [[form test] bindings] `(let [tmp# ,test] @@ -335,6 +343,7 @@ namespaced functions. See `fn*' for more info." (if (and (= (type k#) :number) (= k# 1)) :seq (= k# nil) :empty :table)))) + (= t# :nil) :nil :else)))) (fn seq-fn [] @@ -342,7 +351,7 @@ namespaced functions. See `fn*' for more info." (var assoc# false) (let [res# [] insert# table.insert] - (each [k# v# (pairs tbl#)] + (each [k# v# (pairs (or tbl# []))] (if (and (not assoc#) (not (= (type k#) :number))) (set assoc# true)) @@ -359,61 +368,83 @@ namespaced functions. See `fn*' for more info." (let [to-type (table-type to) from-type (table-type from)] (if (and (= to-type :seq) (= from-type :seq)) - `(let [to# ,to + `(let [to# (or ,to []) insert# table.insert] - (each [_# v# (ipairs ,from)] + (each [_# v# (ipairs (or ,from []))] (insert# to# v#)) - to#) + (setmetatable to# {:cljlib/table-type :seq})) (= to-type :seq) - `(let [to# ,to + `(let [to# (or ,to []) seq# ,(seq-fn) insert# table.insert] - (each [_# v# (ipairs (seq# ,from))] + (each [_# v# (ipairs (seq# (or ,from [])))] (insert# to# v#)) - to#) + (setmetatable to# {:cljlib/table-type :seq})) (and (= to-type :table) (= from-type :seq)) - `(let [to# ,to] - (each [_# [k# v#] (ipairs ,from)] + `(let [to# (or ,to [])] + (each [_# [k# v#] (ipairs (or ,from []))] (tset to# k# v#)) - to#) + (setmetatable to# {:cljlib/table-type :table})) (and (= to-type :table) (= from-type :table)) - `(let [to# ,to - from# ,from] + `(let [to# (or ,to []) + from# (or ,from [])] (each [k# v# (pairs from#)] (tset to# k# v#)) - to#) + (setmetatable to# {:cljlib/table-type :table})) (= to-type :table) - `(let [to# ,to - from# ,from] + `(let [to# (or ,to []) + from# (or ,from [])] (match (,(table-type-fn) from#) :seq (each [_# [k# v#] (ipairs from#)] (tset to# k# v#)) :table (each [k# v# (pairs from#)] (tset to# k# v#)) - :else (error "expected table as second argument")) - to#) + :else (error "expected table as second argument" 2)) + (setmetatable to# {:cljlib/table-type :table})) + ;; runtime branch `(let [to# ,to from# ,from insert# table.insert table-type# ,(table-type-fn) - seq# ,(seq-fn)] - (match (table-type# to#) - :seq (each [_# v# (ipairs (seq# from#))] - (insert# to# v#)) - :table (match (table-type# from#) - :seq (each [_# [k# v#] (ipairs from#)] - (tset to# k# v#)) - :table (each [k# v# (pairs from#)] - (tset to# k# v#)) - :else (error "expected table as second argument")) - ;; If we could not deduce type, it means that - ;; we've got empty table. We use will default - ;; to sequential table, because it will never - ;; break when converting into - :empty (each [_# v# (ipairs (seq# from#))] - (insert# to# v#)) - :else (error "expected table as first argument")) - to#)))) + seq# ,(seq-fn) + to-type# (table-type# to#) + to# (or to# []) ;; secure nil + res# (match to-type# + :seq (do (each [_# v# (ipairs (seq# from#))] + (insert# to# v#)) + to#) + :table (match (table-type# from#) + :seq (do (each [_# [k# v#] (ipairs (or from# []))] + (tset to# k# v#)) + to#) + :table (do (each [k# v# (pairs (or from# []))] + (tset to# k# v#)) + to#) + :empty to# + :else (error "expected table as second argument" 2)) + ;; If we could not deduce type, it means that + ;; we've got empty table. We use will default + ;; to sequential table, because it will never + ;; break when converting into + :empty (do (each [_# v# (ipairs (seq# from#))] + (insert# to# v#)) + to#) + :nil (match (table-type# from#) + :nil nil + :empty to# + :seq (do (each [k# v# (pairs (or from# []))] + (tset to# k# v#)) + to#) + :table (do (each [k# v# (pairs (or from# []))] + (tset to# k# v#)) + to#) + :else (error "expected table as second argument" 2)) + :else (error "expected table as first argument" 2))] + (if res# + (setmetatable res# {:cljlib/table-type (match to-type# + :seq :seq + :empty :seq + :table :table)})))))) (fn first [tbl] (. tbl 1)) @@ -425,7 +456,8 @@ namespaced functions. See `fn*' for more info." (= (type x) :string)) (fn when-meta [...] - (when meta-enabled `(do ,...))) + (when meta-enabled + `(do ,...))) (fn meta [v] (when-meta @@ -447,53 +479,69 @@ namespaced functions. See `fn*' for more info." res#) (= a# b#)))) +(fn seq->table [seq] + (let [tbl {}] + (var v nil) + (var (i k) (next seq)) + (while i + (set (i v) (next seq i)) + (tset tbl k v) + (set (i k) (next seq i))) + tbl)) + (fn defmulti [...] - (let [[name & opts] [...] - docstring (if (string? (first opts)) (first opts)) - opts (if docstring (rest opts) opts) - dispatch-fn (first opts)] - (if (in-scope? name) - nil - `(local ,name - (let [multimethods# {}] - (setmetatable - ,(with-meta {} {:fnl/docstring docstring}) - {:__call - (fn [_# ...] - ,docstring - (let [dispatch-value# (,dispatch-fn ...) - (res# view#) (pcall require :fennelview)] - ((or (. multimethods# dispatch-value#) - (. multimethods# :default) - (error (.. "No method in multimethod '" - ,(tostring name) - "' for dispatch value: " - ((if res# view# tostring) dispatch-value#)) - 2)) ...))) - :multimethods (setmetatable multimethods# - {:__index - (fn [tbl# key#] - (let [eq# ,(eq-fn)] - (var res# nil) - (each [k# v# (pairs tbl#)] - (when (eq# k# key#) - (set res# v#) - (lua :break))) - res#))})})))))) - -(fn defmethod [...] - (let [[multifn dispatch-val & fn-tail] [...]] - `(let [multifn# ,multifn] - (tset (. (getmetatable multifn#) :multimethods) - ,dispatch-val - (fn* ,(unpack fn-tail))) - multifn#))) + (let [[name & options] (if (> (select :# ...) 0) [...] + (error "wrong argument amount for defmulti")) + docstring (if (string? (first options)) (first options)) + options (if docstring (rest options) options) + dispatch-fn (first options) + options (rest options)] + (assert (= (% (length options) 2) 0) "wrong argument amount for defmulti") + (let [options (seq->table options)] + (if (in-scope? name) + nil + `(local ,name + (let [multimethods# {}] + (setmetatable + ,(with-meta {} {:fnl/docstring docstring}) + {:__call + (fn [_# ...] + ,docstring + (let [dispatch-value# (,dispatch-fn ...) + (res# view#) (pcall require :fennelview) + tostr# (if res# view# tostring)] + ((or (. multimethods# dispatch-value#) + (. multimethods# (or (. ,options :default) :default)) + (error (.. "No method in multimethod '" + ,(tostring name) + "' for dispatch value: " + (tostr# dispatch-value#)) + 2)) ...))) + :multimethods (setmetatable multimethods# + {:__index + (fn [tbl# key#] + (let [eq# ,(eq-fn)] + (var res# nil) + (each [k# v# (pairs tbl#)] + (when (eq# k# key#) + (set res# v#) + (lua :break))) + res#))})}))))))) + +(fn defmethod [multifn dispatch-val ...] + (when (= (select :# ...) 0) (error "wrong argument amount for defmethod")) + `(let [multifn# ,multifn] + (tset (. (getmetatable multifn#) :multimethods) + ,dispatch-val + (do (fn* f# ,...) + f#)) + multifn#)) (fn def [...] (let [[attr-map name expr] (match (select :# ...) 2 [{} ...] 3 [...] - _ (error "wa")) + _ (error "wrong argument amount for def" 2)) attr-map (if (table? attr-map) attr-map (string? attr-map) {attr-map true} (error "def: expected keyword or literal table as first argument" 2)) @@ -511,7 +559,7 @@ namespaced functions. See `fn*' for more info." (let [[attr-map name expr] (match (select :# ...) 2 [{} ...] 3 [...] - _ (error "wa"))] + _ (error "wrong argument amount for def" 2))] (if (in-scope? name) nil (def attr-map name expr)))) @@ -213,15 +213,11 @@ If `tbl' is sequential table, returns its shallow copy." ([tbl x & xs] (apply conj (conj tbl x) xs))) -(fn* consj +(fn consj [...] "Like conj but joins at the front. Modifies `tbl'." - ([] (empty [])) - ([tbl] tbl) - ([tbl x] - (when-some [x x] - (doto tbl (insert 1 x)))) - ([tbl x & xs] - (apply consj (consj tbl x) xs))) + (let [[tbl x & xs] [...]] + (if (nil? x) tbl + (consj (doto tbl (insert 1 x)) (unpack xs))))) (fn& core.cons "Insert `x' to `tbl' at the front. Modifies `tbl'." diff --git a/test/core.fnl b/tests/core.fnl index 6c705b6..b0c02aa 100644 --- a/test/core.fnl +++ b/tests/core.fnl @@ -1,5 +1,5 @@ (require-macros :cljlib-macros) -(require-macros :test.test) +(require-macros :tests.test) (local {: vector @@ -66,7 +66,7 @@ (deftest equality (testing "comparing basetypes" - (assert* (not (pcall eq))) + (assert-not (pcall eq)) (assert-eq 1 1) (assert-ne 1 2) (assert* (eq 1 1 1 1 1)) @@ -84,7 +84,7 @@ (assert-ne [1 2] [1]) (assert* (eq [1 [2]] [1 [2]] [1 [2]])) (assert* (eq [1 [2]] [1 [2]] [1 [2]])) - (assert* (not (eq [1 [2]] [1 [2]] [1 [2 [3]]]))) + (assert-not (eq [1 [2]] [1 [2]] [1 [2 [3]]])) (let [a {:a 1 :b 2} b {:a 1 :b 2}] @@ -106,7 +106,7 @@ (assert-eq {4 1} [nil nil nil 1]))) (testing "range" - (assert* (not (pcall range))) + (assert-not (pcall range)) (assert-eq (range 10) [0 1 2 3 4 5 6 7 8 9]) (assert-eq (range -5 5) [-5 -4 -3 -2 -1 0 1 2 3 4]) (assert-eq [0 0.2 0.4 0.6 0.8] [0 0.2 0.4 0.6 0.8]) @@ -116,11 +116,11 @@ (testing "zero?" (assert* (zero? 0)) (assert* (zero? -0)) - (assert* (not (zero? 1)))) + (assert-not (zero? 1))) (testing "int?" (assert* (int? 1)) - (assert* (not (int? 1.1)))) + (assert-not (int? 1.1))) (testing "pos?" (assert* (pos? 1)) @@ -132,67 +132,67 @@ (testing "pos-int?" (assert* (pos-int? 42)) - (assert* (not (pos-int? 4.2)))) + (assert-not (pos-int? 4.2))) (testing "neg-int?" (assert* (neg-int? -42)) - (assert* (not (neg-int? -4.2)))) + (assert-not (neg-int? -4.2))) (testing "string?" (assert* (string? :s))) (testing "double?" (assert* (double? 3.3)) - (assert* (not (double? 3.0)))) + (assert-not (double? 3.0))) (testing "map?" (assert* (map? {:a 1})) - (assert* (not (map? {}))) + (assert-not (map? {})) (assert* (map? (empty {}))) - (assert* (not (map? (empty []))))) + (assert-not (map? (empty [])))) (testing "seq?" - (assert* (not (seq? []))) + (assert-not (seq? [])) (assert* (seq? [{:a 1}])) - (assert* (not (seq? {}))) - (assert* (not (seq? {:a 1}))) + (assert-not (seq? {})) + (assert-not (seq? {:a 1})) (assert* (seq? (empty []))) - (assert* (not (seq? (empty {}))))) + (assert-not (seq? (empty {})))) (testing "nil?" (assert* (nil?)) (assert* (nil? nil)) - (assert* (not (nil? 1)))) + (assert-not (nil? 1))) (testing "odd?" (assert* (odd? 3)) (assert* (odd? -3)) - (assert* (not (odd? 2))) - (assert* (not (odd? -2)))) + (assert-not (odd? 2)) + (assert-not (odd? -2))) (testing "even?" (assert* (even? 2)) (assert* (even? -2)) - (assert* (not (even? 23))) - (assert* (not (even? -23)))) + (assert-not (even? 23)) + (assert-not (even? -23))) (testing "true?" (assert* (true? true)) - (assert* (not (true? false))) - (assert* (not (true? 10))) - (assert* (not (true? :true)))) + (assert-not (true? false)) + (assert-not (true? 10)) + (assert-not (true? :true))) (testing "false?" (assert* (false? false)) - (assert* (not (false? true))) - (assert* (not (false? 10))) - (assert* (not (false? :true)))) + (assert-not (false? true)) + (assert-not (false? 10)) + (assert-not (false? :true))) (testing "boolean?" (assert* (boolean? true)) (assert* (boolean? false)) - (assert* (not (boolean? :false))) - (assert* (not (boolean? (fn [] true)))))) + (assert-not (boolean? :false)) + (assert-not (boolean? (fn [] true))))) (deftest sequence-functions (testing "seq" @@ -203,8 +203,8 @@ (assert-eq (seq {:a 1}) [["a" 1]])) (testing "mapv" - (assert* (not (pcall mapv))) - (assert* (not (pcall mapv #(do nil)))) + (assert-not (pcall mapv)) + (assert-not (pcall mapv #(do nil))) (assert-eq (mapv #(* $ $) [1 2 3 4]) [1 4 9 16]) (assert-eq (into {} (mapv (fn [[k v]] [k (* v v)]) {:a 1 :b 2 :c 3})) @@ -245,8 +245,8 @@ (assert-eq (reduce add 10 []) 10) (assert-eq (reduce add 10 [1]) 11) (assert-eq (reduce add 10 nil) 10) - (assert* (not (pcall reduce))) - (assert* (not (pcall reduce add)))) + (assert-not (pcall reduce)) + (assert-not (pcall reduce add))) (testing "reduce reference implementation" (fn mapping [f] @@ -262,8 +262,8 @@ (reduce- ((mapping inc) add) 0 (range 10)))) (testing "filter" - (assert* (not (pcall filter))) - (assert* (not (pcall filter even?))) + (assert-not (pcall filter)) + (assert-not (pcall filter even?)) (assert-eq (filter even? (range 10)) [0 2 4 6 8]) (assert-eq (filter odd? (range 10)) [1 3 5 7 9]) (assert-eq (filter map? [{:a 1} {5 1} [1 2] [] {}]) [{:a 1} {5 1}]) @@ -280,11 +280,11 @@ (assert-eq (concat {:a 1} [[:b 2]]) [[:a 1] [:b 2]]) (assert-eq (concat [] [[:b 2]]) [[:b 2]]) (assert-eq (concat [] []) []) - (assert* (not (pcall concat 1))) - (assert* (not (pcall concat 1 2))) - (assert* (not (pcall concat 1 []))) - (assert* (not (pcall concat [] 2))) - (assert* (not (pcall concat [1] 2)))) + (assert-not (pcall concat 1)) + (assert-not (pcall concat 1 2)) + (assert-not (pcall concat 1 [])) + (assert-not (pcall concat [] 2)) + (assert-not (pcall concat [1] 2))) (testing "reverse" (assert-eq (reverse []) nil) @@ -330,13 +330,13 @@ (testing "reduce-kv" (assert-eq (reduce-kv #(+ $1 $3) 0 {:a 1 :b 2 :c 3}) 6) - (assert* (not (pcall reduce-kv #(+ $1 $3) 0))) - (assert* (not (pcall reduce-kv #(+ $1 $3)))) - (assert* (not (pcall reduce-kv)))) + (assert-not (pcall reduce-kv #(+ $1 $3) 0)) + (assert-not (pcall reduce-kv #(+ $1 $3))) + (assert-not (pcall reduce-kv))) (testing "assoc" - (assert* (not (pcall assoc))) - (assert* (not (pcall assoc {}))) + (assert-not (pcall assoc)) + (assert-not (pcall assoc {})) (assert-eq (assoc {} :a 1) {:a 1}) (assert-eq (assoc {} :a 1 :b 2 :c 3 :d 4) {:a 1 :b 2 :c 3 :d 4}))) @@ -370,8 +370,8 @@ (assert-eq (apply add -3 -2 -1 [1 2 3 4]) 4) (assert-eq (apply add -4 -3 -2 -1 [1 2 3 4]) 0) (assert-eq (apply add -5 -4 -3 -2 -1 [1 2 3 4]) -5) - (assert* (not (pcall apply))) - (assert* (not (pcall apply add)))) + (assert-not (pcall apply)) + (assert-not (pcall apply add))) (testing "comp" (assert-eq ((comp) 10) 10) @@ -398,38 +398,38 @@ (deftest sequence-predicates (testing "some" - (assert* (not (pcall some))) - (assert* (not (pcall some pos-int?))) + (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* (not (some pos-int? {:a 1}))) + (assert-not (some pos-int? {:a 1})) (assert* (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 (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* (not (not-any? pos-int? [1 2 3 4 5])))) + (assert-not (not-any? pos-int? [1 2 3 4 5]))) (testing "every?" - (assert* (not (pcall every?))) - (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-not (pcall every?)) + (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]))) (testing "empty?" - (assert* (not (pcall empty?))) + (assert-not (pcall empty?)) (assert* (empty? [])) (assert* (empty? {})) (assert* (empty? "")) - (assert* (not (empty? "1"))) - (assert* (not (empty? [1]))) - (assert* (not (empty? {:a 1}))) - (assert* (not (pcall empty? 10)))) + (assert-not (empty? "1")) + (assert-not (empty? [1])) + (assert-not (empty? {:a 1})) + (assert-not (pcall empty? 10))) (testing "not-empty" - (assert* (not (pcall not-empty))) + (assert-not (pcall not-empty)) (assert-eq (not-empty []) nil) (assert-eq (not-empty {}) nil) (assert-eq (not-empty "") nil) @@ -441,14 +441,14 @@ (testing "inc" (assert-eq (inc 1) 2) (assert-eq (inc -1) 0) - (assert* (not (pcall inc))) - (assert* (not (pcall inc nil)))) + (assert-not (pcall inc)) + (assert-not (pcall inc nil))) (testing "dec" (assert-eq (dec 1) 0) (assert-eq (dec -1) -2) - (assert* (not (pcall dec))) - (assert* (not (pcall dec nil))))) + (assert-not (pcall dec)) + (assert-not (pcall dec nil)))) (deftest table-access (testing "get" @@ -456,8 +456,8 @@ (assert-eq (get {:key1 10 :key2 20} :key1 false) 10) (assert-eq (get {:key1 10 :key2 20} :key3 false) false) (assert-eq (get {:key1 10 :key2 20} :key3) nil) - (assert* (not (pcall get))) - (assert* (not (pcall get {})))) + (assert-not (pcall get)) + (assert-not (pcall get {}))) (testing "get-in" (local t {:a {:b {:c 10}}}) @@ -468,8 +468,8 @@ (assert-eq (get-in t [:a :b :d] false) false) (assert-eq (get-in t [:a :b :d]) nil) (assert-eq (get-in t []) t) - (assert* (not (pcall get-in))) - (assert* (not (pcall get-in {}))))) + (assert-not (pcall get-in)) + (assert-not (pcall get-in {})))) (deftest methods (testing "methods" @@ -478,8 +478,8 @@ (defmethod f :b [_] :b) (defmethod f :c [x] (* x x)) (assert-eq (methods f) (. (getmetatable f) :multimethods)) - (assert* (not (pcall methods))) - (assert* (not (pcall methods f f)))) + (assert-not (pcall methods)) + (assert-not (pcall methods f f))) (testing "get-method" (defmulti f identity) @@ -489,9 +489,9 @@ (assert-eq ((get-method f :a) 10) :a) (assert-eq ((get-method f :b) 20) :b) (assert-eq ((get-method f :c) 4) 16) - (assert* (not (pcall get-method))) - (assert* (not (pcall get-method f))) - (assert* (not (pcall get-method f :a :b)))) + (assert-not (pcall get-method)) + (assert-not (pcall get-method f)) + (assert-not (pcall get-method f :a :b))) (testing "remove-method" (defmulti f identity) @@ -501,9 +501,9 @@ (assert-eq (get-method f :a) nil) (defmethod f :default [_] :default) (assert-eq (get-method f :a) (get-method f :default)) - (assert* (not (pcall remove-method))) - (assert* (not (pcall remove-method f))) - (assert* (not (pcall remove-method f :a :b)))) + (assert-not (pcall remove-method)) + (assert-not (pcall remove-method f)) + (assert-not (pcall remove-method f :a :b))) (testing "remove-all-methods" (defmulti f identity) @@ -512,8 +512,8 @@ (defmethod f :default [_] :default) (remove-all-methods f) (assert-eq (methods f) {}) - (assert* (not (pcall remove-all-methods))) - (assert* (not (pcall remove-all-methods f f))))) + (assert-not (pcall remove-all-methods)) + (assert-not (pcall remove-all-methods f f)))) (deftest math-functions (testing "add" @@ -544,7 +544,7 @@ (assert-eq (mul 1 2 3 4 5) 120)) (testing "div" - (assert* (not (pcall div))) + (assert-not (pcall div)) (assert-eq (div 1) 1) (assert-eq (div -1) -1) (assert-eq (div 1 2) (/ 1 2)) @@ -554,44 +554,44 @@ (deftest comparison-functions (testing "le" - (assert* (not (pcall le))) + (assert-not (pcall le)) (assert* (le 1)) (assert* (le 1 2)) (assert* (le 1 2 2)) (assert* (le 1 2 3 4)) - (assert* (not (le 2 1))) - (assert* (not (le 2 1 3))) - (assert* (not (le 1 2 4 3)))) + (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-not (pcall lt)) (assert* (lt 1)) (assert* (lt 1 2)) (assert* (lt 1 2 3)) (assert* (lt 1 2 3 4)) - (assert* (not (lt 2 1))) - (assert* (not (lt 2 1 3))) - (assert* (not (lt 1 2 4 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-not (pcall ge)) (assert* (ge 2)) (assert* (ge 2 1)) (assert* (ge 3 3 2)) (assert* (ge 4 3 2 -1)) - (assert* (not (ge 1 2))) - (assert* (not (ge 2 1 3))) - (assert* (not (ge 1 2 4 4)))) + (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-not (pcall gt)) (assert* (gt 2)) (assert* (gt 2 1)) (assert* (gt 3 2 1)) (assert* (gt 4 3 2 -1)) - (assert* (not (gt 1 2))) - (assert* (not (gt 2 1 3))) - (assert* (not (gt 1 2 4 4))))) + (assert-not (gt 1 2)) + (assert-not (gt 2 1 3)) + (assert-not (gt 1 2 4 4)))) (deftest vec (testing "vec" @@ -602,7 +602,7 @@ (deftest hash-map (testing "hash-map" - (assert* (not (pcall hash-map :a))) + (assert-not (pcall hash-map :a)) (assert-eq (hash-map) {}) (assert-eq (hash-map :a 1) {:a 1}) (assert-eq (hash-map :a 1 :b 2 :c 3) {:a 1 :b 2 :c 3}) diff --git a/test/fn.fnl b/tests/fn.fnl index ec4e835..e508541 100644 --- a/test/fn.fnl +++ b/tests/fn.fnl @@ -1,4 +1,4 @@ -(require-macros :test.test) +(require-macros :tests.test) (require-macros :cljlib-macros) (deftest fn* diff --git a/test/macros.fnl b/tests/macros.fnl index 1876126..9b2e6ac 100644 --- a/test/macros.fnl +++ b/tests/macros.fnl @@ -1,8 +1,12 @@ -(require-macros :test.test) +(require-macros :tests.test) (require-macros :cljlib-macros) (deftest into (testing "into" + (assert-eq (into [] nil) []) + (assert-eq (into nil nil) nil) + (assert-eq (into nil [1 2 3]) [1 2 3]) + (assert-eq (into [] []) []) (assert-eq (into [1 2 3] []) [1 2 3]) (assert-eq (into [1 2 3] [4 5 6]) [1 2 3 4 5 6]) @@ -11,9 +15,12 @@ (assert-eq (into {:a 1} {}) {:a 1}) (assert-eq (into {:a 1} {:b 2}) {:a 1 :b 2}) - ;; different bodies are being used so worth testing + ;; different bodies are being used at compile time so worth testing (assert-eq (into [] {}) []) (assert-eq (into {} []) []) + (assert-eq (. (getmetatable (into [] {})) :cljlib/table-type) :seq) + (assert-eq (. (getmetatable (into {} [])) :cljlib/table-type) :table) + (let [a []] (assert-eq (. (getmetatable (into a a)) :cljlib/table-type) :seq)) ;; can't transform table with more than one key-value pair, as order ;; is undeterminitive @@ -48,13 +55,13 @@ (deftest let-variants (testing "when-let" (assert-eq (when-let [a 4] a) 4) - (assert* (not (when-let [a false] a)) "(not (when-let [a false] a))") - (assert* (not (when-let [a nil] a)) "(not (when-let [a nil] a))")) + (assert-not (when-let [a false] a) "(not (when-let [a false] a))") + (assert-not (when-let [a nil] a) "(not (when-let [a nil] a))")) (testing "when-some" (assert-eq (when-some [a [1 2 3]] a) [1 2 3]) (assert-eq (when-some [a false] a) false) - (assert* (not (when-some [a nil] a)) "(when-some [a nil] a)")) + (assert-not (when-some [a nil] a) "(when-some [a nil] a)")) (testing "if-let" (assert-eq (if-let [a 4] a 10) 4) @@ -104,7 +111,30 @@ (assert-eq (encounter b b) :mate) (assert-eq (encounter l l) :fight) (assert-eq (encounter b l) :run) - (assert-eq (encounter l b) :eat)))) + (assert-eq (encounter l b) :eat))) + + (testing "defmulti default name" + (defmulti f (fn [x] x) :default :my-default) + (defmethod f :my-default [_] 42) + (assert-eq (f 10) 42)) + + + (testing "defmulti docstring" + (defmulti f "documentation" (fn [x] x)) + (assert-eq (meta f) (when-meta {:fnl/docstring "documentation"})) + (defmulti g "documentation" (fn [x] x) :default 0) + (assert-eq (meta g) (when-meta {:fnl/docstring "documentation"}))) + + (testing "defmulti with multiple arity" + (defmulti f (fn* ([x] x) ([x y] [x y]))) + (defmethod f :default ([_] :def) ([_ _] :def2)) + (defmethod f :4 ([x] (.. x :2))) + (defmethod f [:4 :2] ([x y] 42)) + + (assert-eq (f 0) :def) + (assert-eq (f 0 1) :def2) + (assert-eq (f :4) :42) + (assert-eq (f :4 :2) 42))) (deftest def-macros (testing "def" diff --git a/test/test.fnl b/tests/test.fnl index a83b510..f678b6b 100644 --- a/test/test.fnl +++ b/tests/test.fnl @@ -43,16 +43,20 @@ [expr msg] `(assert ,expr (.. "assertion failed for " (or ,msg ,(tostring expr))))) +(fn test.assert-not + [expr msg] + `(assert (not ,expr) (.. "assertion failed for " + (or ,msg ,(tostring expr))))) (fn test.deftest [name ...] "Simple way of grouping tests" - `,((or table.unpack _G.unpack) [...])) + `(do ,...)) (fn test.testing [description ...] - "Define test function, print its name and run it." + "Print test description and run it." `(do (io.stderr:write (.. "testing: " ,description "\n")) - ,((or table.unpack _G.unpack) [...]))) + ,...)) test |