git.m455.casa

fa

clone url: git://git.m455.casa/fa

esperbuild/espersrc/fennel-0.7.0/test/core.fnl

1 (local l (require :test.luaunit))
2 (local fennel (require :fennel))
3
4 (set _G.tbl [])
5
6 (fn test-calculations []
7 (let [cases {"(% 1 2 (- 1 2))" 0
8 "(* 1 2 (/ 1 2))" 1
9 "(*)" 1
10 "(+ 1 2 (- 1 2))" 2
11 "(+ 1 2 (^ 1 2))" 4
12 "(+)" 0
13 "(- 1)" (- 1)
14 "(/ 2)" (/ 1 2)}]
15 (each [code expected (pairs cases)]
16 (l.assertEquals (fennel.eval code {:correlate true}) expected code))))
17
18 (fn test-booleans []
19 (let [cases {"(and 43 table false)" false
20 "(and 5)" 5
21 "(and true 12 \"hey\")" "hey"
22 "(and)" true
23 "(not 39)" false
24 "(not nil)" true
25 "(not true)" false
26 "(or 11 true false)" 11
27 "(or 5)" 5
28 "(or false nil true 12 false)" true
29 "(or)" false}]
30 (each [code expected (pairs cases)]
31 (l.assertEquals (fennel.eval code {:correlate true}) expected code))))
32
33 (fn test-comparisons []
34 (let [cases {"(< -4 89)" true
35 "(<= 5 1 91)" false
36 "(<= 88 32)" false
37 "(= 1 1 2 2)" false
38 "(> -4 89)" false
39 "(> 2 0 -1)" true
40 "(> 2 0)" true
41 "(>= 22 (+ 21 1))" true
42 "(let [f (fn [] (tset tbl :dbl (+ 1 (or (. tbl :dbl) 0))) 1)]
43 (< 0 (f) 2) (. tbl :dbl))" 1
44 "(not= 33 1)" true
45 "(not= 6 6 9)" true
46 "(~= 33 1)" true ; undocumented backwards-compat alias
47 }]
48 (each [code expected (pairs cases)]
49 (l.assertEquals (fennel.eval code {:correlate true}) expected code))))
50
51 (fn test-parsing []
52 (set _G.parsedbg true)
53 (let [cases {"\"\\\\\"" "\\"
54 "\"abc\n\\240\"" "abc\n\240"
55 "\"abc\\\"def\"" "abc\"def"
56 "\"abc\\240\"" "abc\240"
57 :150_000 150000}]
58 (each [code expected (pairs cases)]
59 (l.assertEquals (fennel.eval code {:correlate true}) expected code))))
60
61 (fn test-functions []
62 (let [cases {;; regular function
63 "((fn [x] (* x 2)) 26)" 52
64 ;; basic lambda
65 "((lambda [x] (+ x 2)) 4)" 6
66 ;; vararg lambda
67 "((lambda [x ...] (+ x 2)) 4)" 6
68 ;; underscore lambda
69 "((lambda [x _ y] (+ x y)) 4 5 6)" 10
70 ;; lambdas perform arity checks
71 "(let [(ok e) (pcall (lambda [x] (+ x 2)))]
72 (string.match e \"Missing argument x\"))" "Missing argument x"
73 ;; lambda arity checks skip argument names starting with ?
74 "(let [(ok val) (pcall (λ [?x] (+ (or ?x 1) 8)))] (and ok val))" 9
75 ;; lambda with no body returns nil
76 "(if (= nil ((lambda [a]) 1)) :lambda-works)" :lambda-works
77 ;; closures can set vars they close over
78 "(var a 11) (let [f (fn [] (set a (+ a 2)))] (f) (f) a)" 15
79 ;; nested functions
80 "(let [f (fn [x y f2] (+ x (f2 y)))
81 f2 (fn [x y] (* x (+ 2 y)))
82 f3 (fn [f] (fn [x] (f 5 x)))]
83 (f 9 5 (f3 f2)))" 44
84
85 ;; pick-args
86 "((pick-args 5 (partial select :#)))" 5
87 "(let [f (fn [...] [...]) f-0 (pick-args 0 f)] (f-0 :foo))" []
88 "(let [f (fn [...] [...]) f-2 (pick-args 2 f)] (f-2 1 2 3))" [1 2]
89 ;; pick-values
90 "(select :# (pick-values 3))" 3
91 "(let [f #(values :a :b :c)] [(pick-values 0 (f))])" []
92 "[(pick-values 4 :a :b :c (values :d :e))]" ["a" "b" "c" "d"]
93
94 ;; method calls work
95 "(: :hello :find :e)" 2
96 ;; method calls work on identifiers that aren't valid lua
97 "(let [f {:+ #(+ $2 $3 $4)}] (f:+ 1 2 9))" 12
98 ;; method calls work non-native with no args
99 "(let [f {:+ #18}] (f:+))" 18
100 ;; method calls don't double up side effects
101 "(var a 0) (let [f (fn [] (set a (+ a 1)) :hi)] (: (f) :find :h)) a" 1
102
103 ;; functions with empty bodies return nil
104 "(if (= nil ((fn [a]) 1)) :pass :fail)" "pass"
105
106 ;; partial application
107 "(let [add (fn [x y z] (+ x y z)) f2 (partial add 1 2)] (f2 6))" 9
108 "(let [add (fn [x y] (+ x y)) add2 (partial add)] (add2 99 2))" 101
109 "(let [add (fn [x y] (+ x y)) inc (partial add 1)] (inc 99))" 100
110
111 ;; many args
112 "((fn f [a sin cos radC cx cy x y limit dis] sin) 8 529)" 529
113 }]
114 (each [code expected (pairs cases)]
115 (l.assertEquals (fennel.eval code {:correlate true}) expected code))))
116
117 (fn test-conditionals []
118 (let [cases {"(if _G.non-existent 1 (* 3 9))" 27
119 "(if false \"yep\" \"nope\")" "nope"
120 "(if false :y true :x :trailing :condition)" "x"
121 "(let [b :original b (if false :not-this)] (or b :nil))" "nil"
122 "(let [x 1 y 2] (if (= (* 2 x) y) \"yep\"))" "yep"
123 "(let [x 3 res (if (= x 1) :ONE (= x 2) :TWO true :???)] res)" "???"
124 "(let [x {:y 2}] (if false \"yep\" (< 1 x.y 3) \"uh-huh\" \"nope\"))" "uh-huh"
125 "(var [a z] [0 0]) (when true (set a 192) (set z 12)) (+ z a)" 204
126 "(var a 884) (when nil (set a 192)) a" 884
127 "(var i 0) (var s 0) (while (let [l 11] (< i l)) (set s (+ s i)) (set i (+ 1 i))) s" 55
128 "(var x 12) (if true (set x 22) 0) x" 22
129 "(when (= 12 88) (os.exit 1)) false" false
130 "(while (let [f false] f) (lua :break))" nil}]
131 (each [code expected (pairs cases)]
132 (l.assertEquals (fennel.eval code {:correlate true}) expected code))))
133
134 (fn test-core []
135 (let [cases {"(+ (. {:a 93 :b 4} :a) (. [1 2 3] 2))" 95
136 "(: {:foo (fn [self] (.. self.bar 2)) :bar :baz} :foo)" "baz2"
137 "(do (tset {} :a 1) 1)" 1
138 "(do (var a nil) (var b nil) (local ret (fn [] a)) (set (a b) (values 4 5)) (ret))" 4
139 "(fn b [] (each [e {}] (e))) (let [(_ e) (pcall b)] (e:match \":[1]: .*\"))" ":1: attempt to call a table value"
140 "(global a_b :global) (local a-b :local) a_b" "global"
141 "(global x 1) (global x 284) x" 284
142 "(let [k 5 t {: k}] t.k)" 5
143 "(let [my-tbl {} k :key] (tset my-tbl k :val) my-tbl.key)" "val"
144 "(let [t [[21]]] (+ (. (. t 1) 1) (. t 1 1)))" 42
145 "(let [t []] (table.insert t \"lo\") (. t 1))" "lo"
146 "(let [t []] (tset t :a (let [{: a} {:a :bcd}] a)) t.a)" "bcd"
147 "(let [t {} _ (tset t :a 84)] (. t :a))" 84
148 "(let [t {}] (set t.a :multi) (. t :a))" "multi"
149 "(let [x 17] (. 17))" 17
150 "(let [x 3 y nil z 293] z)" 293
151 "(let [xx (let [xx 1] (* xx 2))] xx)" 2
152 "(local a 3) (let [b 2] (set-forcibly! a 7) (set-forcibly! b 6) (+ a b))" 13
153 "(local x#x# 90) x#x#" 90
154 "(table.concat [\"ab\" \"cde\"] \",\")" "ab,cde"
155 "(var [x y] [3 2]) (set (x y) (do (local [x y] [(* x 3) 0]) (values x y))) (+ x y)" 9
156 "(var a 0) (for [_ 1 3] (let [] (table.concat []) (set a 33))) a" 33
157 "(var i 0) (each [_ ((fn [] (pairs [1])))] (set i 1)) i" 1
158 "(var n 0) (let [f (fn [] (set n 96))] (f) n)" 96
159 "(var x 1) (let [_ (set x 92)] x)" 92
160 "(var x 12) ;; (set x 99)\n x" 12
161 "74 ; (require \"hey.dude\")" 74}]
162 (each [code expected (pairs cases)]
163 (l.assertEquals (fennel.eval code {:correlate true}) expected code))))
164
165 (fn test-if []
166 (let [cases {"(do (fn myfn [x y z] (+ x y z)) (myfn 1 (if 1 (values 2 5) 3) 4))" 7
167 "(do (fn myfn [x y z] (+ x y z)) (myfn 1 (if 1 2 3) 4))" 7
168 "(do (fn myfn [x y z] (+ x y z)) (myfn 1 4 (if 1 2 3)))" 7
169 "(if (values 1 2) 3 4)" 3
170 "(if (values 1) 3 4)" 3
171 "(let [x (if false 3 (values 2 5))] x)" 2}]
172 (each [code expected (pairs cases)]
173 (l.assertEquals (fennel.eval code {:correlate true}) expected code))))
174
175 (fn test-destructuring []
176 (let [cases {"((fn dest [a [b c] [d]] (+ a b c d)) 5 [9 7] [2])" 23
177 "((lambda [[a & b]] (+ a (. b 2))) [90 99 4])" 94
178 "(global (a b) ((fn [] (values 4 29)))) (+ a b)" 33
179 "(global [a b c d] [4 2 43 7]) (+ (* a b) (- c d))" 44
180 "(let [(a [b [c] d]) ((fn [] (values 4 [2 [1] 9])))] (+ a b c d))" 16
181 "(let [(a [b [c] d]) (values 4 [2 [1] 9])] (+ a b c d))" 16
182 "(let [(a b) ((fn [] (values 4 2)))] (+ a b))" 6
183 "(let [[a [b c] d] [4 [2 43] 7]] (+ (* a b) (- c d)))" 44
184 "(let [[a b & c] [1 2 3 4 5]] (+ a (. c 2) (. c 3)))" 10
185 "(let [[a b c d] [4 2 43 7]] (+ (* a b) (- c d)))" 44
186 "(let [[a b c] [4 2]] (or c :missing))" "missing"
187 "(let [[a b] [9 2 49]] (+ a b))" 11
188 "(let [x 1 x (if (= x 1) 2 3)] x)" 2
189 "(let [{: a : b} {:a 3 :b 5}] (+ a b))" 8
190 "(let [{:a [x y z]} {:a [1 2 4]}] (+ x y z))" 7
191 "(let [{:a x :b y} {:a 2 :b 4}] (+ x y))" 6
192 "(local (-a -b) ((fn [] (values 4 29)))) (+ -a -b)" 33
193 "(var [a [b c]] [1 [2 3]]) (set a 2) (set c 8) (+ a b c)" 12
194 "(var x 0) (each [_ [a b] (ipairs [[1 2] [3 4]])] (set x (+ x (* a b)))) x" 14}]
195 (each [code expected (pairs cases)]
196 (l.assertEquals (fennel.eval code {:correlate true}) expected code))))
197
198 (fn test-loops []
199 (let [cases {"(for [y 0 2] nil) (each [x (pairs [])] nil)
200 (match [1 2] [x y] (+ x y))" 3
201 "(let [t {:a 1 :b 2} t2 {}]
202 (each [k v (pairs t)]
203 (tset t2 k v))
204 (+ t2.a t2.b))" 3
205 "(var t 0) (local (f s v) (pairs [1 2 3]))
206 (each [_ x (values f (doto s (table.remove 1)))] (set t (+ t x))) t" 5
207 "(var t 0) (local (f s v) (pairs [1 2 3]))
208 (each [_ x (values f s v)] (set t (+ t x))) t" 6
209 "(var x 0) (for [y 1 20 2] (set x (+ x 1))) x" 10
210 "(var x 0) (for [y 1 5] (set x (+ x 1))) x" 5
211 "(var x 0) (while (< x 7) (set x (+ x 1))) x" 7}]
212 (each [code expected (pairs cases)]
213 (l.assertEquals (fennel.eval code) expected code))))
214
215 (fn test-edge []
216 (let [cases {"(. (let [t (let [t {} k :a] (tset t k 123) t) k :b] (tset t k 321) t) :a)" 123
217 "(length [(if (= (+ 1 1) 2) (values 1 2 3 4 5) (values 1 2 3))])" 5
218 "(length [(values 1 2 3 4 5)])" 5
219 "(let [(a b c d e f g) (if (= (+ 1 1) 2) (values 1 2 3 4 5 6 7))] (+ a b c d e f g))" 28
220 "(let [(a b c d e f g) (if (= (+ 1 1) 3) nil
221 ((or _G.unpack table.unpack) [1 2 3 4 5 6 7]))]
222 (+ a b c d e f g))" 28
223 "(let [t {:st {:v 5 :f #(+ $.v $2)}} x (#(+ $ $2) 1 3)] (t.st:f x) nil)" nil
224 "(let [x (if 3 4 5)] x)" 4
225 "(select \"#\" (if (= 1 (- 3 2)) (values 1 2 3 4 5) :onevalue))" 5
226 (.. "(do (local c1 20) (local c2 40) (fn xyz [A B] (and A B)) "
227 "(xyz (if (and c1 c2) true false) 52))") 52
228 "(let [t {} _ (set t.field :let-side)] t.field)" :let-side}]
229 (each [code expected (pairs cases)]
230 (l.assertEquals (fennel.eval code {:correlate true}) expected code))))
231
232 (fn test-hashfn []
233 (let [cases {"(#$.foo {:foo :bar})" "bar"
234 "(#$2.foo.bar.baz nil {:foo {:bar {:baz :quux}}})" "quux"
235 "(#(+ $ 2) 3)" 5
236 "(#(+ $1 $2) 3 4)" 7
237 "(#(+ $1 45) 1)" 46
238 "(#(+ $3 $4) 1 1 3 4)" 7
239 "(#[(select :# $...) $...] :a :b :c)" [3 "a" "b" "c"]
240 "(+ (#$ 1) (#$2 2 3))" 4
241 "(let [f #(+ $ $1 $2)] (f 1 2))" 4
242 "(let [f #(+ $1 45)] (f 1))" 46
243 "(let [f #(do (local a 1) (local b (+ $1 $1 a)) (+ a b))] (f 1))" 4}]
244 (each [code expected (pairs cases)]
245 (l.assertEquals (fennel.eval code {:correlate true}) expected code))))
246
247 (fn test-method_calls []
248 (let [cases {"(let [x {:foo (fn [self arg1] (.. self.bar arg1)) :bar :baz}] (x:foo :quux))"
249 "bazquux"
250 "(let [x {:y {:foo (fn [self arg1] (.. self.bar arg1)) :bar :baz}}] (x.y:foo :quux))"
251 "bazquux"}]
252 (each [code expected (pairs cases)]
253 (l.assertEquals (fennel.eval code {:correlate true}) expected code))))
254
255 (fn test-with-open []
256 (let [cases {"(var (fh1 fh2) nil) [(with-open [f1 (io.tmpfile) f2 (io.tmpfile)]
257 (set [fh1 fh2] [f1 f2]) (f1:write :asdf) (f1:seek :set 0) (f1:read :*a))
258 (io.type fh1) (io.type fh2)]" ["asdf" "closed file" "closed file"]
259 "(var fh nil) (local (ok msg) (pcall #(with-open [f (io.tmpfile)] (set fh f)
260 (error :bork!)))) [(io.type fh) ok (msg:match :bork!)]" ["closed file" false "bork!"]
261 "[(with-open [proc1 (io.popen \"echo hi\") proc2 (io.popen \"echo bye\")]
262 (values (proc1:read) (proc2:read)))]" ["hi" "bye"]}]
263 (each [code expected (pairs cases)]
264 (l.assertEquals (fennel.eval code) expected code))))
265
266 (fn test-match []
267 (let [cases {"(let [_ :bar] (match :foo _ :should-match :foo :no))" "should-match"
268 "(let [k :k] (match [5 :k] :b :no [n k] n))" 5
269 "(let [s :hey] (match s :wat :no :hey :yes))" "yes"
270 "(let [x 3 res (match x 1 :ONE 2 :TWO _ :???)] res)" "???"
271 "(let [x 95] (match [52 85 95] [x y z] :nope [a b x] :yes))" "yes"
272 "(let [x {:y :z}] (match :z x.y 1 _ 0))" 1
273 "(match (+ 1 6) 7 8 8 1 9 2)" 8
274 "(match (+ 1 6) 7 8)" 8
275 "(match (io.open \"/does/not/exist\") (nil msg) :err f f)" "err"
276 "(match (values 1 [1 2]) (x [x x]) :no (x [x y]) :yes)" "yes"
277 "(match (values 5 9) 9 :no (a b) (+ a b))" 14
278 "(match (values nil :nonnil) (true _) :no (nil b) b)" "nonnil"
279 "(match [1 2 1] [x y x] :yes)" "yes"
280 "(match [1 2 3] [3 2 1] :no [2 9 1] :NO :default)" "default"
281 "(match [1 2 3] [a & b] (+ a (. b 1) (. b 2)))" 6
282 "(match [1 2 3] [x y x] :no [x y z] :yes)" "yes"
283 "(match [1 2 [[1]]] [x y [z]] (. z 1))" 1
284 "(match [1 2 [[3]]] [x y [[x]]] :no [x y z] :yes)" "yes"
285 "(match [1 2] [_ _] :wildcard)" "wildcard"
286 "(match [1] [a & b] (# b))" 0
287 "(match [1] [a & b] (length b))" 0
288 "(match [9 5] [a b ?c] :three [a b] (+ a b))" "three"
289 "(match [9 5] [a b c] :three [a b] (+ a b))" 14
290 "(match [:a :b :c] [1 t d] :no [a b :d] :NO [a b :c] b)" "b"
291 "(match [:a :b :c] [a b c] (.. b :eee))" "beee"
292 "(match [:a [:b :c]] [a b :c] :no [:a [:b c]] c)" "c"
293 "(match [:a {:b 8}] [a b :c] :no [:a {:b b}] b)" 8
294 "(match [{:sieze :him} 5]
295 ([f 4] ? f.sieze (= f.sieze :him)) 4
296 ([f 5] ? f.sieze (= f.sieze :him)) 5)" 5
297 "(match nil _ :yes nil :no)" "yes"
298 "(match {:a 1 :b 2} {:c 3} :no {:a n} n)" 1
299 "(match {:sieze :him}
300 (tbl ? (. tbl :no)) :no
301 (tbl ? (. tbl :sieze)) :siezed)" "siezed"
302 "(match {:sieze :him}
303 (tbl ? tbl.sieze tbl.no) :no
304 (tbl ? tbl.sieze (= tbl.sieze :him)) :siezed2)" "siezed2"
305 "(var x 1) (fn i [] (set x (+ x 1)) x) (match (i) 4 :N 3 :n 2 :y)" "y"}]
306 (each [code expected (pairs cases)]
307 (l.assertEquals (fennel.eval code {:correlate true}) expected code))))
308
309 (fn test-fennelview []
310 (let [cases {"((require :fennelview) (let [t {}] [t t]) {:detect-cycles? false})"
311 "[{} {}]"
312 "((require :fennelview) (let [t {}] [t t]))"
313 "[@2{} #<table @2>]"
314 "((require :fennelview) {:a 1 :b 52})"
315 "{
316 :a 1
317 :b 52
318 }"
319 "((require :fennelview) {:a 1 :b 5} {:one-line true})"
320 "{:a 1 :b 5}"
321 ;; ensure it works on lists/syms inside compiler
322 "(eval-compiler
323 (set _G.out ((require :fennelview) '(a {} [1 2]))))
324 _G.out"
325 "(a {} [1 2])"}]
326 (each [code expected (pairs cases)]
327 (l.assertEquals (fennel.eval code {:correlate true :compiler-env _G})
328 expected code))
329 (let [mt (setmetatable [] {:__fennelview (fn [] "META")})]
330 (l.assertEquals ((require "fennelview") mt) "META"))))
331
332 (fn test-comment []
333 (l.assertEquals "-- hello world\nreturn nil"
334 (fennel.compile-string "(comment hello world)")))
335
336 {: test-booleans
337 : test-calculations
338 : test-comparisons
339 : test-conditionals
340 : test-core
341 : test-destructuring
342 : test-edge
343 : test-fennelview
344 : test-functions
345 : test-hashfn
346 : test-if
347 : test-loops
348 : test-with-open
349 : test-match
350 : test-method_calls
351 : test-parsing
352 : test-comment}