1(local l (require :test.luaunit))
2(local fennel (require :fennel))
3(local specials (require :fennel.specials))
4
5(fn wrap-repl [options]
6  (var repl-complete nil)
7  (fn send []
8    (var output [])
9    (let [opts (or options {})]
10      (fn opts.readChunk []
11        (let [chunk (coroutine.yield output)]
12          (set output [])
13          (and chunk (.. chunk "\n"))))
14      (fn opts.onValues [x]
15        (when (not= :function (type (. x 1)))
16          (table.insert output (table.concat x "\t"))))
17      (fn opts.onError [e-type e lua-src]
18        (table.insert output (.. "error: " e)))
19      (fn opts.registerCompleter [x]
20        (set repl-complete x))
21      (fn opts.pp [x] x)
22      (fennel.repl opts)))
23  (let [repl-send (coroutine.wrap send)]
24    (repl-send)
25    (values repl-send repl-complete)))
26
27(fn assert-equal-unordered [a b msg]
28  (l.assertEquals (table.sort a) (table.sort b) msg))
29
30(fn test-local-completion []
31  (let [(send comp) (wrap-repl)]
32    (send "(local [foo foo-ba* moe-larry] [1 2 {:*curly* \"Why soitenly\"}])")
33    (send "(local [!x-y !x_y] [1 2])")
34    (assert-equal-unordered (comp "foo") ["foo" "foo-ba*"]
35                            "local completion works & accounts for mangling")
36    (assert-equal-unordered (comp "moe-larry") ["moe-larry.*curly*"]
37                            (.. "completion traverses tables without mangling"
38                                " keys when input is \"tbl-var.\""))
39    (assert-equal-unordered (send "(values !x-y !x_y)") [[1 2]]
40                            "mangled locals do not collide")
41    (assert-equal-unordered (comp "!x") ["!x_y" "!x-y"]
42                            "completions on mangled locals do not collide")
43    (send "(local dynamic-index (setmetatable {:a 1 :b 2} {:__index #($2:upper)}))")
44    (assert-equal-unordered (comp "dynamic-index.") [:dynamic-index.a :dynamic-index.b]
45                            "completion doesn't error on table with a fn on mt.__index")
46    (let [(ok msg) (pcall send ",complete ]")]
47      (l.assertTrue ok "shouldn't kill the repl on a parse error"))))
48
49(fn test-macro-completion []
50  (let [(send comp) (wrap-repl)]
51    (send "(local mac {:incremented 9 :unsanitary 2})")
52    (send "(import-macros mac :test.macros)")
53    (let [[c1 c2 c3] (doto (comp "mac.i") table.sort)]
54      ;; local should be shadowed!
55      (l.assertNotEquals c1 "mac.incremented")
56      (l.assertNotEquals c2 "mac.incremented")
57      (l.assertNil c3))))
58
59(fn test-method-completion []
60  (let [(send comp) (wrap-repl)]
61    (send "(local ttt {:abc 12 :fff (fn [] :val) :inner {:foo #:f :fa #:f}})")
62    (l.assertEquals (comp "ttt:f") ["ttt:fff"] "method completion works on fns")
63    (assert-equal-unordered (comp "ttt.inner.f") ["ttt:foo" "ttt:fa"]
64                            "method completion nests")
65    (l.assertEquals (comp "ttt:ab") [] "no method completion on numbers")))
66
67(fn test-help []
68  (let [send (wrap-repl)
69        help (table.concat (send ",help"))]
70    (l.assertStrContains help "Show this message")
71    (l.assertStrContains help "enter code to be evaluated")))
72
73(fn test-exit []
74  (let [send (wrap-repl)
75        _ (send ",exit")
76        (ok? msg) (pcall send ":more")]
77    (l.assertFalse ok?)
78    (l.assertEquals msg "cannot resume dead coroutine")))
79
80(var dummy-module nil)
81
82(fn dummy-loader [module-name]
83  (if (= :dummy module-name)
84      #dummy-module))
85
86(fn test-reload []
87  (set dummy-module {:dummy :first-load})
88  (table.insert (or package.searchers package.loaders) dummy-loader)
89  (let [dummy (require :dummy)
90        dummy-first-contents dummy.dummy
91        send (wrap-repl)]
92    (set dummy-module {:dummy :reloaded})
93    (send ",reload dummy")
94    (l.assertEquals :first-load dummy-first-contents)
95    (l.assertEquals :reloaded dummy.dummy)))
96
97(fn test-reset []
98  (let [send (wrap-repl)
99        _ (send "(local abc 123)")
100        abc (table.concat (send "abc"))
101        _ (send ",reset")
102        abc2 (table.concat (send "abc"))]
103    (l.assertEquals abc "123")
104    (l.assertEquals abc2 "")))
105
106(fn set-boo [env]
107  "Set boo to exclaimation points."
108  (tset env :boo "!!!"))
109
110(fn test-plugins []
111  (let [logged []
112        plugin1 {:repl-command-log #(table.insert logged (select 2 ($2)))
113                 :versions [(fennel.version:gsub "-dev" "")]}
114        plugin2 {:repl-command-log #(error "p1 should handle this!")
115                 :repl-command-set-boo set-boo
116                 :versions [(fennel.version:gsub "-dev" "")]}
117        send (wrap-repl {:plugins [plugin1 plugin2] :allowedGlobals false})]
118    (send ",log :log-me")
119    (l.assertEquals logged ["log-me"])
120    (send ",set-boo")
121    (l.assertEquals (send "boo") ["!!!"])
122    (l.assertStrContains (table.concat (send ",help")) "Set boo to")))
123
124(fn test-options []
125  ;; ensure options.useBitLib propagates to repl
126  (let [send (wrap-repl {:useBitLib true :onError (fn [e] (values :ERROR e))})
127        bxor-result (send "(bxor 0 0)")]
128    (if _G.jit
129      (l.assertEquals bxor-result [:0])
130      (l.assertStrContains (. bxor-result 1) "error:.*attempt to index.*global 'bit'"
131                           "--use-bit-lib should make bitops fail in non-luajit"))))
132
133(fn test-apropos []
134  (local send (wrap-repl))
135  (let [res (. (send ",apropos table%.") 1)]
136    (each [_ k (ipairs ["table.concat" "table.insert" "table.remove"
137                        "table.sort"])]
138      (l.assertStrContains res k)))
139  (let [res (. (send ",apropos not-found") 1)]
140    (l.assertEquals res "" "apropos returns no results for unknown pattern")
141    (l.assertEquals
142     (doto (icollect [item (res:gmatch "[^%s]+")] item)
143       (table.sort))
144     []
145     "apropos returns no results for unknown pattern"))
146  (let [res (. (send ",apropos-doc function") 1)]
147    (l.assertStrContains res "partial" "apropos returns matching doc patterns")
148    (l.assertStrContains res "pick%-args" "apropos returns matching doc patterns"))
149  (let [res (. (send ",apropos-doc \"there's no way this could match\"") 1)]
150    (l.assertEquals res "" "apropos returns no results for unknown doc pattern")))
151
152(fn test-byteoffset []
153  (let [send (wrap-repl)
154        _ (send "(macro b [x] (view (getmetatable x)))")
155        _ (send "(macro f [x] (assert-compile false :lol-no x))")
156        out (table.concat (send "(b [1])"))
157        out2 (table.concat (send "(b [1])"))
158        out3 (table.concat (send "   (f [123])"))]
159    (l.assertEquals out out2 "lines and byte offsets should be stable")
160    (l.assertStrContains out ":bytestart 5")
161    (l.assertStrContains out ":byteend 7")
162    (l.assertStrContains out3 "   (f [123])\n      ^^^^^")))
163
164(fn test-code []
165  (let [(send comp) (wrap-repl)]
166    (send "(local {: foo} (require :test.mod.foo7))")
167    ;; repro case for https://todo.sr.ht/~technomancy/fennel/85
168    (l.assertEquals (send "(foo)") [:foo])
169    (l.assertEquals (comp "fo") [:for :foo])))
170
171(fn test-source-offset []
172  (let [(send comp) (wrap-repl)]
173    ;; we get the source in the error message
174    (l.assertStrContains (. (send "(let a)") 1) "(let a)\n     ^")
175    ;; repeated errors still get it
176    (l.assertStrContains (. (send "(let b)") 1) "(let b)\n     ^")
177    (set _G.dbg true)
178    ;; repl commands don't mess it up
179    (send ",complete l")
180    (l.assertStrContains (. (send "(let c)") 1) "(let c)\n     ^")))
181
182(fn test-locals-saving []
183  (let [(send comp) (wrap-repl)]
184    (send "(local x-y 5)")
185    (send "(let [x-y 55] nil)")
186    (send "(fn abc [] nil)")
187    (l.assertEquals (send "x-y") [:5])
188    (l.assertEquals (send "(type abc)") ["function"]))
189  ;; now let's try with an env
190  (let [(send comp) (wrap-repl {:env {: debug}})]
191    (send "(local xyz 55)")
192    (l.assertEquals (send "xyz") [:55])))
193
194(local doc-cases
195       [[",doc doto" "(doto val ...)\n  Evaluates val and splices it into the first argument of subsequent forms." "docstrings for built-in macros" ]
196        [",doc table.concat"  "(table.concat #<unknown-arguments>)\n  #<undocumented>" "docstrings for built-in Lua functions" ]
197        ;; ["(fn ew [] \"so \\\"gross\\\" \\\\\\\"I\\\\\\\" can't even\" 1) ,doc ew"  "(ew)\n  so \"gross\" \\\"I\\\" can't even" "docstrings should be auto-escaped" ]
198        ["(fn foo [a] :C 1) ,doc foo"  "(foo a)\n  C" "for named functions, doc shows name, args invocation, docstring" ]
199        ["(fn foo! [-kebab- {:x x}] 1) ,doc foo!"  "(foo! -kebab- {:x x})\n  #<undocumented>" "fn-name and args pretty-printing" ]
200        ["(fn foo! [-kebab- [a b {: x} [x y]]] 1) ,doc foo!"  "(foo! -kebab- [a b {:x x} [x y]])\n  #<undocumented>" "fn-name and args deep pretty-printing" ]
201        ["(fn foo! [-kebab- [a b {\"a b c\" a-b-c} [x y]]] 1) ,doc foo!"  "(foo! -kebab- [a b {\"a b c\" a-b-c} [x y]])\n  #<undocumented>" "fn-name and args deep pretty-printing" ]
202        ["(fn foo! [-kebab- [a b {\"a \\\"b\\\" c\" a-b-c} [x y]]] 1) ,doc foo!"  "(foo! -kebab- [a b {\"a \\\"b\\\" c\" a-b-c} [x y]])\n  #<undocumented>" "fn-name and args deep pretty-printing" ]
203        ["(fn foo! [-kebab- [a b {\"a \\\"b \\\\\\\"c\\\\\\\" d\\\" e\" a-b-c-d-e} [x y]]] 1) ,doc foo!"  "(foo! -kebab- [a b {\"a \\\"b \\\\\"c\\\\\" d\\\" e\" a-b-c-d-e} [x y]])\n  #<undocumented>" "fn-name and args deep pretty-printing" ]
204        ["(fn ml [] \"a\nmultiline\ndocstring\" :result) ,doc ml"  "(ml)\n  a\n  multiline\n  docstring" "multiline docstrings work correctly" ]
205        ["(local fennel (require :fennel)) (local {: generate} (fennel.dofile \"test/generate.fnl\" {:useMetadata true})) ,doc generate"  "(generate depth ?choice)\n  Generate a random piece of data." "docstrings from required module." ]
206        ["(macro abc [x y z] \"this is a macro.\" :123) ,doc abc"  "(abc x y z)\n  this is a macro." "docstrings for user-defined macros" ]
207        ["(macro ten [] \"[ten]\" 10) ,doc ten" "(ten)\n  [ten]" "macro docstrings with brackets"]
208        ["(λ foo [] :D 1) ,doc foo"  "(foo)\n  D" ",doc fnname for named lambdas appear like named functions" ]])
209
210(fn test-docstrings []
211  (let [send (wrap-repl)]
212    (each [_ [code expected msg] (ipairs doc-cases)]
213      (l.assertEquals (table.concat (send code)) expected msg))))
214
215(fn test-no-undocumented []
216  (let [send (wrap-repl)
217        undocumented-ok? {:lua true "#" true :set-forcibly! true}
218        {: _SPECIALS} (specials.make-compiler-env)]
219    (each [name (pairs _SPECIALS)]
220      (when (not (. undocumented-ok? name))
221        (let [[docstring] (send (: ",doc %s" :format name))]
222          (l.assertString docstring)
223          (l.assertNil (docstring:find "undocumented")
224                       (.. "Missing docstring for " name)))))))
225
226;; Skip REPL tests in non-JIT Lua 5.1 only to avoid engine coroutine
227;; limitation. Normally we want all tests to run on all versions, but in
228;; this case the feature will work fine; we just can't use this method of
229;; testing it on PUC 5.1, so skip it.
230(if (or (not= _VERSION "Lua 5.1") (= (type _G.jit) "table"))
231    {: test-local-completion
232     : test-macro-completion
233     : test-method-completion
234     : test-help
235     : test-exit
236     : test-reload
237     : test-reset
238     : test-plugins
239     : test-options
240     : test-apropos
241     : test-byteoffset
242     : test-source-offset
243     : test-code
244     : test-locals-saving
245     : test-docstrings
246     : test-no-undocumented}
247    {})
248