diff options
| -rw-r--r-- | macros.fnl | 33 | ||||
| -rw-r--r-- | tests/fn.fnl | 16 | ||||
| -rw-r--r-- | tests/test.fnl | 9 |
3 files changed, 39 insertions, 19 deletions
@@ -238,11 +238,11 @@ returns the value without additional metadata. (string.format "%q" data) (tostring data)))) -(fn gen-arglist-doc [args] +(fn gen-arglist-doc [args method?] (if (list? (. args 1)) (let [arglist []] (each [_ v (ipairs args)] - (let [arglist-doc (gen-arglist-doc v)] + (let [arglist-doc (gen-arglist-doc v method?)] (when (next arglist-doc) (table.insert arglist (table.concat arglist-doc " "))))) (when (and (> (length (table.concat arglist " ")) 60) @@ -253,7 +253,9 @@ returns the value without additional metadata. (sequence? (. args 1)) (let [arglist [] - args (. args 1) + args (if method? + [(sym :self) (table.unpack (. args 1))] + (. args 1)) len (length args)] (if (= len 0) (table.insert arglist "([])") @@ -280,7 +282,7 @@ returns the value without additional metadata. (assert-compile false "only one `more' argument can be supplied after `&' in arglist." args))) res) -(fn gen-arity [[args & body]] +(fn gen-arity [[args & body] method?] ;; Forms three values, representing data needed to create dispatcher: ;; ;; - the length of arglist; @@ -289,6 +291,7 @@ returns the value without additional metadata. (assert-compile (sequence? args) "fn*: expected parameters table. * Try adding function parameters as a list of identifiers in brackets." args) + (when method? (table.insert args 1 (sym :self))) (values (length args) (list 'let [args ['...]] (list 'do ((or table.unpack _G.unpack) body))) (has-amp? args))) @@ -359,11 +362,11 @@ returns the value without additional metadata. (if name (.. " for " name) "")) 2))) bodies)) -(fn single-arity-body [args fname] +(fn single-arity-body [args fname method?] ;; Produces arglist and body for single-arity function. ;; For more info check `gen-arity' documentation. (let [[args & body] args - (arity body amp) (gen-arity [args ((or table.unpack _G.unpack) body)])] + (arity body amp) (gen-arity [args ((or table.unpack _G.unpack) body)] method?)] `(let [len# (select :# ...)] ,(arity-dispatcher 'len# @@ -371,13 +374,13 @@ returns the value without additional metadata. (if amp [amp body]) fname)))) -(fn multi-arity-body [args fname] +(fn multi-arity-body [args fname method?] ;; Produces arglist and all body forms for multi-arity function. ;; For more info check `gen-arity' documentation. (let [bodies {} ;; bodies of fixed arity amp-bodies []] ;; bodies where arglist contains `&' (each [_ arity (ipairs args)] - (let [(n body amp) (gen-arity arity)] + (let [(n body amp) (gen-arity arity method?)] (if amp (table.insert amp-bodies [amp body arity]) (tset bodies n body)))) @@ -392,6 +395,13 @@ returns the value without additional metadata. (. amp-bodies 1)) fname)))) +(fn method? [s] + (when (sym? s) + (let [(res n) (-> s + tostring + (string.find ":"))] + (and res (> n 1))))) + (fn demethodize [s] (-> s tostring @@ -527,14 +537,15 @@ from `ns.strings`, so the latter must be fully qualified (let [docstring (if (string? doc?) doc? nil) (name-wo-namespace namespaced?) (multisym->sym name) fname (if (sym? name-wo-namespace) (tostring name-wo-namespace)) + method? (method? name) name (demethodize name) args (if (sym? name-wo-namespace) (if (string? doc?) [...] [doc? ...]) [name-wo-namespace doc? ...]) - arglist-doc (gen-arglist-doc args) + arglist-doc (gen-arglist-doc args method?) [x] args - body (if (sequence? x) (single-arity-body args fname) - (list? x) (multi-arity-body args fname) + body (if (sequence? x) (single-arity-body args fname method?) + (list? x) (multi-arity-body args fname method?) (assert-compile false "fn*: expected parameters table. * Try adding function parameters as a list of identifiers in brackets." x))] diff --git a/tests/fn.fnl b/tests/fn.fnl index 40dda8b..5697aab 100644 --- a/tests/fn.fnl +++ b/tests/fn.fnl @@ -61,16 +61,24 @@ (testing "fn* methods" (local ns {:a 1 :b 2}) - (fn* ns:foo [self] + (fn* ns:foo [] (+ self.a self.b)) (assert-eq (ns:foo) 3) (assert-not (pcall #(ns:foo 1))) (assert-not (pcall #(ns:foo 1 2))) (fn* ns:bar - ([self x] (+ self.a x)) - ([self x y] (+ self.b x y))) + ([x] (+ self.a x)) + ([x y] (+ self.b x y))) (assert-eq (ns:bar -1) 0) (assert-eq (ns:bar 10 20) 32) (assert-not (pcall #(ns:bar))) - (assert-not (pcall #(ns:bar 1 2 3))))) + (assert-not (pcall #(ns:bar 1 2 3)))) + + (testing "fn* anonymous calls" + (assert-eq ((fn* [])) (values)) + (assert-eq ((fn* [] nil)) nil) + (assert-eq ((fn* [x] x) 5) 5) + (assert-eq ((fn* [a b c d e] [e d c b a]) 1 2 3 4 5) [5 4 3 2 1]) + (assert-eq ((fn* ([x] x) ([x y] [y x])) 10) 10) + (assert-eq ((fn* ([x] x) ([x y] [y x])) 10 20) [20 10]))) diff --git a/tests/test.fnl b/tests/test.fnl index 05da7be..43247d9 100644 --- a/tests/test.fnl +++ b/tests/test.fnl @@ -60,7 +60,7 @@ Deep compare values: right# ,expr2 eq# ,(eq-fn) fennel# (require :fennel)] - (assert (eq# left# right#) + (assert (pick-values 1 (pcall #(do eq# left# right#))) (or ,msg (.. "assertion failed for expression: (= " ,(view expr1 {:one-line? true}) " " ,(view expr2 {:one-line? true}) ") Left: " (fennel#.view left# {:one-line? true}) " @@ -75,7 +75,7 @@ Deep compare values: right# ,expr2 eq# ,(eq-fn) fennel# (require :fennel)] - (assert (not (eq# left# right#)) + (assert (pick-values 1 (pcall #(not (eq# left# right#)))) (or ,msg (.. "assertion failed for expression: (not= " ,(view expr1 {:one-line? true}) " " ,(view expr2 {:one-line? true}) ") Left: " (fennel#.view left# {:one-line? true}) " @@ -90,14 +90,15 @@ Deep compare values: ;; (assert-is (= 1 2 3)) ;; => runtime error: assertion failed for (= 1 2 3) ```" - `(assert ,expr + `(assert (pick-values 1 (pcall #(do ,expr))) (.. "assertion failed: " (or ,msg ,(view expr {:one-line? true}))))) + (fn test.assert-not [expr msg] "Assert `expr` for not truth. Generates more verbose message if `msg` is not set. Works the same as [`assert-is`](#assert-is)." - `(assert (not ,expr) + `(assert (pick-values 1 (pcall #(not ,expr))) (.. "assertion failed: " (or ,msg ,(view expr {:one-line? true}))))) |