fey.naomi/fennel-ls
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Change tests to faith

Browse Source
This commit is contained in:
XeroOl 2024-03-01 14:37:33 -06:00
parent 418e04edff
commit 186c388344
38 changed files with 1715 additions and 1635 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
Makefile
View File

@ -25,7 +25,7 @@ clean:
rm -f $(EXE)
test:
TESTING=1 $(FENNEL) $(OPTS) test/init.fnl
TESTING=1 $(FENNEL) $(OPTS) --add-fennel-path "./test/faith/?.fnl" test/init.fnl
testall:
$(MAKE) test LUA=lua5.1

28
src/fennel-ls/searcher.fnl
View File

@ -3,12 +3,11 @@ This module is responsible for resolving (require) calls. It has all the logic
for using the name of a module and find the corresponding URI.
I suspect this file may be gone after a bit of refactoring."
(local fennel (require :fennel))
(local utils (require :fennel-ls.utils))
(local sep (package.config:sub 1 1))
(λ is_absolute [path]
(λ absolute? [path]
(or
;; windows
(-> path
@ -32,17 +31,30 @@ I suspect this file may be gone after a bit of refactoring."
"Make every relative path be relative to every workspace."
(let [result []]
(each [path (path:gmatch "[^;]+")]
(if (is_absolute path)
(if (absolute? path)
(table.insert result path)
(each [_ workspace (ipairs (or ?workspaces []))]
(table.insert result (join (utils.uri->path workspace) path)))))
(table.concat result ";")))
(λ lookup [{:configuration {: fennel-path} : root-uri} mod]
(case (or ;; TODO support lua ;; (fennel.searchModule mod (add-workspaces-to-path luapath [root-uri]))
(fennel.searchModule mod (add-workspaces-to-path fennel-path [root-uri])))
modname (utils.path->uri modname)
nil nil))
(fn file-exists? [self uri]
(or (. self.preload uri)
(case (io.open (utils.uri->path uri))
f (do (f:close) true))))
(λ lookup [{:configuration {: fennel-path} : root-uri &as self} mod]
(let [mod (mod:gsub "%." sep)
root-path (utils.uri->path root-uri)]
(accumulate [uri nil
segment (fennel-path:gmatch "[^;]+")
&until uri]
(let [segment (segment:gsub "%?" mod)
segment (if (absolute? segment)
segment
(join root-path segment))
segment (utils.path->uri segment)]
(if (file-exists? self segment)
segment)))))
{: lookup
: add-workspaces-to-path}

20
src/fennel-ls/state.fnl
View File

@ -10,21 +10,24 @@ entire fennel-ls project is referring to the same object."
(local utils (require :fennel-ls.utils))
(local {: compile} (require :fennel-ls.compiler))
(λ read-file [uri]
(with-open [fd (io.open (utils.uri->path uri))]
{:uri uri
:text (fd:read :*a)}))
(λ read-file [self uri]
(let [text (case (. self.preload uri)
preload preload
_ (let [file (io.open (utils.uri->path uri))]
(if file
(let [body (file:read :*a)]
(file:close)
body)
(error (.. "failed to open file" uri)))))]
{: uri : text}))
(λ get-by-uri [self uri]
(or (. self.files uri)
(let [file (read-file uri)]
(let [file (read-file self uri)]
(compile self file)
(tset self.files uri file)
file)))
(λ _get-by-path [self path]
(get-by-uri self (utils.path->uri path)))
(λ get-by-module [self module]
;; check the cache
(case (. self.modules module)
@ -123,6 +126,7 @@ However, fennel-ls can fall back to positionEncoding=utf-16 (with a performance
(λ init-state [self params]
(set self.files {})
(set self.preload {})
(set self.modules {})
(set self.root-uri params.rootUri)
(set self.position-encoding (choose-position-encoding params))

61
test/capabilities-test.fnl
View File

@ -1,61 +0,0 @@
(import-macros {: is-matching : is-casing : describe : it : before-each} :test)
(local {: view} (require :fennel))
(local is (require :test.is))
(local {: ROOT-URI
: ROOT-PATH
: create-client} (require :test.client))
(fn default [tbl field value]
(when (= nil (. tbl field))
(tset tbl field value)))
(fn client-initialization [params]
(default params :clientInfo {:name "xerool's mock client" :version "9000"}) ;; not necessary, but why not have some fun?
(default params :rootPath ROOT-PATH) ;; deprecated, TODO delete
(default params :rootUri ROOT-URI) ;; deprecated, TODO delete
{default params :workspaceFolders [{:name "my cool space" :uri ROOT-URI}]}
(default params :capabilities {})
(default params :trace "off") ;; | "messages" | "verbose"
;; :initializationOptions {}) ;; LspAny
;; :processId nil
;; :locale "en" ;; I don't support languages/translations as of now
params)
(describe "capabilities negotiations"
(it "chooses utf-16"
(let [(self [response])
(create-client
{:params
(client-initialization
{:capabilities
{:general
{:positionEncodings
[:utf-16]}}})})]
(is.equal :utf-16 (. response :result :positionEncoding))
(self:open-file! "foo.fnl" "(let [𐐀𐐀 100] 𐐀𐐀)")
(let [[response] (self:definition "foo.fnl" 0 16)]
(is.equal 6 response.result.range.start.character)
(is.equal 10 response.result.range.end.character))))
(it "chooses utf-8 if at all possible"
(let [(self [response])
(create-client
{:params
(client-initialization
{:capabilities
{:general
{:positionEncodings
[:utf-16 :utf-8]}}})})]
(is.equal :utf-8 (. response :result :positionEncoding))
(self:open-file! "foo.fnl" "(let [𐐀𐐀 100] 𐐀𐐀)")
(let [[response] (self:definition "foo.fnl" 0 20)]
(is.equal 6 response.result.range.start.character)
(is.equal 14 response.result.range.end.character)))))
(it "falls back to utf-16"
(let [(self [response]) (create-client {:params (client-initialization {})})]
(is.equal :utf-16 (. response :result :positionEncoding))))

44
test/capabilities.fnl Normal file
View File

@ -0,0 +1,44 @@
(local faith (require :faith))
(local {: ROOT-URI
: ROOT-PATH
: create-client} (require :test.utils.client))
(local {: get-markup} (require :test.utils))
(fn params-with-encodings [encodings]
{:clientInfo {:name "my mock client" :version "9000"}
:rootPath ROOT-PATH
:rootUri ROOT-URI
:workspaceFolders [{:name "foo" :uri ROOT-URI}]
:capabilities {:general {:positionEncodings encodings}}
:trace "off"})
(fn test-offset-encoding []
(let [(self [response])
(create-client {:params (params-with-encodings [:utf-16])})
_ (faith.= :utf-16 (. response :result :positionEncoding))
{: text : cursor :ranges [{: start : end}]} (get-markup "(let [==𐐀𐐀== 100] 𐐀𐐀|)" :utf-16)
_ (self:open-file! "foo.fnl" text)
[response] (self:definition "foo.fnl" cursor)]
(faith.= start response.result.range.start)
(faith.= end response.result.range.end))
(let [(self [response])
(create-client {:params (params-with-encodings [:utf-16 :utf-8])})
_ (faith.= :utf-8 (. response :result :positionEncoding))
{: text : cursor :ranges [{: start : end}]} (get-markup "(let [==𐐀𐐀== 100] 𐐀𐐀|)" :utf-8)
_ (self:open-file! "foo.fnl" text)
[response] (self:definition "foo.fnl" cursor)]
(faith.= start response.result.range.start)
(faith.= end response.result.range.end))
;; utf-16 is the fallback
(let [(_ [response]) (create-client {:params (params-with-encodings nil)})]
(faith.= :utf-16 (. response :result :positionEncoding)))
(let [(_ [response]) (create-client {:params (params-with-encodings [:some-nonsense-encoding-I-dont-know])})]
(faith.= :utf-16 (. response :result :positionEncoding)))
nil)
{: test-offset-encoding}

238
test/completion-test.fnl
View File

@ -1,238 +0,0 @@
(import-macros {: is-matching : is-casing : describe : it : before-each} :test)
(local is (require :test.is))
(local {: view} (require :fennel))
(local {: ROOT-URI
: create-client} (require :test.client))
(local filename (.. ROOT-URI "/imaginary-file.fnl"))
(fn check-completion [body line col expected unexpected ?line-start ?col-start]
(let [client (doto (create-client)
(: :open-file! filename body))
[{: result}] (client:completion filename line col)
seen (if result
(collect [_ suggestion (ipairs result)]
(do
(if ?line-start
(is.same suggestion.textEdit.range.start {:line ?line-start :character ?col-start}))
(values suggestion.label suggestion.label))))]
(each [_ exp (ipairs expected)]
(is (. seen exp) (.. exp " was not suggested, but should be")))
(each [_ exp (ipairs unexpected)]
(is.nil (. seen exp) (.. exp " was suggested, but shouldn't be")))))
(describe "completions"
(it "suggests globals"
(check-completion "(" 0 1 [:_G :debug :table :io :getmetatable :setmetatable :_VERSION :ipairs :pairs :next] [] 0 1)
(check-completion "#nil\n(" 1 1 [:_G :debug :table :io :getmetatable :setmetatable :_VERSION :ipairs :pairs :next] [] 1 1))
(it "suggests locals in scope"
(check-completion "(local x 10)\n(print )" 1 7 [:x] [] 1 7))
(it "suggests locals where the definition can't be found"
(check-completion "(local x (doto 10 or and +))\n(print )" 1 7 [:x] [] 1 7))
(it "suggests locals in scope at the top level"
(check-completion "(local x 10)\n\n" 1 0 [:x] []))
(it "suggests more locals in scope"
(check-completion "(let [x 10] (let [y 100] \n nil\n ))" 2 4 [:x :y] []))
(it "suggests specials and macros at beginning of list"
(check-completion "()" 0 1 [:do :let :fn :doto :-> :-?>> :?.] [])
;; it's not the language server's job to do filtering,
;; so there's no negative assertions here for other symbols
(check-completion "(d)" 0 2 [:do :doto] [] 0 1)
;; in fact, for fuzzy-matching clients, you especially want to make sure the server isn't filtering
(check-completion "(t)" 0 2 [:doto :setmetatable] [] 0 1))
(it "suggests macros in scope"
(check-completion "(macro funny [] `nil)\n()" 1 1 [:funny] []))
(it "does not suggest locals out of scope"
(check-completion "(do (local x 10))\n" 1 0 [] [:x]))
(it "does not suggest function args out of scope"
(check-completion "(fn [x] (print x))\n" 1 0 [] [:x])
(check-completion "(fn [x] (print x))\n(print " 1 7 [] [:x]))
(describe "When the program doesn't compile"
(it "still completes without requiring the close parentheses"
(check-completion "(fn foo [z]\n (let [x 10 y 20]\n " 2 4 [:x :y :z] []))
(it "still completes with no body in the `let`"
(check-completion "(let [x 10 y 20]\n )" 1 2 [:x :y] []))
(it "still completes with no body in the `let` and no close parentheses"
(check-completion "(local foo 10)\n(local x (let [y f]\n" 1 18 [:foo] []))
(it "still completes items from the previous definitions in the same `let`"
(check-completion "(let [a 10\n b 20\n " 1 6 [:a :b] []))
(it "completes fields with a partially typed multisym that ends in :"
(check-completion "(local x {:field (fn [])})\n(x:" 1 3 [:field] [:local]))
(it "doesn't crash with a partially typed multisym contains ::"
(check-completion "(local x {:field (fn [])})\n(x::f" 1 3 [] [])))
;; Functions
(it "suggests function arguments at the top scope of the function"
(check-completion "(fn foo [arg1 arg2 arg3]\n )" 1 2 [:arg1 :arg2 :arg3] [] 1 2))
(it "suggests function arguments at the top scope of the function"
(check-completion "(fn foo [arg1 arg2 arg3]\n (do (do (do ))))" 1 14 [:arg1 :arg2 :arg3] [] 1 14))
(it "suggests even in a macro"
(check-completion "(local item 10)\n(doto it)" 1 8 [:item] [] 1 6)
(check-completion "(local item 10)\n(case 1 1 it)" 1 12 [:item] [] 1 10)
nil)
;; ;; Scope Ordering Rules
;; (it "does not suggest locals past the suggestion location when a symbol is partially typed")
;; (it "does not suggest locals past the suggestion location without a symbol")
;; (it "does not suggest locals past the suggestion point at the top level")
;; (it "does not suggest items from later definitions in the same `let`")
;; (it "does not suggest macros defined from later definitions")
;; ;; Call ordering rules
(it "doesn't suggest specials in the middle of a list"
(check-completion "(do )"
0 4 [] [:do :let :fn :-> :-?>> :?.]))
(it "doesn't suggest specials at the very top level, fresh"
(check-completion "\n"
0 0 [] [:do :let :fn :-> :-?>> :?.]))
(it "doesn't suggest specials at the very top level, with a symbol"
(check-completion "d\n"
0 1 [] [:do :let :fn :-> :-?>> :?.]))
(it "suggests fields of tables"
(check-completion
"(let [my-table {:foo 10 :bar 20}]\n my-table.)))"
1 11
[:foo :bar]
[:_G :local :doto :1])) ;; no globals, specials, macros, or others
(it "suggests fields of tables indirectly"
(check-completion
"(let [foo (require :foo)]\n foo.)))"
1 6
[:my-export :constant]
[:_G :local :doto :1])) ;; no globals, specials, macros, or others
;; (it "suggests fields of strings"))
(it "suggests known fn fields of tables when using a method call multisym"
(check-completion "(local x {:field (fn [])})\n(x:fi" 1 5 [:field] [:table]))
(describe "metadata"
;; CompletionItemKind
(local kinds
{:Text 1 :Method 2 :Function 3 :Constructor 4 :Field 5 :Variable 6 :Class 7
:Interface 8 :Module 9 :Property 10 :Unit 11 :Value 12 :Enum 13 :Keyword 14
:Snippet 15 :Color 16 :File 17 :Reference 18 :Folder 19 :EnumMember 20
:Constant 21 :Struct 22 :Event 23 :Operator 24 :TypeParameter 25})
(it "offers rich information about function completions"
(let [client (doto (create-client)
(: :open-file! filename "(fn xyzzy [x y z] \"docstring\" nil)\n(xyzz"))
[{:result [completion]}] (client:completion filename 1 5)]
;; TODO this seems a little bit weird to assert
(is.same :xyzzy completion.label "the first completion should be xyzzy")
(assert completion.kind "completion kind should be present")
(assert completion.documentation "completion documentation should be present")))
(it "offers rich information about builtin/special completions"
(let [client (doto (create-client)
(: :open-file! filename "("))
[{:result completions}] (client:completion filename 0 1)
completion (accumulate [item nil _ completion (ipairs completions) &until item] (if (= completion.label :local) completion))]
(is-casing
completion
(where
{:label :local
:kind (= kinds.Operator)
:documentation documentation
:textEdit {:range {:start {:line 0 :character 1} :end {:line 0 :character 1}}}}
(not= documentation :nil)))))
(it "offers rich information about builtin-macro completions"
(let [client (doto (create-client)
(: :open-file! filename "("))
[{:result completions}] (client:completion filename 0 1)
completion (accumulate [item nil _ completion (ipairs completions) &until item] (if (= completion.label :-?>) completion))]
(is-casing
completion
(where
{:label :-?>
:kind (= kinds.Keyword)
:documentation documentation}
(not= documentation :nil)))))
(it "offers rich information about all builtin/globals"
(let [client (doto (create-client)
(: :open-file! filename "("))
[{:result completions}] (client:completion filename 0 1)
_ (table.sort completions #(< $1.label $2.label))
missing-docs (icollect [_ completion (ipairs completions)]
(if (not (and (= (type completion.label) :string)
(= (type completion.kind) :number)
(= (type completion.documentation) :table)))
completion.label))
allowed-missing-docs {:lua true
:set-forcibly! true
;; TODO support other lua versions besides 5.4
:gcinfo true
:getfenv true
:setfenv true
:loadstring true
:module true
:newproxy true
:unpack true
:bit32 true
;; luajit
:bit true
:jit true}]
(each [_ completion (ipairs completions)]
(when (not (. allowed-missing-docs completion.label))
(is.same (type completion.label) :string "unlabeled completion")
(is.same (type completion.kind) :number (.. completion.label " needs a kind"))
(is.same (type completion.documentation) :table (.. completion.label " needs documentation"))
(is.not.same completion.documentation :nil (.. completion.label " needs documentation"))))))
(it "offers rich information about fields"
(let [client (doto (create-client)
(: :open-file! filename "(let [x (fn x [a b c] \"\"\"docstring\"\"\" nil)\n t {: x}]\n (t."))
[{:result completions}] (client:completion filename 2 5)
_ (table.sort completions #(< $1.label $2.label))
missing-docs (icollect [_ completion (ipairs completions)]
(if (not (and (= (type completion.label) :string)
(= (type completion.kind) :number)
(= (type completion.documentation) :table)))
completion.label))
allowed-missing-docs {}]
(each [_ completion (ipairs completions)]
(when (not (. allowed-missing-docs completion.label))
(is.same (type completion.label) :string "unlabeled completion")
(is.same (type completion.kind) :number (.. completion.label " needs a kind"))
(is.same (type completion.documentation) :table (.. completion.label " needs documentation"))
(is.not.same completion.documentation :nil (.. completion.label " needs documentation")))))))
;; (it "offers rich information about variable completions")
;; (it "offers rich information about field completions")
;; (it "offers rich information about method completions")
;; (it "offers rich information about module completions")
;; (it "offers rich information about macro-module completions")))
(it "completes things in an if statement with no body"
(check-completion "(if ge" 0 6 [:getmetatable] [])
(check-completion "(local x {:field 100})\n(if x.fi" 1 8 [:field] [])))
;; (it "suggests known fn keys when using the `:` special")
;; (it "suggests known keys when using the `.` special")
;; (it "suggests known module names in `require` and `include` and `import-macros` and `require-macros` and friends")
;; (it "knows the fields of the standard lua library.")
;; (it "does not suggest special forms for the \"call\" position when a list isn't actually a call, ie destructuring assignment")
;; (it "suggests keys when typing out destructuring, as in `(local {: typinghere} (require :mod))`")
;; (it "only suggests tables for `ipairs` / begin work on type checking system")

226
test/completion.fnl Normal file
View File

@ -0,0 +1,226 @@
(local faith (require :faith))
(local {: create-client-with-files
: position-past-end-of-text} (require :test.utils))
(local {: view} (require :fennel))
(local kinds
{:Text 1 :Method 2 :Function 3 :Constructor 4 :Field 5 :Variable 6 :Class 7
:Interface 8 :Module 9 :Property 10 :Unit 11 :Value 12 :Enum 13 :Keyword 14
:Snippet 15 :Color 16 :File 17 :Reference 18 :Folder 19 :EnumMember 20
:Constant 21 :Struct 22 :Event 23 :Operator 24 :TypeParameter 25})
(fn find [completions e]
(accumulate [result nil
i c (ipairs completions)
&until result]
(if (or (and (= (type e) :string)
(= c.label e))
(and (= (type e) :table)
(or (= e.label nil)
(and (= (type e.label) :string) (= e.label c.label))
(and (= (type e.label) :function) (e.label c.label)))
(or (= e.kind nil)
(and (= (type e.kind) :number) (= e.kind c.kind))
(and (= (type e.kind) :function) (e.kind c.kind)))
(or (= e.documentation nil)
(and (= (type e.documentation) :string) (= e.documentation c.documentation))
(and (= (type e.documentation) :function) (e.documentation c.documentation))
(and (= e.documentation true) (not= nil c.documentation)))
(or (= e.textEdit nil)
(and (= e.textEdit.range.start.line c.textEdit.range.start.line)
(= e.textEdit.range.start.character c.textEdit.range.start.character)
(= e.textEdit.range.end.line c.textEdit.range.end.line)
(= e.textEdit.range.end.character c.textEdit.range.end.character)))))
i)))
(fn check [file-contents expected unexpected]
(let [{: self : uri : cursor : text} (create-client-with-files file-contents)
[{:result ?result}] (self:completion uri
(or cursor
(position-past-end-of-text text)))
completions (or ?result [])]
(each [_ e (ipairs unexpected)]
(let [i (find completions e)]
(faith.= nil i (.. "Got unexpected completion: " (view e) "\n"
"from: " (view file-contents) "\n"
(view (. completions i) {:escape-newlines? true})))))
(each [_ e (ipairs expected)]
(let [i (find completions e)]
(faith.is i (.. "Didn't get completion: " (view e) "\n"
"from: " (view file-contents) "\n"
(if (= (type e) :table)
(let [candidate (find completions {:label e.label})]
(if candidate
(.. "Candidate that didn't match:\n"
(view (. completions candidate)
{:escape-newlines? true}))
""))
"")))))))
(fn test-global []
;; TODO shouldn't this kind be Function?
(check "(" [{:label :setmetatable :kind kinds.Variable}] [])
(check "(" [:_G :debug :table :io :getmetatable :setmetatable :_VERSION :ipairs :pairs :next] [:this-is-not-a-global])
(check "#nil\n(" [:_G :debug :table :io :getmetatable :setmetatable :_VERSION :ipairs :pairs :next] [])
(check "(if ge" [:getmetatable] [])
nil)
(fn test-local []
(check "(local x 10)\n(print |)" [:x] [:+])
(check "(local x (doto 10 or and +))\n(print |)" [:x] [])
(check "(local x 10)\n|\n" [:x] [])
(check "(do (local x 10))\n|" [] [:x])
(check "(let [foo 10 bar 20]
|)" [:foo :bar] [])
(check "(let [foo 10]
(let [bar 20]
|))" [:foo :bar] [])
(check "(let [foo 10]
(let [bar 20]
fo|))" [:foo :bar] [])
(check "(let [foo 10]
(let [bar 20]
|" [:foo :bar] [])
(check "(let [foo 10]
(let [bar 20]
fo|" [:foo :bar] [])
(check "(local foo 10)
(local bar (let [y foo] |" [:foo :y] [])
;; TODO add compile check for incomplete let
; (check "(let [foo 10
; bar 20
; _ |" [:foo :bar] [])
(check "(let [foo 10
bar 20
_ fo|" [:foo :bar] [])
(check "(local x {:field 100})\n(if x.fi" [:field] [])
nil)
(fn test-builtin []
(check "(|)" [:do :let :fn :doto :-> :-?>> :?.] [])
;; it's not the language server's job to do filtering,
;; so there's no negative assertions here for other symbols
(check "(d|)" [:do :doto] [])
;; in fact, for fuzzy-matching clients, you especially want to make sure the server isn't filtering
(check "(t|)" [:doto :setmetatable] [])
;; specials only are suggested in callable positions
(check "(do |)" [] [:do :let :fn :-> :-?>> :?.])
(check "|\n" [] [:do :let :fn :-> :-?>> :?.])
(check "d|\n" [] [:do :let :fn :-> :-?>> :?.])
nil)
(fn test-macro []
(check "(macro funny [] `nil)\n(|)" [:funny] [])
nil)
(fn test-local-in-macro []
(check "(local item 10)\n(doto it|)" [:item] [])
(check "(local item 10)\n(doto |)" [:item] [])
(check "(local item 10)\n(case 1 1 it|)" [:item] [])
(check "(local item 10)\n(case 1 1 |)" [:item] [])
nil)
(fn test-fn-arg []
(check "(fn [x] (print x))\n" [] [:x])
(check "(fn [x] (print x))\n(print " [] [:x])
(check "(fn foo [z]\n (let [x 10 y 20]\n |" [:x :y :z] [])
(check "(fn foo [arg1 arg2 arg3]\n |)" [:arg1 :arg2 :arg3] [])
(check "(fn foo [arg1 arg2 arg3]\n (do (do (do |))))" [:arg1 :arg2 :arg3] [])
nil)
(fn test-field []
(check "(local x {:field (fn [])})\n(x:" [:field] [:local])
;; regression test for not crashing
(check "(local x {:field (fn [])})\n(x::f" [] [])
(check
"(let [my-table {:foo 10 :bar 20}]\n my-table.|)))"
[:foo :bar]
[:_G :local :doto :+]) ;; no globals, specials, macros, or others
(check
{:main.fnl "(let [foo (require :fooo)]
foo.|)))"
:fooo.fnl "(fn my-export [x] (print x))
{: my-export :constant 10}"}
[:my-export :constant]
[:_G :local :doto :+]
;; TODO fix completions of virtual fields
; (check
; {:main.fnl "(let [foo (require :fooo)]
; foo.|)))"
; :fooo.fnl "(local M {:constant 10})
; (fn M.my-export [x] (print x))
; M"}
[:my-export :constant]
[:_G :local :doto :+]) ;; no globals, specials, macros, or others
(check "(local x {:field (fn [])})\n(x:fi|" [:field] [:table])
nil)
(fn test-docs []
(check "(fn xyzzy [x y z] \"docstring\" nil)\n(xyzz"
[{:label :xyzzy :kind kinds.Variable :documentation true}] ;; TODO shouldn't this be kinds.Function
[])
(local things-that-are-allowed-to-have-missing-docs
{:lua 1 :set-forcibly! 1})
(check "("
[;; builtin specials
{:label :local
:kind kinds.Operator
:documentation true
:textEdit {:range {:start {:line 0 :character 1}
:end {:line 0 :character 1}}}}
;; builtin macros
{:label :-?>
:kind kinds.Keyword
:documentation true}]
[{:documentation #(= nil $) :label #(not (. things-that-are-allowed-to-have-missing-docs $))}
{:kind #(= nil $)}
{:label #(= nil $)}])
(check "(let [x (fn x [a b c]
\"\"\"docstring\"\"\"
nil)
t {: x}]
(t."
[:x]
[:_G
{:documentation #(= nil $)}
{:kind #(= nil $)}
{:label #(= nil $)}])
nil)
;; ;; Future tests / features
;; ;; Scope Ordering Rules
;; (it "does not suggest locals past the suggestion location when a symbol is partially typed")
;; (it "does not suggest locals past the suggestion location without a symbol")
;; (it "does not suggest locals past the suggestion point at the top level")
;; (it "does not suggest items from later definitions in the same `let`")
;; (it "does suggest items from earlier definitions in the same `let`")
;; (it "does not suggest macros defined from later definitions")
;; (it "suggests fields of strings"))
;; (it "offers rich information about variable completions")
;; (it "offers rich information about field completions")
;; (it "offers rich information about method completions")
;; (it "offers rich information about module completions")
;; (it "offers rich information about macro-module completions")))
;; (it "suggests known fn keys when using the `:` special")
;; (it "suggests known keys when using the `.` special")
;; (it "suggests known module names in `require` and `include` and `import-macros` and `require-macros` and friends")
;; (it "knows the fields of the standard lua library.")
;; (it "does not suggest special forms for the \"call\" position when a list isn't actually a call, ie destructuring assignment")
;; (it "suggests keys when typing out destructuring, as in `(local {: typinghere} (require :mod))`")
;; (it "only suggests tables for `ipairs` / begin work on type checking system")
{: test-global
: test-local
: test-builtin
: test-macro
: test-local-in-macro
:: test-fn-arg
: test-field
: test-docs}

303
test/diagnostic-test.fnl
View File

@ -1,303 +0,0 @@
(import-macros {: is-matching : describe : it : before-each} :test)
(local is (require :test.is))
(local {: view} (require :fennel))
(local {: ROOT-URI
: create-client} (require :test.client))
(macro find [t body ?should-be-nil]
(assert-compile (= nil ?should-be-nil) "you can only have one thing here, put a `(do)`")
(assert-compile (sequence? t) "[] square brackets please")
(local result (gensym :result))
(local nil* (sym :nil))
(table.insert t 1 result)
(table.insert t 2 nil*)
(table.insert t `&until)
(table.insert t result)
`(accumulate ,t ,body))
(local filename (.. ROOT-URI "/imaginary.fnl"))
(describe "diagnostic messages"
(it "handles compile errors"
(let [self (create-client)
responses (self:open-file! filename "(do do)")
diagnostic
(match responses
[{:params {: diagnostics}}]
(is (find [_ v (ipairs diagnostics)]
(match v
{:message "tried to reference a special form without calling it"
:range {:start {:character 4 :line 0}
:end {:character 6 :line 0}}}
v))
"not found")
_ (error "did not match"))]
(is diagnostic "expected a diagnostic")))
(it "handles parse errors"
(let [self (create-client)
responses (self:open-file! filename "(do (print :hello(]")
diagnostic
(match responses
[{:params {: diagnostics}}]
(is (find [_ v (ipairs diagnostics)]
(match v
{:message "expected whitespace before opening delimiter ("
:range {:start {:character 17 :line 0}
:end {:character 17 :line 0}}}
v))
"not found")
_ (error "did not match"))]
(is diagnostic "expected a diagnostic")))
(it "handles (match)"
(let [self (create-client)
responses (self:open-file! filename "(match)")]
(is-matching responses
[{:params
{:diagnostics
[{:range {:start {:character 0 :line 0}
:end {:character 7 :line 0}}}]}}]
"diagnostics should always have a range")))
(it "gives more than one error"
(let [self (create-client)
responses (self:open-file! filename "(unknown-global-1 unknown-global-2)")]
(is-matching responses
[{:params {:diagnostics [a b]}}] "there should be a diagnostic for each one here")))
(it "warns about unused variables"
(let [self (create-client)
responses (self:open-file! filename "(local x 10)")]
(match responses
[{:params {: diagnostics}}]
(is (find [_ v (ipairs diagnostics)]
(match v
{:message "unused definition: x"
:range {:start {:character 7 :line 0}
:end {:character 8 :line 0}}}
v))
"not found")
_ (error "did not match"))))
(it "warns about unused variables from multival destructuring"
(let [self (create-client)
responses (self:open-file! filename "(let [(x y) (values 1 2)] x)")]
(match responses
[{:params {: diagnostics}}]
(is (find [_ v (ipairs diagnostics)]
(match v
{:code 301
:range {:start {:character 9 :line 0}
:end {:character 10 :line 0}}}
v))
"not found")
_ (error "did not match"))))
(it "warns about vars that are never set"
(let [self (create-client)
responses (self:open-file! filename "(var x nil) (print x)")]
(match responses
[{:params {: diagnostics}}]
(is (find [_ v (ipairs diagnostics)]
(match v
{:code 305
:range {:start {:character 5 :line 0}
:end {:character 6 :line 0}}}
v))
"not found")
_ (error "did not match"))))
(it "warns about unused functions"
(let [self (create-client)
responses (self:open-file! filename "(fn x [])")]
(match responses
[{:params {: diagnostics}}]
(is (find [_ v (ipairs diagnostics)]
(match v
{:message "unused definition: x"
:range {:start {:character 4 :line 0}
:end {:character 5 :line 0}}}
v))
"not found")
_ (error "did not match"))))
(it "does not warn if a field is used"
(let [self (create-client)
responses (self:open-file! filename "(fn [a b] (set a.x 10) (fn b.f []))")]
(assert (not (?. responses 1 :params :diagnostics 1)) (?. responses 1 :params :diagnostics 1 :message))))
(it "warns when using the : special when a multisym would do"
(let [self (create-client)]
(match (self:open-file! filename "(let [x :haha] (: x :find :a))")
[{:params {: diagnostics}}]
(is (find [_ v (ipairs diagnostics)]
(match v
{:message "unnecessary : call: use (x:find)"
:code 303
:range {:start {:character 15 :line 0}
:end {:character 29 :line 0}}}
v)))
_ (error "did not match"))))
(it "doesn't warn when using the : special when macros are involved"
(let [self (create-client)]
(match (self:open-file! filename "(let [x :haha y :find] (-> x (: y :a))
(let [x :haha] (-> x (: :find :a))")
[{:params {: diagnostics}}]
(is.nil (find [_ v (ipairs diagnostics)]
(match v
{:code 303
:range _}
v)))
_ (error "did not match"))))
(it "doesn't warn when using the : special when the string isn't valid"
(let [self (create-client)]
(match (self:open-file! filename "(let [x :haha] (: x \"bar baz\"))")
[{:params {: diagnostics}}]
(is.nil (find [_ v (ipairs diagnostics)]
(match v
{:code 303
:range _}
v)))
_ (error "did not match"))))
(it "warns 'unused' if a var is written but not read"
(let [self (create-client)
responses (self:open-file! filename "(var x 1) (set x 2) (set [x] [3])")]
(match responses
[{:params {: diagnostics}}]
(is (find [_ v (ipairs diagnostics)]
(match v
{:code 301
:range {:start {:character 5 :line 0}
:end {:character 6 :line 0}}}
v))
"not found")
_ (error "did not match"))))
(it "warns 'var-never-set' if a var is not written"
(let [self (create-client)
responses (self:open-file! filename "(var x 1) (print x)")]
(match responses
[{:params {: diagnostics}}]
(is (find [_ v (ipairs diagnostics)]
(match v
{:code 305
:range {:start {:character 5 :line 0}
:end {:character 6 :line 0}}}
v))
"not found")
_ (error "did not match"))))
(it "does not warn 'var-never-set' if a var is written"
(let [self (create-client)
responses (self:open-file! filename "(var x 1) (set x 2) (print x)")]
(match responses
[{:params {: diagnostics}}]
(is.equal 0 (length diagnostics) "this code has no problems")
_ (error "did not match"))))
(it "does not warn on ampersand in destructuring"
(let [self (create-client)
responses (self:open-file! filename "(let [[x & y] [1 2 3]] (print x (. y 1) (. y 2)))")]
(match responses
[{:params {: diagnostics}}]
(is.nil (find [_ v (ipairs diagnostics)]
(match v
{:message "unused definition: &"}
v))
"not found")
_ (error "did not match"))))
(it "does not warn on ampersand in function parameters"
(let [self (create-client)
responses (self:open-file! filename "(fn [x & more] (print x more))")]
(match responses
[{:params {: diagnostics}}]
(is.nil (find [_ v (ipairs diagnostics)]
(match v
{:message "unused definition: &"}
v))))))
(it "does not warn about a generated unpack"
(let [self (create-client)
responses (self:open-file! filename "(-> [1 2 3] unpack +)")]
(match responses
[{:params {: diagnostics}}]
(is.nil (find [_ v (ipairs diagnostics)]
(match v
{:code 304}
v))))))
(it "warns about unpack into +"
(let [self (create-client)
responses (self:open-file! filename "(+ (unpack [1 2 3]))")]
(match responses
[{:params {: diagnostics}}]
(is (find [_ v (ipairs diagnostics)]
(match v
{:code 304}
v))))))
(it "mentions table.concat if you use unpack into .."
(let [self (create-client)
responses (self:open-file! filename "(.. (table.unpack [\"hello\" \"world\"]))")]
(match responses
[{:params {: diagnostics}}]
(is (find [_ v (ipairs diagnostics)]
(and
(match v
{:code 304}
v)
(v.message:find "table.concat")))))))
(it "doesn't mention table.concat if you use unpack into another op"
(let [self (create-client)
responses (self:open-file! filename "(* (table.unpack [\"hello\" \"world\"]))")]
(match responses
[{:params {: diagnostics}}]
(is.nil (find [_ v (ipairs diagnostics)]
(and
(match v
{:code 304}
v)
(v.message:find "table.concat")))))))
(it "tells me not to use values in the middle"
(let [self (create-client)
responses (self:open-file! filename "(+ 1 2 3 (values 4 5) 6)")]
(match responses
[{:params {: diagnostics}}]
(is (find [_ v (ipairs diagnostics)]
(and
(match v
{:code 307}
v)
(v.message:find "values")))))))
(it "doesn't trigger the values warning (code 307) in a statement context"
(let [self (create-client)
responses (self:open-file! filename "(let [x 10] (values 4 5) x)")]
(match responses
[{:params {: diagnostics}}]
(is
(not
(find [_ v (ipairs diagnostics)]
(and
(match v
{:code 307}
v)
(v.message:find "values")))))))))
;; TODO lints:
;; unnecessary (do) in body position
;; Unused variables / fields (maybe difficult)
;; discarding results to various calls
;; unnecessary `do`/`values` with only one inner form
;; `pairs` or `ipairs` call in a (for) table
;; mark when unification is happening on a `match` pattern (may be difficult)
;; think of more lints

215
test/diagnostic.fnl Normal file
View File

@ -0,0 +1,215 @@
(local faith (require :faith))
(local {: view} (require :fennel))
(local {: ROOT-URI
: create-client} (require :test.utils.client))
(local filename (.. ROOT-URI "/imaginary.fnl"))
(fn find [diagnostics e]
"returns the index of the diagnostic "
(accumulate [result nil
i d (ipairs diagnostics)
&until result]
(if (and (or (= e.message nil)
(if (= (type e.message) "function")
(e.message d.message)
(= e.message d.message)))
(or (= e.code nil)
(= e.code d.code))
(or (= e.range nil)
(and (= e.range.start.line d.range.start.line)
(= e.range.start.character d.range.start.character)
(= e.range.end.line d.range.end.line)
(= e.range.end.character d.range.end.character))))
i)))
(fn check [file-contents expected unexpected]
(let [self (create-client)
[{:params {: diagnostics}}] (self:open-file! filename file-contents)]
(each [_ e (ipairs unexpected)]
(let [i (find diagnostics e)]
(faith.= nil i (.. "Lint matching " (view e) "\n"
"from: " (view file-contents) "\n"
(view (. diagnostics i) {:escape-newlines? true})))))
(each [_ e (ipairs expected)]
(let [i (find diagnostics e)]
(faith.is i (.. "No lint matching " (view e) "\n"
"from: " (view file-contents) "\n"
(view diagnostics {:empty-as-sequence? true
:escape-newlines? true})))
(table.remove diagnostics i)))))
(fn test-compile-error []
(check "(do do)"
[{:message "tried to reference a special form without calling it"
:range {:start {:character 4 :line 0}
:end {:character 6 :line 0}}}] [])
nil)
(fn test-parse-error []
(check "(do (print :hello(]"
[{:message "expected whitespace before opening delimiter ("
:range {:start {:character 17 :line 0}
:end {:character 17 :line 0}}}] [])
nil)
(fn test-macro-error []
(check "(match)"
[{:range {:start {:character 0 :line 0}
:end {:character 7 :line 0}}}] [])
nil)
(fn test-multiple-errors []
(check "(unknown-global-1 unknown-global-2)"
[{:message "unknown identifier: unknown-global-1"}
{:message "unknown identifier: unknown-global-2"}] [])
(check "(let [x unknown-global"
[{:message "unknown identifier: unknown-global"}
{:message "expected body expression"}
{:message "expected closing delimiters )]"}] [])
nil)
(fn test-unused []
(check "(local x 10)"
[{:message "unused definition: x"
:code 301
:range {:start {:character 7 :line 0}
:end {:character 8 :line 0}}}] [])
(check "(fn x [])"
[{:message "unused definition: x"
:code 301
:range {:start {:character 4 :line 0}
:end {:character 5 :line 0}}}] [])
(check "(let [(x y) (values 1 2)] x)"
[{:code 301
:range {:start {:character 9 :line 0}
:end {:character 10 :line 0}}}] [])
;; setting a var without reading
(check "(var x 1) (set x 2) (set [x] [3])"
[{:code 301
:range {:start {:character 5 :line 0}
:end {:character 6 :line 0}}}] [])
nil)
(fn test-ampersand []
(check "(let [[x & y] [1 2 3]]
(print x (. y 1) (. y 2)))"
[] [{:message "unused definition: &"} {}])
(check "(let [{1 x & y} [1 2 3]]
(print x (. y 2) (. y 3)))"
[] [{:message "unused definition: &"} {}])
(check "(let [[x &as y] [1 2 3]]
(print x (. y 2) (. y 3)))"
[] [{:message "unused definition: &as"} {}])
(check "(let [{1 x &as y} [1 2 3]]
(print x (. y 2) (. y 3)))"
[] [{:message "unused definition: &as"} {}])
(check "(fn [x & more]
(print x more))"
[] [{:message "unused definition: &"} {}])
nil)
(fn test-no-warnings []
;; setting a field without reading is okay
(check "(fn [a b] (set a.x 10) (fn b.f []))" [] [{}])
nil)
; (fn test-unknown-module-field []
; (check {:the-guy-they-tell-you-not-to-worry-about.fnl
; "(local M {:a 1})
; (fn M.b [] 2)
; M"
; :main.fnl
; "(local {: a : c &as guy} (require :the-guy-they-tell-you-not-to-worry-about))
; (print guy.b guy.d)"}
; [{:code 302}] [{:code 302 :message "unknown module field: a"}]))
(fn test-unnecessary-colon []
(check "(let [x :haha] (: x :find :a))"
[{:message "unnecessary : call: use (x:find)"
:code 303
:range {:start {:character 15 :line 0}
:end {:character 29 :line 0}}}] [])
;; no warning from macros
(check "(let [x :haha y :find] (-> x (: y :a))
(let [x :haha] (-> x (: :find :a))"
[] [{:code 303}])
;; no warning when its an expression, or when string has spaces
(check "(let [x :haha]
(: x \"bar baz\") (: x 1) (: x x))"
[] [{:code 303}])
nil)
(fn test-unpack-into-op []
(check "(+ (unpack [1 2 3]))"
[{:code 304}] [])
(check "(.. (table.unpack [\"hello\" \"world\"]))"
[{:code 304 :message #($:find "table.concat")}] [])
(check "(* (table.unpack [\"hello\" \"world\"]))"
[{:code 304 :message #(not ($:find "table%.concat"))}]
[{:code 304 :message #($:find "table.concat")}])
;; only when lexical
(check "(-> [1 2 3] unpack +)"
[] [{:code 304}])
nil)
(fn test-unset-var []
(check "(var x nil) (print x)"
[{:code 305
:range {:start {:character 5 :line 0}
:end {:character 6 :line 0}}}] [])
(check "(var x 1) (set x 2) (print x)"
[] [{}])
;; TODO fix diagnostic
; (check "(local x 10) (?. x)"
; [] [{:code 305}])
nil)
;; missing test for 306
(fn test-unpack-in-middle []
(check "(+ 1 2 3 (values 4 5) 6)"
[{:code 307
:range {:start {:line 0 :character 9}
:end {:line 0 :character 21}}}]
[])
;; not in a statement, should be covered by another lint
(check "(let [x 10] (values 4 5) x)"
[] [{:code 307}])
(check "(do (values 4 5) (_G.unpack 6 7) (table.unpack 8 9) 10)"
[] [{:code 307}])
nil)
;; TODO lints:
;; unnecessary (do) in body position
;; duplicate keys in kv table
;; (tset <sym> <str>) --> (set <sym>.<str>)
;; {&as x} and [&as x] pattern with no other matches
;; Unused variables / fields (maybe difficult)
;; discarding results to various calls, such as unpack, values, etc
;; unnecessary `do`/`values` with only one inner form
;; `pairs` or `ipairs` call in a (for) binding table
;; mark when unification is happening on a `match` pattern (may be difficult)
;; steal as many lints as possible from cargo
;; unnecessary parens around single multival destructure
{: test-compile-error
: test-parse-error
: test-macro-error
: test-multiple-errors
: test-unused
: test-ampersand
: test-no-warnings
: test-unnecessary-colon
: test-unset-var
: test-unpack-into-op
: test-unpack-in-middle}

121
test/faith/README.md Normal file
View File

@ -0,0 +1,121 @@
# Faith
> It's been a long road...
> Getting from there to here.
The Fennel Advanced Interactive Test Helper.
To use Faith, create a test runner file which calls the `run` function with
a list of module names. The modules should export functions whose
names start with `test-` and which call the assertion functions in the
`faith` module.
## Usage
Your test runner file `test/init.fnl` can be very short:
```fennel
(local t (require :faith))
(local default-modules [:test.one-thing :test.other :test.third])
(t.run (if (= 0 (length arg)) default-modules arg))
```
You can run the `t.run` function from the REPL as well after reloading
your test modules.
Tests are just functions in test modules which call assertion functions.
```fennel
(local t (require :faith))
;; A setup-all function can load files from disk; connect to a server, etc
(fn setup-all []
(with-open [f (io.open "test/data.txt")]
(let [contents (f:read :*all)]
;; whatever the setup-all function returns will be passed as
;; an argument to every test function.
{: contents :length (length contents) :status "initialized"})))
(fn test-add [_data]
(t.= 2 (+ 1 1))
;; assert= tests for deep equality, not just table identity
(t.= [1 99] [1 (+ 45 44)]))
(fn test-check [data]
(t.= 0 (- 2 2)))
{: setup-all
: test-add
: test-check}
```
You can provide `setup` and `teardown` functions to run before and after
each test, as well as, `setup-all` and `teardown-all` to run before and
after each test module. Whatever values `setup-all` returns are passed
into each of the test functions and also the `teardown-all` function.
Note that in a language like Fennel that has tail-call optimization,
it's possible for an assertion on the last line of a function to fail
in a way that obscures the line number of the failure. If this is a
concern, you can put a `nil` or `(values)` on the last line of each
test function.
This is an issue for any test framework; it is not specific to Faith.
Faith supports PUC Lua 5.1 to 5.4 as well as LuaJIT.
If the `luasocket` or `luaposix` libraries are installed, Faith will
use them to calculate the total runtime of the test run. Without these
libraries, Lua is unable to track elapsed time with granularity of
under a second, so approximate times will be displayed instead.
## Assertions
All assertions take an optional message string as their last argument.
* `is`: checks truthiness (anything other than `false` or `nil`)
* `error`: checks that the given function errors out
All these assertions take the expected value first, then the actual.
* `=`: deep equality checks on tables, regular equality otherwise
* `not=`: checks the opposite of `=`
* `<`: checks that the arguments are in increasing order
* `<=`: checks that the arguments are in increasing or equal order
* `almost=`: is the actual value within a tolerance of expected?
* `identical`: regular `=` equality; checks tables for identity
* `match`: checks that the actual string matches an expected pattern
* `not-match`: checks the opposite
* `error-match`: checks that a function errors out and the error matches an
expected pattern
You can call `skip` in a test to indicate that the test is incomplete
without triggering a failure.
## Developing Faith
Run `make testall` to run the full suite against all supported Lua
versions. Currently the `Makefile` assumes that there is a checkout of
Fennel itself in the same directory as your checkout of Faith, but you
can override this with, e.g., `make test FENNEL=/usr/local/bin/fennel`.
Discussion happens on [the Fennel mailing
list](https://lists.sr.ht/%7Etechnomancy/fennel) and on the `#fennel`
channel on Libera chat and matrix.org.
## TODO
* [ ] document hooks
* [ ] detailed/colored diffs for failed equality assertions?
## License
Faith was based on [lunatest](https://github.com/silentbicycle/lunatest)
originally but has evolved significantly since its beginning.
© 2009-2013 Scott Vokes and contributors
© 2023 Phil Hagelberg and contributors
Released under the [MIT License](LICENSE).

302
test/faith/faith.fnl Normal file
View File

@ -0,0 +1,302 @@
;;; faith.fnl --- The Fennel Advanced Interactive Test Helper
;; https://git.sr.ht/~technomancy/faith
;; To use Faith, create a test runner file which calls the `run` function with
;; a list of module names. The modules should export functions whose
;; names start with `test-` and which call the assertion functions in the
;; `faith` module.
;; Copyright © 2009-2013 Scott Vokes and contributors
;; Copyright © 2023 Phil Hagelberg and contributors
;; Permission is hereby granted, free of charge, to any person obtaining a copy
;; of this software and associated documentation files (the "Software"), to deal
;; in the Software without restriction, including without limitation the rights
;; to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
;; copies of the Software, and to permit persons to whom the Software is
;; furnished to do so, subject to the following conditions:
;; The above copyright notice and this permission notice shall be included in
;; all copies or substantial portions of the Software.
;; THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
;; IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
;; FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
;; AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
;; LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
;; OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
;; SOFTWARE.
(local fennel (require :fennel))
;;; helper functions
(local unpack (or table.unpack _G.unpack))
(fn now []
{:real (or (and (pcall require :socket)
(package.loaded.socket.gettime))
(and (pcall require :posix)
(package.loaded.posix.gettimeofday)
(let [t (package.loaded.posix.gettimeofday)]
(+ t.sec (/ t.usec 1000000))))
nil)
:approx (os.time)
:cpu (os.clock)})
(fn result-table [name]
{:started-at (now) :err [] :fail [] : name :pass [] :skip [] :ran 0 :tests []})
(fn combine-results [to from]
(each [_ s (ipairs [:pass :fail :skip :err])]
(each [name val (pairs (. from s))]
(tset (. to s) name val))))
(fn fn? [v] (= (type v) :function))
(fn count [t] (accumulate [c 0 _ (pairs t)] (+ c 1)))
(fn fail->string [{: where : reason : msg} name]
(string.format "FAIL: %s: %s\n %s%s\n"
where name (or reason "")
(or (and msg (.. " - " (tostring msg))) "")))
(fn err->string [{: msg} name]
(or msg (string.format "ERROR (in %s, couldn't get traceback)"
(or name "(unknown)"))))
(fn get-where [start]
(let [traceback (fennel.traceback nil start)
(_ _ where) (traceback:find "\n *([^:]+:[0-9]+):")]
(or where "?")))
;;; assertions
;; while I'd prefer to remove all top-level state, this one is difficult
;; because it has to be set by every assertion, and the assertion functions
;; themselves do not have access to any stateful arguments given that they
;; are called directly from user code.
(var checked nil)
(macro wrap [flag msg ...]
`(do (set ,(sym :checked) (+ ,(sym :checked) 1))
(when (not ,flag)
(error {:char "F" :type :fail :tostring fail->string
:reason (string.format ,...) :msg ,msg :where (get-where 4)}))))
(fn pass [] {:char "." :type :pass})
(fn error-result [msg] {:char "E" :type :err :tostring err->string :msg msg})
(fn skip []
(error {:char :s :type :skip}))
(fn is [got ?msg]
(wrap got ?msg "Expected truthy value"))
(fn error* [f ?msg]
(case (pcall f)
(true val) (wrap false ?msg "Expected an error, got %s"
(fennel.view val))))
(fn error-match [pat f ?msg]
(case (pcall f)
(true val) (wrap false ?msg
"Expected an error, got %s" (fennel.view val))
(_ err) (let [err-string (if (= (type err) :string) err (fennel.view err))]
(wrap (: err-string :match pat) ?msg
"Expected error to match pattern %s, was %s"
pat err-string))))
(fn extra-fields? [t keys]
(or (accumulate [extra? false k (pairs t) &until extra?]
(if (= nil (. keys k))
true
(tset keys k nil)))
(next keys)))
(fn table= [x y equal?]
(let [keys {}]
(and (accumulate [same? true k v (pairs x) &until (not same?)]
(do (tset keys k true)
(equal? v (. y k))))
(not (extra-fields? y keys)))))
(fn equal? [x y]
(or (= x y)
(and (= (type x) :table (type y)) (table= x y equal?))))
(fn =* [exp got ?msg]
(wrap (equal? exp got) ?msg "Expected %s, got %s"
(fennel.view exp) (fennel.view got)))
(fn not=* [exp got ?msg]
(wrap (not (equal? exp got)) ?msg "Expected something other than %s"
(fennel.view exp)))
(fn <* [...]
(let [args [...]
msg (if (= :string (type (. args (length args)))) (table.remove args))
correct? (faccumulate [ok? true i 2 (length args) &until (not ok?)]
(< (. args (- i 1)) (. args i)))]
(wrap correct? msg
"Expected arguments in strictly increasing order, got %s"
(fennel.view args))))
(fn <=* [...]
(let [args [...]
msg (if (= :string (type (. args (length args)))) (table.remove args))
correct? (faccumulate [ok? true i 2 (length args) &until (not ok?)]
(<= (. args (- i 1)) (. args i)))]
(wrap correct? msg
"Expected arguments in increasing/equal order, got %s"
(fennel.view args))))
(fn almost= [exp got tolerance ?msg]
(wrap (<= (math.abs (- exp got)) tolerance) ?msg
"Expected %s +/- %s, got %s" exp tolerance got))
(fn identical [exp got ?msg]
(wrap (= exp got) ?msg
"Expected %s, got %s" (fennel.view exp) (fennel.view got)))
(fn match* [pat s ?msg]
(wrap (: (tostring s) :match pat) ?msg
"Expected string to match pattern %s, was\n%s" pat s))
(fn not-match [pat s ?msg]
(wrap (or (not= (type s) :string) (not (s:match pat))) ?msg
"Expected string not to match pattern %s, was\n %s" pat s))
;;; running
(fn dot [c ran]
(io.write c)
(when (= 0 (math.fmod ran 76))
(io.write "\n"))
(io.stdout:flush))
(fn print-totals [{: pass : fail : skip : err : started-at : ended-at}]
(let [duration (fn [start end]
(let [decimal-places 2]
(: (.. "%." (tonumber decimal-places) "f")
:format
(math.max (- end start)
(math.pow 10 (- decimal-places))))))]
(print (: (.. "Testing finished %s with %d assertion(s)\n"
"%d passed, %d failed, %d error(s), %d skipped\n"
"%.2f second(s) of CPU time used")
:format
(if started-at.real
(: "in %s second(s)" :format
(duration started-at.real ended-at.real))
(: "in approximately %s second(s)" :format
(- ended-at.approx started-at.approx)))
checked
(count pass) (count fail) (count err) (count skip)
(duration started-at.cpu ended-at.cpu)))))
(fn begin-module [s-env tests]
(print (string.format "\nStarting module %s with %d test(s)"
s-env.name (count tests))))
(fn done [results]
(print "\n")
(each [_ ts (ipairs [results.fail results.err results.skip])]
(each [name result (pairs ts)]
(when result.tostring (print (result:tostring name)))))
(print-totals results))
(local default-hooks {:begin false
: done
: begin-module
:end-module false
:begin-test false
:end-test (fn [_name result ran] (dot result.char ran))})
(fn test-key? [k]
(and (= (type k) :string) (k:match :^test.*)))
(local ok-types {:fail true :pass true :skip true})
(fn err-handler [name]
(fn [e]
(if (and (= (type e) :table) (. ok-types e.type))
e
(error-result (-> (string.format "\nERROR: %s:\n%s\n" name e)
(fennel.traceback 4))))))
(fn run-test [name ?setup test ?teardown module-result hooks context]
(when (fn? hooks.begin-test) (hooks.begin-test name))
(let [started-at (now)
result (case-try (if ?setup (xpcall ?setup (err-handler name)) true)
true (xpcall #(test (unpack context)) (err-handler name))
true (pass)
(catch (_ err) err))]
(when ?teardown (pcall ?teardown (unpack context)))
(tset module-result result.type name result)
(set module-result.ran (+ module-result.ran 1))
(when (fn? hooks.end-test) (hooks.end-test name result module-result.ran))))
(fn run-setup-all [setup-all results module-name]
(if (fn? setup-all)
(case [(pcall setup-all)]
[true & context] context
[false err] (let [msg (: "ERROR in test module %s setup-all: %s"
:format module-name err)]
(tset results.err module-name (error-result msg))
(values nil err)))
[]))
(fn run-module [hooks results module-name test-module]
(assert (= :table (type test-module)) (.. "test module must be table: "
module-name))
(let [result (result-table module-name)]
(case (run-setup-all test-module.setup-all results module-name)
context (do
(when hooks.begin-module (hooks.begin-module result test-module))
(each [name test (pairs test-module)]
(when (test-key? name)
(table.insert result.tests test)
(run-test name
test-module.setup
test
test-module.teardown
result
hooks
context)))
(case test-module.teardown-all
teardown (pcall teardown (unpack context)))
(when hooks.end-module (hooks.end-module result))
(combine-results results result)))))
(fn exit [hooks]
(if hooks.exit (hooks.exit 1)
_G.___replLocals___ :failed
(and os os.exit) (os.exit 1)))
(fn run [module-names ?hooks]
(set checked 0)
(io.stdout:setvbuf :line)
;; don't count load time against the test runtime
(each [_ m (ipairs module-names)]
(when (not (pcall require m))
(tset package.loaded m nil)))
(let [hooks (setmetatable (or ?hooks {}) {:__index default-hooks})
results (result-table :main)]
(when hooks.begin
(hooks.begin results module-names))
(each [_ module-name (ipairs module-names)]
(case (pcall require module-name)
(true test-mod) (run-module hooks results module-name test-mod)
(false err) (tset results.err module-name
(error-result (: "ERROR: Cannot load %q:\n%s"
:format module-name err)))))
(set results.ended-at (now))
(when hooks.done (hooks.done results))
(when (or (next results.err) (next results.fail))
(exit hooks))))
{: run : skip :version "0.1.2"
: is :error error* : error-match := =* :not= not=* :< <* :<= <=* : almost=
: identical :match match* : not-match}

136
test/goto-definition-test.fnl
View File

@ -1,136 +0,0 @@
(import-macros {: is-matching : describe : it : before-each} :test)
(local {: view} (require :fennel))
(local is (require :test.is))
(local {: ROOT-URI
: create-client} (require :test.client))
(describe "jump to definition"
(var CLIENT nil)
(fn check [request-file line char response-file start-line start-col end-line end-col]
(let [client (or CLIENT (create-client))
message (client:definition (.. ROOT-URI :/ request-file) line char)
uri (.. ROOT-URI "/" response-file)]
(set CLIENT client)
(is-matching
message
[{:jsonrpc "2.0" :id client.prev-id
:result {: uri
:range {:start {:line start-line :character start-col}
:end {:line end-line :character end-col}}}}]
(.. "expected position: " start-line " " start-col " " end-line " " end-col))))
(it "can go to a fn"
(check :goto-definition.fnl 9 3 :goto-definition.fnl 4 4 4 7))
(it "can go to a local"
(check :goto-definition.fnl 7 17 :goto-definition.fnl 6 9 6 10))
(it "can go to a function argument"
(check :goto-definition.fnl 5 9 :goto-definition.fnl 4 9 4 10))
(it "can handle variables shadowed with let"
(check :goto-definition.fnl 14 10 :goto-definition.fnl 13 6 13 9))
(it "can sort out the unification rule with match (variable unified)"
(check :goto-definition.fnl 19 12 :goto-definition.fnl 17 8 17 9))
(it "can sort out the unification rule with match (variable introduced)"
(check :goto-definition.fnl 20 13 :goto-definition.fnl 20 9 20 10))
(it "can go to a destructured local"
(check :goto-definition.fnl 21 9 :goto-definition.fnl 16 13 16 16))
(it "can go to a function inside a table"
(check :goto-definition.fnl 28 6 :goto-definition.fnl 4 4 4 7))
(it "can go to the table containing a function"
(check :goto-definition.fnl 28 3 :goto-definition.fnl 26 7 26 10))
(it "can go to a field inside of a table literal"
(check :goto-definition.fnl 35 19 :goto-definition.fnl 34 20 34 35))
(it "can go to a function in another file when accessed by multisym"
(check :goto-definition.fnl 7 7 :foo.fnl 2 4 2 13))
(it "can go to a function in another file imported via destructuring assignment" ;; WORKS, just needs a test case
(check :goto-definition.fnl 2 11 :baz.fnl 0 4 0 9))
(it "goes further if you go to definition on a binding"
(check :goto-definition.fnl 31 12 :goto-definition.fnl 23 4 23 5))
;; (it "can go to a destructured function argument")
(it "can go up and down destructuring"
(check :goto-definition.fnl 38 15 :goto-definition.fnl 33 7 33 13))
(it "can go up and down field accesses"
(check :goto-definition.fnl 45 15 :goto-definition.fnl 40 7 40 13))
(it "works directly on a require/include (require XXX))"
(check :goto-definition.fnl 1 5 :bar.fnl 0 0 0 2))
(it "goes to the last form of `do` and `let`"
(check :goto-definition.fnl 47 13 :goto-definition.fnl 47 30 47 52))
(it "can go to `a.b` from an `a.b.c` symbol"
(check :goto-definition.fnl 54 9 :goto-definition.fnl 53 13 53 25))
(it "doesn't leak function arguments to the surrounding scope"
(check :goto-definition.fnl 58 7 :goto-definition.fnl 53 7 53 8))
(it "can go to identifiers introduced by (for)"
(check :goto-definition.fnl 61 9 :goto-definition.fnl 60 6 60 7))
(it "can go to identifiers introduced by (each)"
(check :goto-definition.fnl 64 2 :goto-definition.fnl 63 7 63 8))
(it "can go to a top level identifier"
(let [c (create-client)
_ (c:open-file! :foo.fnl "(fn x []) x")
response (c:definition :foo.fnl 0 10)]
(is-matching response
[{:jsonrpc "2.0" :id c.prev-id
:result {:uri :foo.fnl
:range {:start {:line 0 :character 4}
:end {:line 0 :character 5}}}}])))
(it "doesn't crash when doing this"
(let [c (create-client)
_ (c:open-file! :foo.fnl "(macro cool [a b] `(let [,b 10] ,a))\n(cool x x)")
_response (c:definition :foo.fnl 1 6)
_response (c:definition :foo.fnl 1 8)]
nil))
(it "doesn't crash when going to hashfn"
(let [c (create-client)
_ (c:open-file! :foo.fnl "#$...")
_response (c:definition :foo.fnl 0 0)]
nil))
(it "can go through multival destructures"
(let [c (doto (create-client)
(: :open-file! :foo.fnl "(local [x y] (values [1 2] [3 4]))\n(local (a b) (values {:x y : y} {: x : y}))\n(print b.x a)"))
[find_b] (c:definition :foo.fnl 2 9)]
;; it finds the first `x` symbol
(is.same find_b.result.range {:start {:line 0 :character 8} :end {:line 0 :character 9}})
nil))
;; (it "can go through more than one extra file")
;; (it "will give up instead of freezing on recursive requires")
;; (it "finds the definition of in-file macros")
;; (it "can follow import-macros (destructuring)")
;; (it "can follow import-macros (namespaced)")
;; (it "can go to the definition even in a lua file")
;; (it "finds (set a.b) definitions")
(it "finds (fn a.b [] ...) declarations"
(check :goto-definition.fnl 51 12 :goto-definition.fnl 50 4 50 22)))
;; (it "finds (tset a :b) definitions")
;; (it "finds (setmetatable a {__index {:b def}) definitions")
;; (it "finds definitions into a function (fn foo [] (local x 10) {: x}) (let [result (foo)] (print result.x)) finds result.x")
;; (it "finds definitions through a function (fn foo [{: y}] {:x y}) (let [result (foo {:y {}})] (print result.x)) finds result.x")
;; (it "finds through setmetatable with an __index function")
;; (it "can go to a function's references OR read type inference comments when callsite isn't available (PICK ONE)")
;; (it "can work with a custom fennelpath") ;; Wait until an options system is done

221
test/goto-definition.fnl Normal file
View File

@ -0,0 +1,221 @@
(local faith (require :faith))
(local {: create-client-with-files} (require :test.utils))
(local {: null} (require :fennel-ls.json.json))
(local {: view} (require :fennel))
(fn check [file-contents]
(let [{: self : uri : cursor :locations [location]} (create-client-with-files file-contents)
[message] (self:definition uri cursor)]
(if location
(faith.= location message.result
(.. "Didn't go to location: \n" (view file-contents)))
(faith.= null message.result
(.. "Wasn't supposed to find a definition\n" (view file-contents))))))
;; "|" is the cursor
;; "==" is the definition that should be found
(fn test-basics []
(check "(fn ==x== []) x|")
(check "(local ==x== 10)
(print x|))")
(check "(fn context [==x==]
(print x|))")
(check "(fn ==context== []
(print context|))")
(check "(let [x 100]
(let [==x== 200]
(print x|)))")
(check "(for [==x== 1 10]
(print x|))")
(check "(fn context [x]
(each [_ ==v== (ipairs x)]
(print v|)))")
(check "(fn context [{: ==x==}]
(print |x))")
(check "(fn context [[==x==]]
(print |x))")
;; match unification
(check "(let [==a== 10]
(match [10 1]
[a 1] a|))")
;; case shadows
(check "(let [a 10]
(case [[] 1]
[==a== 1] a|))")
;; first segment of a multisym
(check "(let [a 10
b 20
==foo== {: a : b}]
(print fo|o.a))")
;; starting on a binding
(check "(let [==x== 10
y| x]
(print y)")
;; doesn't leak fn arguments
(check "(local ==x== 10)
(fn [x] x)
x|")
(check "(fn [x] x)
x|")
;; the "definition" of the name of the function is the
;; whole outer function thing.
(check "==(fn foo| [] nil)==")
nil)
(fn test-indirection []
(check "(fn ==target== [] nil)
(local obstacle {: target})
(obstacle.tar|get)")
(check "(fn ==target== [] nil)
(local {: obstacle} {:obstacle {: target}})
(obstacle.tar|get)")
(check "(fn ==target== [] nil)
(local [obstacle] [{: target}])
(obstacle.tar|get)")
(check "(fn ==target== [] nil)
(local (obstacle) {: target})
(obstacle.tar|get)")
(check "(fn ==target== [] nil)
(local (_ obstacle) (values 1 {: target}))
(obstacle.tar|get)")
(check "(fn ==target== [] nil)
(local obstacle (values {: target}))
(obstacle.tar|get)")
(check "(fn ==target== [] nil)
(local obstacle {: target})
(local {:target fo|o} obstacle)
(foo)")
(check "(fn ==target== [] nil)
(local obstacle {:box {: target}})
(local box obstacle.box)
(box.targe|t)")
(check "(fn ==target== [] nil)
(local obstacle {:box {: target}})
(local {: box} obstacle)
(box.targe|t)")
(check "(fn ==target== [] nil)
(local [obstacle-1] [[{: target}]])
(local [[obstacle-2]] [obstacle-1])
(obstacle-2.tar|get)")
;; goes through do, let, and values
(check "(fn ==target== [] nil)
(local (_ obsta|cle) (do (let [x 1] (values x target))))
(obstacle)")
(check "(local [==x== y] (values [1 2] [3 4]))
(local (a b) (values {:x y : y} {: x : y}))
(print b.x| a)")
(check
{:foo.fnl "(fn ==target== []
nil)
{: target}"
:main.fnl "(local foo (require :foo))
(foo.targe|t)"})
(check
{:foo.fnl "(fn ==target== []
nil)
{: target}"
:main.fnl "(local {: ta|rget} (require :foo))
(target)"})
(check
{:foo.fnl "(local M [])
(fn ==M.target== []
nil)
M"
:main.fnl "(local foo (require :foo))
(foo.ta|rget)"})
(check
{:foo.fnl "(fn target []
nil)
=={: target}=="
:main.fnl "(local {: target} (require| :foo))
(target)"})
;; TODO make it work on include
; (check
; {:foo.fnl "(fn target []
; nil)
; =={: target}=="
; :main.fnl "(local {: target} (include| :foo))
; (target)"}))
;; TODO fix goto-definition on the module name string itself
; (check
; {:foo.fnl "(fn target []
; nil)
; =={: target}=="
; :main.fnl "(local {: target} (require :f|oo))
; (target)"}))
(check "(local a {:b {:c =={:d #\"hi\"}==}})
(a.b.|c.d)")
;; TODO fix the multisym splitter
; (check "(local a {:b {:c =={:d #\"hi\"}==}})
; (a.b.c|.d)"))
nil)
(fn test-no-crash []
;; TODO convert the rest of goto
; ;; (it "can go to a destructured function argument")
(check "(macro cool [a b] `(let [,b 10] ,a))\n(cool |x ==x==)")
(check "(macro cool [a b] `(let [,b 10] ,a))\n(cool x x|)")
(check "|#$..."))
; ;; (it "can go through more than one file")
; ;; (it "will give up instead of freezing on recursive requires")
; ;; (it "will give up instead of freezing on recursive tables constructed with (set)")
; ;; (it "finds the definition of in-file macros")
; ;; (it "can follow import-macros (destructuring)")
; ;; (it "can follow import-macros (namespaced)")
; ;; (it "can go to the definition in a lua file")
; ;; (it "finds (set a.b) definitions")
; (it "finds (fn a.b [] ...) declarations"
; (check :goto-definition.fnl 51 12 :goto-definition.fnl 50 4 50 22))
; ;; (it "finds (tset a :b) definitions")
; ;; (it "finds (setmetatable a {:__index {:b def}) definitions")
; ;; (it "finds definitions into a function (fn foo [] (local x 10) {: x}) (let [result (foo)] (print result.x)) finds result.x")
; ;; (it "finds definitions through a function (fn foo [{: y}] {:x y}) (let [result (foo {:y {}})] (print result.x)) finds result.x")
; ;; (it "finds through setmetatable with an :__index function")
; ;; (it "can go to a function's references OR read type inference comments when callsite isn't available (PICK ONE)")
; ;; (it "can work with a custom fennelpath") ;; Wait until an options system is done
{: test-basics
: test-indirection
: test-no-crash}

98
test/hover-test.fnl
View File

@ -1,98 +0,0 @@
(import-macros {: is-matching : describe : it : before-each} :test)
(local is (require :test.is))
(local {: view} (require :fennel))
(local {: ROOT-URI
: create-client} (require :test.client))
(describe "hover"
(fn check [request-file line char response-string]
(let [self (create-client)
message (self:hover (.. ROOT-URI :/ request-file) line char)]
(is-matching
message
[{:jsonrpc "2.0" :id self.prev-id
:result
{:contents
{:kind "markdown"
:value response-string}}}]
(.. "expected response: " (view response-string)))))
(it "hovers over a function"
(check "hover.fnl" 6 6 "```fnl\n(fn my-function [arg1 arg2 arg3] ...)\n```"))
(it "hovers over a literal number"
(check "hover.fnl" 6 16 "```fnl\n300\n```"))
(it "hovers over a literal string"
(check "hover.fnl" 6 19 "```fnl\n\"some text\"\n```"))
(it "hovers over a field number"
(check "hover.fnl" 9 20 "```fnl\n10\n```"))
(it "hovers over a field string"
(check "hover.fnl" 9 30 "```fnl\n:colon-string\n```"))
(it "hovers over a literal nil"
(check "hover.fnl" 12 9 "```fnl\nnil\n```"))
(it "hovers over λ function"
(check "hover.fnl" 18 6 "```fnl\n(fn lambda-fn [arg1 arg2] ...)\n```\ndocstring"))
(it "hovers the first part of a multisym"
(check "hover.fnl" 9 14 "```fnl\n{:field1 10 :field2 :colon-string}\n```"))
(it "hovers over literally the very first character"
(let [self (create-client)
message (self:hover (.. ROOT-URI "/hover.fnl") 0 0)]
(is-matching message [{:jsonrpc "2.0" :id 2}] "")))
(it "can go backward through (case)"
(check "hover.fnl" 22 22 "```fnl\n{:AB :CD}\n```"))
(it "hovers over a special"
(check "hover.fnl" 5 2 "```fnl\n(let [name1 val1 ... nameN valN] ...)\n```\nIntroduces a new scope in which a given set of local bindings are used."))
(it "hovers over a multival destructure over (values)"
(let [client (doto (create-client)
(: :open-file! :foo.fnl "(local (a b) (values 1 2))"))
[hover-a] (client:hover :foo.fnl 0 8)
[hover-b] (client:hover :foo.fnl 0 10)]
(is (hover-a.result.contents.value:find "```fnl\n1\n```"))
(is (hover-b.result.contents.value:find "```fnl\n2\n```"))
nil))
(it "hovers over a multival destructure over (do (values))"
(let [client (doto (create-client)
(: :open-file! :foo.fnl "(local (a b) (do (values 1 2)))"))
[hover-a] (client:hover :foo.fnl 0 8)
[hover-b] (client:hover :foo.fnl 0 10)]
(is (hover-a.result.contents.value:find "```fnl\n1\n```"))
(is (hover-b.result.contents.value:find "```fnl\n2\n```"))
nil))
(it "hovers over a multival destructure over a mean test (do (values))"
(let [client (doto (create-client)
(: :open-file! :foo.fnl "(let [(x y z a) (do (do (values 1 (do (values (values 2 4) (do 3))))))]\n (print x y z a))"))
[hover-x] (client:hover :foo.fnl 1 9)
[hover-y] (client:hover :foo.fnl 1 11)
[hover-z] (client:hover :foo.fnl 1 13)]
(is (hover-x.result.contents.value:find "```fnl\n1\n```"))
(is (hover-y.result.contents.value:find "```fnl\n2\n```"))
(is (hover-z.result.contents.value:find "```fnl\n3\n```"))
nil))
(it "hovers over a special"
(let [client (doto (create-client)
(: :open-file! :foo.fnl "(do nil)"))
[hover-do] (client:hover :foo.fnl 0 2)]
(is.equal hover-do.result.contents.value
"```fnl\n(do ...)\n```\nEvaluate multiple forms; return last value.")))
(it "hovers over a builtin macro"
(let [client (doto (create-client)
(: :open-file! :foo.fnl "(doto nil (print))"))
[hover-do] (client:hover :foo.fnl 0 2)]
(is.equal hover-do.result.contents.value
"```fnl\n(doto val ...)\n```\nEvaluate val and splice it into the first argument of subsequent forms."))))

102
test/hover.fnl Normal file
View File

@ -0,0 +1,102 @@
(local faith (require :faith))
(local {: view} (require :fennel))
(local {: create-client-with-files} (require :test.utils))
(local {: null} (require :fennel-ls.json.json))
(fn check [file-contents ?response-string]
(let [{: self : uri : cursor} (create-client-with-files file-contents)
[message] (self:hover uri cursor)]
(if ?response-string
(faith.= ?response-string (?. message :result :contents :value)
(.. "Invalid hover message\nfrom: " (view file-contents)))
(faith.= null message.result))))
(fn test-literals []
(check "(local x| 200)" "```fnl\n200\n```")
(check "(local |x 200)" "```fnl\n200\n```")
(check "(local x 200)\n|x" "```fnl\n200\n```")
(check "(local x 200)\nx|" "```fnl\n200\n```")
(check "(local x| \"hello\")" "```fnl\n:hello\n```")
(check "(local x| \"hello world\")" "```fnl\n\"hello world\"\n```")
(check "(local x \"hello\")\nx|" "```fnl\n:hello\n```")
(check "(local x \"hello world\")\nx|" "```fnl\n\"hello world\"\n```")
(check "(local x| nil)" "```fnl\nnil\n```")
(check "(local x| true)" "```fnl\ntrue\n```")
(check "(local x| false)" "```fnl\nfalse\n```")
nil)
(fn test-builtins []
(check "(d|o nil)" "```fnl\n(do ...)\n```\nEvaluate multiple forms; return last value.")
(check "(|doto nil (print))" "```fnl\n(doto val ...)\n```\nEvaluate val and splice it into the first argument of subsequent forms.")
(check "(le|t [x 10] 10)" "```fnl\n(let [name1 val1 ... nameN valN] ...)\n```\nIntroduces a new scope in which a given set of local bindings are used.")
nil)
(fn test-globals []
;; TODO fix globals
; (check "(pri|nt :hello :world)" "```fnl\n(print ...)\n```\nHi its me! I'm the print docs")
; (check "(xpca|ll io.open debug.traceback :filename.txt)" "```fnl\n(xpcall ...)\n```\nHi its me! I'm the xpcall docs"))
nil)
(fn test-functions []
(check "(fn my-function| [arg1 arg2 arg3]
(print arg1 arg2 arg3))"
"```fnl\n(fn my-function [arg1 arg2 arg3] ...)\n```")
(check "(fn my-function| [arg1 arg2 arg3]
\"this is a doc string\"
(print arg1 arg2 arg3))"
"```fnl\n(fn my-function [arg1 arg2 arg3] ...)\n```\nthis is a doc string")
(check "(fn my-function [arg1 arg2 arg3]
\"this is a doc string\"
(print arg1 arg2 arg3))
(|my-function)"
"```fnl\n(fn my-function [arg1 arg2 arg3] ...)\n```\nthis is a doc string")
(check "(fn my-function [arg1 arg2 arg3]
\"this is a doc string\"
(print arg1 arg2 arg3))
(my-function)|" nil)
(check "(λ foo| [x ...]
\"not a docstring, this gets returned\")"
"```fnl\n(fn foo [x ...] ...)\n```")
;; TODO cleanup signatures
; (check "(λ foo| [{: start : end} ...]
; :body)"
; "```fnl\n(fn foo [{: start : end} ...] ...)\n```")
nil)
(fn test-multisym []
(check "(local x {:foo 10}) x.foo|" "```fnl\n10\n```")
(check "(local x {:foo 10}) x.|foo" "```fnl\n10\n```")
;; TODO make it pick the other side of the multisym
;; (check "(local x {:foo 10}) x|.foo" "```fnl\n{:foo 10}\n```")
(check "(local x {:foo 10}) |x.foo" "```fnl\n{:foo 10}\n```")
(check "(local x {:foo \"hello\"}) x.foo|" "```fnl\n:hello\n```")
(check "(let [x [10 {:foo \"hello\"}]]
(case (values 10 x)
(bar [_ {: foo}]) fo|o))" "```fnl\n:hello\n```")
nil)
(fn test-crash []
(check "|(local x {:foo \"hello\"}) x.foo" nil)
(check "|\n(local x {:foo \"hello\"}) x.foo" nil)
nil)
(fn test-multival []
(check "(local (a| b) (values 1 2))" "```fnl\n1\n```")
(check "(local (a |b) (values 1 2))" "```fnl\n2\n```")
(check "(local (a| b) (do (values 1 2)))" "```fnl\n1\n```")
(check "(local (a |b) (do (values 1 2)))" "```fnl\n2\n```")
(check "(let [(x y z a) (do (do (values 1 (do (values (values 2 4) (do 3))))))]\n (print x| y z a))" "```fnl\n1\n```")
(check "(let [(x y z a) (do (do (values 1 (do (values (values 2 4) (do 3))))))]\n (print x y| z a))" "```fnl\n2\n```")
(check "(let [(x y z a) (do (do (values 1 (do (values (values 2 4) (do 3))))))]\n (print x y z| a))" "```fnl\n3\n```")
(check "(let [(x y z a) (do (do (values 1 (do (values (values 2 4) (do 3))))))]\n (print x y z a|))" nil)
nil)
{: test-literals
: test-builtins
: test-globals
: test-functions
: test-multisym
: test-crash
: test-multival}

57
test/init-macros.fnl
View File

@ -1,57 +0,0 @@
;; fennel-ls: macro-file
"This document does not include tests. Instead it includes macros that are used for tests."
(fn it [desc ...]
"lust's `it` function"
(let [body [...]]
(table.insert body `nil)
`((. (require :test.lust) :it)
,desc (fn [] ,desc ,(unpack body)))))
(fn describe [desc ...]
"lust's `describe` function"
(let [body [...]]
(table.insert body `nil)
`((. (require :test.lust) :describe)
,desc (fn [] ,desc ,(unpack body)))))
(fn before-each [...]
"lust's `before_each` function"
(let [body [...]]
(table.insert body `nil)
`((. (require :test.lust) :before_each)
(fn [] ,(unpack body)))))
(fn is-matching [item pattern ?msg]
"check if item matches a pattern according to fennel's `match` builtin"
`(match ,item
,pattern nil
?otherwise#
(is false
(.. "Pattern did not match:\n"
(let [fennel# (require :fennel)]
(fennel#.view ?otherwise#))
"\ndid not match pattern:\n"
,(view pattern)
,(and ?msg `(.. "\n" ,?msg))))))
(fn is-casing [item pattern ?msg]
"check if item matches a pattern according to fennel's `match` builtin"
`(case ,item
,pattern nil
?otherwise#
(error
(.. "Pattern did not match:\n"
(let [fennel# (require :fennel)]
(fennel#.view ?otherwise#))
"\ndid not match pattern:\n"
,(view pattern)
,(and ?msg `(.. "\n" ,?msg))))))
{: it
: describe
: is-matching
: is-casing
: before-each}

28
test/init.fnl
View File

@ -9,19 +9,17 @@
(set info.linedefined (or (?. sourcemap info.source info.linedefined 2) info.linedefined)))
info))
(require :test.capabilities-test)
(require :test.completion-test)
(require :test.diagnostic-test)
(require :test.goto-definition-test)
(require :test.hover-test)
(require :test.json-rpc-test)
(require :test.misc-test)
(require :test.references-test)
(require :test.rename-test)
(require :test.settings-test)
(require :test.string-processing-test)
(local faith (require :faith))
(let [{: passes : errors} (require :test.lust)]
(print (.. passes " passes. " errors " errors."))
(if (not= errors 0)
(os.exit errors)))
(faith.run
[:test.json-rpc
:test.string-processing
:test.capabilities
:test.settings
:test.goto-definition
:test.hover
:test.completion
:test.references
:test.diagnostic
:test.rename
:test.misc])

11
test/is.fnl
View File

@ -1,11 +0,0 @@
;; this package is here to translate into lust's weird dsl
(local {: view} (require :fennel))
(local {: expect} (require :test.lust))
;; lust uses weird terminology, but what I say is that "equal" is by __eq, "same" is by recursively having the same contents
(setmetatable {:equal #(do ((. (expect $1) :to :be) $2) true)
:same #(do ((. (expect $1) :to :equal) $2 $3) true)
:nil #(do ((. (expect $1) :to_not :exist) $2) true)
:not {:nil #(do ((. (expect $1) :to :exist) $2) true)
:same #(do ((. (expect $1) :to_not :equal) $2))}
:truthy #(do ((. (expect $1) :to :be :truthy)) true)}
{:__call #(do ((. (expect $2) :to :be :truthy) $3) true)})

38
test/json-rpc-test.fnl
View File

@ -1,38 +0,0 @@
(import-macros {: is-matching : describe : it} :test)
(local is (require :test.is))
(local stringio (require :test.pl.stringio))
(local json-rpc (require :fennel-ls.json-rpc))
(describe "json-rpc"
(describe "read"
(it "parses incoming messages"
(let [out (stringio.open
"Content-Length: 29\r\n\r\n{\"my json content\":\"is cool\"}")]
(is.same
{"my json content" "is cool"}
(json-rpc.read out))))
(it "can read multiple incoming messages"
(let [out (stringio.open
"Content-Length: 29\r\n\r\n{\"my json content\":\"is cool\"}Content-Length: 29\r\n\r\n{\"my json content\":\"is neat\"}")]
(is.same
{"my json content" "is cool"}
(json-rpc.read out))
(is.same
{"my json content" "is neat"}
(json-rpc.read out))
(is.same
nil
(json-rpc.read out))))
(it "can report compiler errors"
(let [out (stringio.open "Content-Length: 9\r\n\r\n{{{{{}}}}")]
(is (= (type (json-rpc.read out)) :string)))))
(describe "write"
(it "serializes outgoing messages"
(let [in (stringio.create)]
(json-rpc.write in {"my json content" "is cool"})
(is.same "Content-Length: 29\r\n\r\n{\"my json content\":\"is cool\"}"
(in:value))))))

24
test/json-rpc.fnl Normal file
View File

@ -0,0 +1,24 @@
(local faith (require :faith))
(local stringio (require :test.pl.stringio))
(local json-rpc (require :fennel-ls.json-rpc))
(fn test-read []
(let [out (stringio.open "Content-Length: 29\r\n\r\n{\"my json content\":\"is cool\"}")]
(faith.= {"my json content" "is cool"} (json-rpc.read out)))
(let [out (stringio.open "Content-Length: 29\r\n\r\n{\"my json content\":\"is cool\"}Content-Length: 29\r\n\r\n{\"my json content\":\"is neat\"}")]
(faith.= {"my json content" "is cool"} (json-rpc.read out))
(faith.= {"my json content" "is neat"} (json-rpc.read out))
(faith.= nil (json-rpc.read out)))
(let [out (stringio.open "Content-Length: 9\r\n\r\n{{{{{}}}}")]
(faith.= :string (type (json-rpc.read out)) "json-rpc returns a table on successful read, and a string on unsuccessful read. It's jank and should probably be replaced with an ok, err system")))
(fn test-write []
(let [in (stringio.create)]
(json-rpc.write in {"my json content" "is cool"})
(faith.= "Content-Length: 29\r\n\r\n{\"my json content\":\"is cool\"}"
(in:value))))
{: test-read
: test-write}

245
test/lust.lua
View File

@ -1,245 +0,0 @@
-- lust v0.1.0 - Lua test framework
-- https://github.com/bjornbytes/lust
-- MIT LICENSE
--
-- Modified by XeroOl to use fennel.view for more fennel flavored error messages
local lust = {}
local tostring = require("fennel").view
lust.level = 0
lust.passes = 0
lust.errors = 0
lust.befores = {}
lust.afters = {}
local red = string.char(27) .. '[31m'
local green = string.char(27) .. '[32m'
local normal = string.char(27) .. '[0m'
local function indent(level) return string.rep('\t', level or lust.level) end
local function has(t, x)
for k, v in pairs(t) do
if v == x then return true end
end
return false
end
function lust.nocolor()
red, green, normal = '', '', ''
return lust
end
function lust.describe(name, fn)
print(indent() .. name)
lust.level = lust.level + 1
fn()
lust.befores[lust.level] = {}
lust.afters[lust.level] = {}
lust.level = lust.level - 1
end
function lust.it(name, fn)
for level = 1, lust.level do
if lust.befores[level] then
for i = 1, #lust.befores[level] do
lust.befores[level][i](name)
end
end
end
local success, err = xpcall(fn, require('fennel').traceback)
if success then lust.passes = lust.passes + 1
else lust.errors = lust.errors + 1 end
local color = success and green or red
local label = success and 'PASS' or 'FAIL'
print(indent() .. color .. label .. normal .. ' ' .. name)
if err then
print(indent(lust.level + 1) .. red .. tostring(err) .. normal)
end
for level = 1, lust.level do
if lust.afters[level] then
for i = 1, #lust.afters[level] do
lust.afters[level][i](name)
end
end
end
if has(arg, "--quit-at-first-test") then os.exit(1) end
end
function lust.before(fn)
lust.befores[lust.level] = lust.befores[lust.level] or {}
table.insert(lust.befores[lust.level], fn)
end
function lust.after(fn)
lust.afters[lust.level] = lust.afters[lust.level] or {}
table.insert(lust.afters[lust.level], fn)
end
-- Assertions
local function isa(v, x)
if type(x) == 'string' then
return type(v) == x,
'expected ' .. tostring(v) .. ' to be a ' .. x,
'expected ' .. tostring(v) .. ' to not be a ' .. x
elseif type(x) == 'table' then
if type(v) ~= 'table' then
return false,
'expected ' .. tostring(v) .. ' to be a ' .. tostring(x),
'expected ' .. tostring(v) .. ' to not be a ' .. tostring(x)
end
local seen = {}
local meta = v
while meta and not seen[meta] do
if meta == x then return true end
seen[meta] = true
meta = getmetatable(meta) and getmetatable(meta).__index
end
return false,
'expected ' .. tostring(v) .. ' to be a ' .. tostring(x),
'expected ' .. tostring(v) .. ' to not be a ' .. tostring(x)
end
error('invalid type ' .. tostring(x))
end
local function strict_eq(t1, t2)
if type(t1) ~= type(t2) then return false end
if type(t1) ~= 'table' then return t1 == t2 end
for k, _ in pairs(t1) do
if not strict_eq(t1[k], t2[k]) then return false end
end
for k, _ in pairs(t2) do
if not strict_eq(t2[k], t1[k]) then return false end
end
return true
end
local paths = {
[''] = { 'to', 'to_not' },
to = { 'have', 'equal', 'be', 'exist', 'fail', 'match' },
to_not = { 'have', 'equal', 'be', 'exist', 'fail', 'match', chain = function(a) a.negate = not a.negate end },
a = { test = isa },
an = { test = isa },
be = { 'a', 'an', 'truthy',
test = function(v, x, message)
return v == x,
message or 'expected ' .. tostring(v) .. ' and ' .. tostring(x) .. ' to be equal',
message or 'expected ' .. tostring(v) .. ' and ' .. tostring(x) .. ' to not be equal'
end
},
exist = {
test = function(v, message)
return v ~= nil,
message or 'expected ' .. tostring(v) .. ' to exist',
message or 'expected ' .. tostring(v) .. ' to not exist'
end
},
truthy = {
test = function(v, message)
return v,
message or 'expected ' .. tostring(v) .. ' to be truthy',
message or 'expected ' .. tostring(v) .. ' to not be truthy'
end
},
equal = {
test = function(v, x, message)
return strict_eq(v, x),
message or 'expected ' .. tostring(v) .. ' and ' .. tostring(x) .. ' to be exactly equal',
message or 'expected ' .. tostring(v) .. ' and ' .. tostring(x) .. ' to not be exactly equal'
end
},
have = {
test = function(v, x, message)
if type(v) ~= 'table' then
error('expected ' .. tostring(v) .. ' to be a table')
end
return has(v, x),
message or 'expected ' .. tostring(v) .. ' to contain ' .. tostring(x),
message or 'expected ' .. tostring(v) .. ' to not contain ' .. tostring(x)
end
},
fail = {
test = function(v)
return not pcall(v),
'expected ' .. tostring(v) .. ' to fail',
'expected ' .. tostring(v) .. ' to not fail'
end
},
match = {
test = function(v, p)
if type(v) ~= 'string' then v = tostring(v) end
local result = string.find(v, p)
return result ~= nil,
'expected ' .. v .. ' to match pattern [[' .. p .. ']]',
'expected ' .. v .. ' to not match pattern [[' .. p .. ']]'
end
},
}
function lust.expect(v)
local assertion = {}
assertion.val = v
assertion.action = ''
assertion.negate = false
setmetatable(assertion, {
__index = function(t, k)
if has(paths[rawget(t, 'action')], k) then
rawset(t, 'action', k)
local chain = paths[rawget(t, 'action')].chain
if chain then chain(t) end
return t
end
return rawget(t, k)
end,
__call = function(t, ...)
if paths[t.action].test then
local res, err, nerr = paths[t.action].test(t.val, ...)
if assertion.negate then
res = not res
err = nerr or err
end
if not res then
error(err or 'unknown failure')
end
end
end
})
return assertion
end
function lust.spy(target, name, run)
local spy = {}
local subject
local function capture(...)
table.insert(spy, {...})
return subject(...)
end
if type(target) == 'table' then
subject = target[name]
target[name] = capture
else
run = name
subject = target or function() end
end
setmetatable(spy, {__call = function(_, ...) return capture(...) end})
if run then run() end
return spy
end
lust.test = lust.it
lust.paths = paths
return lust

72
test/misc-test.fnl
View File

@ -1,72 +0,0 @@
(import-macros {: is-matching : describe : it : before-each} :test)
(local is (require :test.is))
(local {: view &as fennel} (require :fennel))
(local {: create-client
: ROOT-URI}
(require :test.client))
(local language (require :fennel-ls.language))
(local utils (require :fennel-ls.utils))
(local filename (.. ROOT-URI "imaginary.fnl"))
(describe "multi-sym-split"
(it "should be 1 on regular syms"
(is.same ["foo"] (utils.multi-sym-split "foo" 2)))
(it "should be 1 before the :"
(is.same ["foo"] (utils.multi-sym-split "foo:bar" 3)))
(it "should be 2 at the :"
(is.same ["foo" "bar"] (utils.multi-sym-split "foo:bar" 4)))
(it "should be 2 after the :"
(is.same ["is" "equal"] (utils.multi-sym-split "is.equal" 5)))
(it "should be big"
(is.same ["a" "b" "c" "d" "e" "f"] (utils.multi-sym-split "a.b.c.d.e.f"))
(is.same ["obj" "bar"] (utils.multi-sym-split (fennel.sym "obj.bar")))))
(describe "find-symbol"
(it "finds a symbol and parents"
(let [state (doto (create-client)
(: :open-file! filename "(match [1 2 4] [1 2 sym-one] sym-one)"))
file (. state.server.files filename)
(symbol parents) (language.find-symbol file.ast 23)]
(is.equal symbol (fennel.sym :sym-one))
(is-matching
;; awful way to check AST equality, but I don't mind
parents [[1 2 [:sym-one]] [[:match] [1 2 4] [1 2 [:sym-one]] [:sym-one]]]
"bad parents")))
(it "finds nothing, but still gives parents"
(let [state (doto (create-client)
(: :open-file! filename "(match [1 2 4] [1 2 sym-one] sym-one)"))
file (. state.server.files filename)
(symbol parents) (language.find-symbol file.ast 18)]
(is.equal symbol nil)
(is-matching
parents [[1 2 [:sym-one]] [[:match] [1 2 4] [1 2 [:sym-one]] [:sym-one]]]
"bad parents"))))
(describe "failure"
(it "doesn't crash"
(let [self (create-client)
state (require :fennel-ls.state)
searcher (require :fennel-ls.searcher)]
(is.not.nil (searcher.lookup self.server :crash-files.test1))
(is.not.nil (state.get-by-module self.server :crash-files.test1)))))
; (is.not.nil (searcher.lookup self.server :crash-files.test2))
; (is.not.nil (state.get-by-module self.server :crash-files.test2)))))
(describe "split-spaces"
(it "should split empty string"
(is.same [] (utils.split-spaces "")))
(it "should split single word"
(is.same ["foo"] (utils.split-spaces "foo")))
(it "should trim single word"
(is.same ["foo"] (utils.split-spaces " foo ")))
(it "should split multiple words"
(is.same ["foo-bar" "bar" "baz"] (utils.split-spaces "foo-bar bar baz")))
(it "should split multiple words with arbitrary white space"
(is.same ["foo-bar" "bar" "baz"] (utils.split-spaces " foo-bar bar baz "))))

65
test/misc.fnl Normal file
View File

@ -0,0 +1,65 @@
(local faith (require :faith))
(local fennel (require :fennel))
(local {: create-client
: ROOT-URI}
(require :test.utils.client))
(local language (require :fennel-ls.language))
(local utils (require :fennel-ls.utils))
(local filename (.. ROOT-URI "imaginary.fnl"))
(fn test-multi-sym-split []
(faith.= ["foo"] (utils.multi-sym-split "foo" 2))
(faith.= ["foo"] (utils.multi-sym-split "foo:bar" 3))
(faith.= ["foo" "bar"] (utils.multi-sym-split "foo:bar" 4))
(faith.= ["is" "equal"] (utils.multi-sym-split "is.equal" 5))
(faith.= ["a" "b" "c" "d" "e" "f"] (utils.multi-sym-split "a.b.c.d.e.f"))
(faith.= ["obj" "bar"] (utils.multi-sym-split (fennel.sym "obj.bar")))
nil)
(fn test-find-symbol []
(let [state (doto (create-client)
(: :open-file! filename "(match [1 2 4] [1 2 sym-one] sym-one)"))
file (. state.server.files filename)
(symbol parents) (language.find-symbol file.ast 23)]
(faith.= symbol (fennel.sym :sym-one))
(faith.=
"[[1 2 sym-one] (match [1 2 4] [1 2 sym-one] sym-one) [(match [1 2 4] [1 2 sym-one] sym-one)]]"
(fennel.view parents {:one-line? true})
"bad parents"))
(let [state (doto (create-client)
(: :open-file! filename "(match [1 2 4] [1 2 sym-one] sym-one)"))
file (. state.server.files filename)
(symbol parents) (language.find-symbol file.ast 18)]
(faith.= symbol nil)
(faith.=
"[[1 2 sym-one] (match [1 2 4] [1 2 sym-one] sym-one) [(match [1 2 4] [1 2 sym-one] sym-one)]]"
(fennel.view parents {:one-line? true})
"bad parents"))
nil)
(fn test-failure []
(let [self (create-client)
state (require :fennel-ls.state)
searcher (require :fennel-ls.searcher)]
(faith.not= nil (searcher.lookup self.server :crash-files.test1))
(faith.not= nil (state.get-by-module self.server :crash-files.test1)))
;; TODO turn off TESTING=1 in makefile
; (faith.not= nil (searcher.lookup self.server :crash-files.test2))
; (faith.not= nil (state.get-by-module self.server :crash-files.test2)))
nil)
(fn test-split-spaces []
(faith.= [] (utils.split-spaces ""))
(faith.= ["foo"] (utils.split-spaces "foo"))
(faith.= ["foo"] (utils.split-spaces " foo "))
(faith.= ["foo-bar" "bar" "baz"] (utils.split-spaces "foo-bar bar baz"))
(faith.= ["foo-bar" "bar" "baz"] (utils.split-spaces " foo-bar bar baz "))
nil)
{: test-multi-sym-split
: test-find-symbol
: test-failure
: test-split-spaces}

52
test/references-test.fnl
View File

@ -1,52 +0,0 @@
(import-macros {: is-matching : describe : it : before-each} :test)
(local is (require :test.is))
(local {: null} (require :fennel-ls.json.json))
(local {: view} (require :fennel))
(local {: ROOT-URI
: create-client} (require :test.client))
(local filename (.. ROOT-URI "/imaginary-file.fnl"))
(fn range [a b c d]
{:start {:line a :character b}
:end {:line c :character d}})
(fn check-references [body line col expected]
(let [client (doto (create-client)
(: :open-file! filename body))
response (client:references filename line col)]
(is-matching response
(where [{:jsonrpc "2.0" :id client.prev-id
:result ?result}]
(is.same ?result expected)))))
(describe "references"
(it "finds a reference from let"
(check-references "(let [x 10] x)" 0 12
[{:uri filename :range (range 0 12 0 13)}]))
(it "finds a reference from let"
(check-references "(let [x 10] x)" 0 6
[{:uri filename :range (range 0 12 0 13)}]))
(let [x 10] x x x)
(it "finds multiple reference from let"
(check-references "(let [x 10] x x x)" 0 6
[{:uri filename :range (range 0 12 0 13)}
{:uri filename :range (range 0 14 0 15)}
{:uri filename :range (range 0 16 0 17)}]))
(it "finds a reference from fn"
(check-references "(fn x []) x" 0 10
[{:uri filename :range (range 0 10 0 11)}]))
(it "finds a reference from fn"
(check-references "(fn x []) x" 0 4
[{:uri filename :range (range 0 10 0 11)}]))
(it "doesn't crash here"
(check-references "(let [x nil] x.y)" 0 14
null)))

47
test/references.fnl Normal file
View File

@ -0,0 +1,47 @@
(local faith (require :faith))
(local {: create-client-with-files} (require :test.utils))
(local {: null} (require :fennel-ls.json.json))
(local {: view} (require :fennel))
(fn location-comparator [a b]
(or (< a.uri b.uri)
(and (= a.uri b.uri)
(or (< a.range.start.line b.range.start.line)
(and (= a.range.start.line b.range.start.line)
(or (< a.range.start.character b.range.start.character)
(and (= a.range.start.character b.range.start.character)
(or (< a.range.end.line b.range.end.line)
(and (= a.range.end.line b.range.end.line)
(or (< a.range.end.character b.range.end.character)
(= a.range.end.character b.range.end.character)))))))))))
(fn check [file-contents]
(let [{: self : uri : cursor : locations} (create-client-with-files file-contents)
[response] (self:references uri cursor)]
(if (not= null response.result)
(do
(table.sort locations location-comparator)
(table.sort response.result location-comparator)
(faith.= locations response.result
(view file-contents)))
(faith.= locations []))))
(fn test-references []
(check "(let [x 10] ==x==|)")
(check "(let [x| 10] ==x==)")
(check "(let [x| 10] ==x== ==x== ==x==)")
(check "(fn x []) ==x|==")
(check "(fn x []) ==|x==")
(check "(fn x| []) ==x==")
(check "(fn x [])| x")
(check "(let [x nil] ==|x.y== ==x.z==)")
;; TODO decide this the other way
;; (check "(let [x nil] ==x|.y== ==x.z==)")
(check "(let [x nil] x.|y x.z)")
(check "(let [x nil] x.y| x.z)")
(check "(let [x| 10]
(print ==x==)
(let [x :shadowed] x))")
nil)
{: test-references}

62
test/rename-test.fnl
View File

@ -1,62 +0,0 @@
(import-macros {: is-matching : is-casing : describe : it : before-each} :test)
(local utils (require :fennel-ls.utils))
(local is (require :test.is))
(local {: view} (require :fennel))
(local {: ROOT-URI
: create-client} (require :test.client))
(local filename (.. ROOT-URI "/imaginary-file.fnl"))
(fn check-rename [body line col new-name new-body]
(let [client (doto (create-client)
(: :open-file! filename body))
[{: result}] (client:rename filename line col new-name)
changes (. result.changes filename)
body (. client.server.files filename :text)]
(is.equal
(utils.apply-edits body changes client.server.position-encoding)
new-body)))
(describe "rename"
(it "renames a variable"
(check-rename "(let [old-name 100] old-name)" 0 9 :new-name
"(let [new-name 100] new-name)"))
(it "renames a variable 2"
(check-rename "(let [old-name 100] (print old-name) (print old-name))" 0 9 :new-name!!
"(let [new-name!! 100] (print new-name!!) (print new-name!!))"))
(it "renames a multisym"
(check-rename "(let [old-name {:field 10}] old-name.field)" 0 9 :new
"(let [new {:field 10}] new.field)")
(check-rename "(let [old-name {:field 10}] old-name.field)" 0 30 :new
"(let [new {:field 10}] new.field)")
(check-rename "(let [[old-name] [{:field 10}]] (old-name:field 10))" 0 7 :new
"(let [[new] [{:field 10}]] (new:field 10))")
(check-rename "(let [[old-name] [{:field 10}]] (case 1 (where 1 (old-name:field 10)) 1)" 0 7 :new
"(let [[new] [{:field 10}]] (case 1 (where 1 (new:field 10)) 1)"))
(it "renames from destructure/args"
(check-rename "(fn [{: x}] x)" 0 8 :foo "(fn [{: foo}] foo)")
(check-rename "(fn [{:x x}] x)" 0 9 :foo "(fn [{:x foo}] foo)"))
(it "renames a sym inside of lambda"
(check-rename "(λ [foo] (print foo))" 0 6 :something
"(λ [something] (print something))"))
(it "renames a sym inside of set"
(check-rename "(var x 10)\n(set x 20)" 1 6 :something
"(var something 10)\n(set something 20)"))
(it "renames a sym inside of set 2"
(check-rename "(var x 10)\n(var m 0)\n(set (m x) (values 10 20))" 2 8 :something
"(var something 10)\n(var m 0)\n(set (m something) (values 10 20))"))
(it "renames a sym inside of set 3"
(check-rename "(var (x y) 10)\n(set (x y) 10)" 1 8 :something
"(var (x something) 10)\n(set (x something) 10)"))
(it "renames a sym inside of macro that uses multiple times"
(check-rename "(var x 10)\n(doto x (set 20) (set 30))" 1 6 :something
"(var something 10)\n(doto something (set 20) (set 30))")))

60
test/rename.fnl Normal file
View File

@ -0,0 +1,60 @@
(local faith (require :faith))
(local {: create-client-with-files
: default-encoding} (require :test.utils))
(local {: null} (require :fennel-ls.json.json))
(local {: apply-edits} (require :fennel-ls.utils))
(fn check [file-content new-name expected-file-content]
(let [{: self : uri : cursor : text} (create-client-with-files file-content)
[{: result}] (self:rename uri cursor new-name)]
(if (= null result)
(faith.= expected-file-content text)
(let [new-content (apply-edits text (. result.changes uri) default-encoding)]
(faith.= expected-file-content new-content)))))
(fn test-rename []
(check "(let [old-name| 100] old-name)" :new-name
"(let [new-name 100] new-name)")
(check "(let [old-name| 100] (print old-name) (print old-name))" :new-name!!
"(let [new-name!! 100] (print new-name!!) (print new-name!!))")
(check "(let [old|-name {:field 10}] old-name.field)" :new
"(let [new {:field 10}] new.field)")
(check "(let [old-name {:field 10}] old-|name.field)" :new
"(let [new {:field 10}] new.field)")
(check "(let [[|old-name] [{:field 10}]] (old-name:field 10))" :new
"(let [[new] [{:field 10}]] (new:field 10))")
(check "(let [[|old-name] [{:field 10}]] (case 1 (where 1 (old-name:field 10)) 1)" :new
"(let [[new] [{:field 10}]] (case 1 (where 1 (new:field 10)) 1)")
(check "(fn [{: x|}] x)" :foo
"(fn [{: foo}] foo)")
(check "(fn [{:x x|}] x)" :foo
"(fn [{:x foo}] foo)")
(check "(λ [foo|] (print foo))" :something
"(λ [something] (print something))")
(check "(var x 10)
(set x| 20)" :something
"(var something 10)
(set something 20)")
(check "(var x 10)
(var m 0)
(set (m |x) (values 10 20))" :something
"(var something 10)
(var m 0)
(set (m something) (values 10 20))")
(check "(var (x y) 10)
(set (x |y) 10)" :something
"(var (x something) 10)
(set (x something) 10)")
(check "(var x 10)
(doto |x (set 20) (set 30))" :something
"(var something 10)
(doto something (set 20) (set 30))"))
{: test-rename}

63
test/settings-test.fnl
View File

@ -1,63 +0,0 @@
(import-macros {: is-matching : describe : it : before-each} :test)
(local is (require :test.is))
(local {: view} (require :fennel))
(local {: ROOT-URI
: ROOT-PATH
: create-client} (require :test.client))
(describe "settings"
(it "can set the path"
(let [client (doto (create-client {:settings {:fennel-ls {:fennel-path "./?/?.fnl"}}})
(: :open-file! (.. ROOT-URI :/test.fnl) "(local {: this-is-in-modname} (require :modname))"))
result (client:definition (.. ROOT-URI :/test.fnl) 0 12)]
(is-matching
result
[{:result {:range _range}}]
"error message")))
(it "can set the macro path"
(let [client (create-client {:settings {:fennel-ls {:macro-path "./?/?.fnl"}}})
responses (client:open-file! (.. ROOT-URI :/test.fnl) "(import-macros {: this-is-in-modname} :modname)")]
(assert (not (. responses 1 :params :diagnostics 1)) "if the import-macros fails it generates a diagnostic (for now at least)")))
;; (it "recompiles modules if the macro files are modified)"
;; (it "can infer the macro path from fennel-path"
;; (local self (doto [] (setup-server {:fennel-ls {:fennel-path "./?/?.fnl"}}))))
(it "can set extra allowed globals"
(let [client (create-client {:settings {:fennel-ls {:extra-globals "foo-100 bar"}}})
responses (client:open-file! (.. ROOT-URI :/test.fnl) "(foo-100 bar :baz)")]
(is-matching responses
[{:method :textDocument/publishDiagnostics
:params {:diagnostics [nil]}}]
"bad")))
;; (it "can turn off strict globals"
;; (local self (doto [] (setup-server {:fennel-ls {:checks {:globals false}}}))))
;; (it "can treat globals as a warning instead of an error"
;; (local self (doto [] (setup-server {:fennel-ls {:diagnostics {:E202 "warning"}}})))))
;; I suspect this test will fail when I put warnings for module return type
(it "can disable some lints"
(let [client (create-client {:settings {:fennel-ls {:checks {:unused-definition false}}}})
responses (client:open-file! (.. ROOT-URI :/test.fnl) "(local x 10)")]
(is-matching responses
[{:method :textDocument/publishDiagnostics
:params {:diagnostics [nil]}}]
"bad")))
(it "can be configured with initialization options"
(let [initializationOptions {:fennel-ls {:checks {:unused-definition false}}}
client (create-client {:params {: initializationOptions
:rootPath ROOT-PATH
:rootUri ROOT-URI
:workspaceFolders [{:name ROOT-PATH
:uri ROOT-URI}]}})
responses (client:open-file! (.. ROOT-URI :/test.fnl) "(local x 10)")]
(is-matching responses
[{:method :textDocument/publishDiagnostics
:params {:diagnostics [nil]}}]
"settings should apply when set through initializationOptions"))))

67
test/settings.fnl Normal file
View File

@ -0,0 +1,67 @@
(local faith (require :faith))
(local {: ROOT-URI
: ROOT-PATH} (require :test.utils.client))
(local {: create-client-with-files} (require :test.utils))
(fn test-path []
(let [{: self : uri : cursor :locations [location]}
(create-client-with-files
{:modname.fnl "{:this-is-in-modname {:this :one :isnt :on :the :path}}"
:modname/modname/modname/modname.fnl "(fn ==this-is-in-modname== [] nil) {: this-is-in-modname}"
:main.fnl "(local {: this-is-in-mod|name} (require :modname))"}
{:settings {:fennel-ls {:fennel-path "./?/?/?/?.fnl"}}})
[response] (self:definition uri cursor)]
(faith.= location response.result
"error message")))
;; TODO fix macros to use a custom searcher
; (let [{: diagnostics}
; (create-client-with-files
; {:modname.fnl "{:this-is-in-modname {:this :one :isnt :on :the :path}}"
; :modname/modname/modname/modname.fnl "(fn this-is-in-modname [] nil) {: this-is-in-modname}"
; :main.fnl "(import-macros {: this-is-in-modname} :modname)
; (this-is-in-modname)"}
; {:settings {:fennel-ls {:macro-path "./?/?/?/?.fnl"}}})]
; (faith.= [] diagnostics) "if the import-macros fails it generates a diagnostic (for now at least)")
; nil)
;; (it "recompiles modules if the macro files are modified)"
;; (it "can infer the macro path from fennel-path"
;; (local self (doto [] ({:settings {:fennel-ls {:fennel-path "./?/?/?/?.fnl"}}))))
(fn test-extra-globals []
(let [{:diagnostics good} (create-client-with-files "(foo-100 bar :baz)" {:settings {:fennel-ls {:extra-globals "foo-100 bar"}}})
{:diagnostics bad} (create-client-with-files "(foo-100 bar :baz)")]
(faith.= [] good)
(faith.not= [] bad))
nil)
;; (it "can turn off strict globals"
;; (local self (doto [] (setup-server {:fennel-ls {:checks {:globals false}}}))))
;; (it "can treat globals as a warning instead of an error"
;; (local self (doto [] (setup-server {:fennel-ls {:diagnostics {:E202 "warning"}}})))))
(fn test-lints []
(let [{:diagnostics good} (create-client-with-files "(local x 10)" {:settings {:fennel-ls {:checks {:unused-definition false}}}})
{:diagnostics bad} (create-client-with-files "(local x 10)")]
(faith.= [] good)
(faith.not= [] bad))
nil)
(fn test-initialization-options []
(let [initializationOptions {:fennel-ls {:checks {:unused-definition false}}}
{: diagnostics} (create-client-with-files "(local x 10)" {:params {: initializationOptions
:rootPath ROOT-PATH
:rootUri ROOT-URI
:workspaceFolders [{:name ROOT-PATH
:uri ROOT-URI}]}})]
(faith.= [] diagnostics))
nil)
{: test-path
: test-extra-globals
: test-lints
: test-initialization-options}

111
test/string-processing-test.fnl
View File

@ -1,111 +0,0 @@
(import-macros {: is-matching : describe : it} :test)
(local is (require :test.is))
(local fennel (require :fennel))
(local utils (require :fennel-ls.utils))
(describe "utils"
(fn position [line character]
{: line : character})
(fn range [start-line start-col end-line end-col]
{:start (position start-line start-col) :end (position end-line end-col)})
;; "a" U+0061 is in U+0000 to U+007F, and therefore is 1 byte in UTF-8, and 1 codepoint in UTF-16
;; "λ" U+03BB is in U+0080 to U+07FF, and therefore is 2 bytes in UTF-8, and 1 codepoint in UTF-16
;; "ｾ" U+FF7E is in U+0800 to U+FFFF, and therefore is 3 bytes in UTF-8, and 1 codepoint in UTF-16
;; "𐐀" U+10400 is in U+10000 to U+10FFFF,and therefore is 4 bytes in UTF-8, and 2 codepoints in UTF-16
;; These symbols cover each of the four cases of byte/codepoint widths
;; they should be sufficient for testing
(it "converts position->byte properly"
(is.equal 1 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 0 0) :utf-8))
(is.equal 2 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 0 1) :utf-8))
(is.equal 6 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 0 5) :utf-8))
(is.equal 8 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 0 7) :utf-8))
(is.equal 9 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 1 0) :utf-8))
(is.equal 10 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 1 1) :utf-8))
(is.equal 12 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 1 3) :utf-8))
(is.equal 16 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 1 7) :utf-8))
(is.equal 1 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 0 0) :utf-16))
(is.equal 2 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 0 1) :utf-16))
(is.equal 6 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 0 3) :utf-16))
(is.equal 8 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 0 4) :utf-16))
(is.equal 9 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 1 0) :utf-16))
(is.equal 10 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 1 1) :utf-16))
(is.equal 12 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 1 2) :utf-16))
(is.equal 16 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 1 4) :utf-16))
(is.equal 19 (utils.position->byte "a𐐀ｾλ\nbλ𐐀" (position 1 4) :utf-16))
(is.equal 19 (utils.position->byte "a𐐀ｾλ\nbλ𐐀" (position 1 4) :utf-16))
(is.equal 7 (utils.position->byte "ｾｾ" (position 0 2) :utf-16)))
(it "converts byte->position properly"
(is.same (position 0 0) (utils.byte->position "a𐐀λ\nbλ𐐀" 1 :utf-8))
(is.same (position 0 1) (utils.byte->position "a𐐀λ\nbλ𐐀" 2 :utf-8))
(is.same (position 0 5) (utils.byte->position "a𐐀λ\nbλ𐐀" 6 :utf-8))
(is.same (position 0 7) (utils.byte->position "a𐐀λ\nbλ𐐀" 8 :utf-8))
(is.same (position 1 0) (utils.byte->position "a𐐀λ\nbλ𐐀" 9 :utf-8))
(is.same (position 1 1) (utils.byte->position "a𐐀λ\nbλ𐐀" 10 :utf-8))
(is.same (position 1 3) (utils.byte->position "a𐐀λ\nbλ𐐀" 12 :utf-8))
(is.same (position 1 7) (utils.byte->position "a𐐀λ\nbλ𐐀" 16 :utf-8))
(is.same (position 0 0) (utils.byte->position "a𐐀λ\nbλ𐐀" 1 :utf-16))
(is.same (position 0 1) (utils.byte->position "a𐐀λ\nbλ𐐀" 2 :utf-16))
(is.same (position 0 3) (utils.byte->position "a𐐀λ\nbλ𐐀" 6 :utf-16))
(is.same (position 0 4) (utils.byte->position "a𐐀λ\nbλ𐐀" 8 :utf-16))
(is.same (position 1 0) (utils.byte->position "a𐐀λ\nbλ𐐀" 9 :utf-16))
(is.same (position 1 1) (utils.byte->position "a𐐀λ\nbλ𐐀" 10 :utf-16))
(is.same (position 1 2) (utils.byte->position "a𐐀λ\nbλ𐐀" 12 :utf-16))
(is.same (position 1 4) (utils.byte->position "a𐐀λ\nbλ𐐀" 16 :utf-16))
(is.same (position 1 4) (utils.byte->position "a𐐀ｾλ\nbλ𐐀" 19 :utf-16))
(is.same (position 1 4) (utils.byte->position "a𐐀ｾλ\nbλ𐐀" 19 :utf-16))
(is.same (position 0 2) (utils.byte->position "ｾｾ" 7 :utf-16)))
(describe "apply-changes"
(it "updates the start of a line"
(is.equal
(utils.apply-changes
"replace beginning"
[{:range (range 0 0 0 7)
:text "the"}]
:utf-8)
"the beginning"))
(it "updates the end of a line"
(is.equal
(utils.apply-changes
"first line\nsecond line\nreplace end"
[{:range (range 2 7 2 11)
:text "ment"}]
:utf-8)
"first line\nsecond line\nreplacement"))
(it "replaces a line"
(is.equal
(utils.apply-changes
"replace all"
[{:range (range 0 0 0 11)
:text "new string"}]
:utf-8)
"new string"))
(it "can handle substituting things"
(is.equal
(utils.apply-changes
"replace beginning"
[{:range (range 0 0 0 7)
:text "the"}]
:utf-8)
"the beginning"))
(it "can handle replacing everything"
(is.equal
(utils.apply-changes
"this is the\nold file"
[{:text "And this is the\nnew file"}]
:utf-8)
"And this is the\nnew file"))))
;; (it "can substitute multiple ranges")

90
test/string-processing.fnl Normal file
View File

@ -0,0 +1,90 @@
(local faith (require :faith))
(local utils (require :fennel-ls.utils))
(fn position [line character]
{: line : character})
(fn range [start-line start-col end-line end-col]
{:start (position start-line start-col) :end (position end-line end-col)})
;; "a" U+0061 is in U+0000 to U+007F, and therefore is 1 byte in UTF-8, and 1 codepoint in UTF-16
;; "λ" U+03BB is in U+0080 to U+07FF, and therefore is 2 bytes in UTF-8, and 1 codepoint in UTF-16
;; "ｾ" U+FF7E is in U+0800 to U+FFFF, and therefore is 3 bytes in UTF-8, and 1 codepoint in UTF-16
;; "𐐀" U+10400 is in U+10000 to U+10FFFF,and therefore is 4 bytes in UTF-8, and 2 codepoints in UTF-16
;; These symbols cover each of the four cases of byte/codepoint widths
;; they should be sufficient for testing
(fn test-position->byte []
(faith.= 1 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 0 0) :utf-8))
(faith.= 2 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 0 1) :utf-8))
(faith.= 6 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 0 5) :utf-8))
(faith.= 8 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 0 7) :utf-8))
(faith.= 9 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 1 0) :utf-8))
(faith.= 10 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 1 1) :utf-8))
(faith.= 12 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 1 3) :utf-8))
(faith.= 16 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 1 7) :utf-8))
(faith.= 1 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 0 0) :utf-16))
(faith.= 2 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 0 1) :utf-16))
(faith.= 6 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 0 3) :utf-16))
(faith.= 8 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 0 4) :utf-16))
(faith.= 9 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 1 0) :utf-16))
(faith.= 10 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 1 1) :utf-16))
(faith.= 12 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 1 2) :utf-16))
(faith.= 16 (utils.position->byte "a𐐀λ\nbλ𐐀" (position 1 4) :utf-16))
(faith.= 19 (utils.position->byte "a𐐀ｾλ\nbλ𐐀" (position 1 4) :utf-16))
(faith.= 19 (utils.position->byte "a𐐀ｾλ\nbλ𐐀" (position 1 4) :utf-16))
(faith.= 7 (utils.position->byte "ｾｾ" (position 0 2) :utf-16))
nil)
(fn test-byte->position []
(faith.= (position 0 0) (utils.byte->position "a𐐀λ\nbλ𐐀" 1 :utf-8))
(faith.= (position 0 1) (utils.byte->position "a𐐀λ\nbλ𐐀" 2 :utf-8))
(faith.= (position 0 5) (utils.byte->position "a𐐀λ\nbλ𐐀" 6 :utf-8))
(faith.= (position 0 7) (utils.byte->position "a𐐀λ\nbλ𐐀" 8 :utf-8))
(faith.= (position 1 0) (utils.byte->position "a𐐀λ\nbλ𐐀" 9 :utf-8))
(faith.= (position 1 1) (utils.byte->position "a𐐀λ\nbλ𐐀" 10 :utf-8))
(faith.= (position 1 3) (utils.byte->position "a𐐀λ\nbλ𐐀" 12 :utf-8))
(faith.= (position 1 7) (utils.byte->position "a𐐀λ\nbλ𐐀" 16 :utf-8))
(faith.= (position 0 0) (utils.byte->position "a𐐀λ\nbλ𐐀" 1 :utf-16))
(faith.= (position 0 1) (utils.byte->position "a𐐀λ\nbλ𐐀" 2 :utf-16))
(faith.= (position 0 3) (utils.byte->position "a𐐀λ\nbλ𐐀" 6 :utf-16))
(faith.= (position 0 4) (utils.byte->position "a𐐀λ\nbλ𐐀" 8 :utf-16))
(faith.= (position 1 0) (utils.byte->position "a𐐀λ\nbλ𐐀" 9 :utf-16))
(faith.= (position 1 1) (utils.byte->position "a𐐀λ\nbλ𐐀" 10 :utf-16))
(faith.= (position 1 2) (utils.byte->position "a𐐀λ\nbλ𐐀" 12 :utf-16))
(faith.= (position 1 4) (utils.byte->position "a𐐀λ\nbλ𐐀" 16 :utf-16))
(faith.= (position 1 4) (utils.byte->position "a𐐀ｾλ\nbλ𐐀" 19 :utf-16))
(faith.= (position 1 4) (utils.byte->position "a𐐀ｾλ\nbλ𐐀" 19 :utf-16))
(faith.= (position 0 2) (utils.byte->position "ｾｾ" 7 :utf-16))
nil)
(fn test-apply-changes []
(faith.= "the beginning"
(utils.apply-changes
"replace beginning"
[{:range (range 0 0 0 7) :text "the"}]
:utf-8))
(faith.= "first line\nsecond line\nreplacement"
(utils.apply-changes
"first line\nsecond line\nreplace end"
[{:range (range 2 7 2 11) :text "ment"}]
:utf-8))
(faith.= "new string"
(utils.apply-changes
"replace all"
[{:range (range 0 0 0 11) :text "new string"}]
:utf-8))
(faith.=
(utils.apply-changes
"this is the\nold file"
[{:text "And this is the\nnew file"}]
:utf-8)
"And this is the\nnew file"))
;; TODO test substitute multiple ranges
{: test-position->byte
: test-byte->position
: test-apply-changes}

1
test/test-project/bar.fnl
View File

@ -1 +0,0 @@
{}

10
test/test-project/baz.fnl
View File

@ -1,10 +0,0 @@
(fn bazfn []
(print "you called bazfn"))
(fn unused []
(print "this function is unused"))
(fn unused2 []
(print "this function is unused, but also exported. Tricky!"))
{: bazfn : unused2}

6
test/test-project/foo.fnl
View File

@ -1,6 +0,0 @@
(local constant 5)
(fn my-export [a]
a)
{: my-export : constant}

23
test/test-project/hover.fnl
View File

@ -1,23 +0,0 @@
(fn my-function [arg1 arg2 arg3]
(let [result nil]
result))
(local foo 300)
(let [bar "some text"]
(my-function foo bar 3))
(local foo {:field1 10 :field2 :colon-string})
(my-function foo.field1 foo.field2)
(local empty nil)
(print empty)
(λ lambda-fn [arg1 arg2]
"docstring"
(print "body")
nil)
(lambda-fn 1 2)
(case {:x [10 {:AB :CD}]}
{:x [_ val]} (print val))

5
test/test-project/modname/modname.fnl
View File

@ -1,5 +0,0 @@
(fn this-is-in-modname []
"this is a docstring"
nil)
{: this-is-in-modname}

28
test/client.fnl → test/utils/client.fnl
View File

@ -10,8 +10,9 @@
(local ROOT-URI
(.. "file://" ROOT-PATH))
(local default-encoding :utf-8)
(local default-params
{:capabilities {:general {:positionEncodings [:utf-8]}}
{:capabilities {:general {:positionEncodings [default-encoding]}}
:clientInfo {:name "Neovim" :version "0.7.2"}
:initializationOptions {}
:processId 16245
@ -50,40 +51,44 @@
:version 1
: text}})))
(fn completion [self file line character]
(fn pretend-this-file-exists! [self name text]
(tset self.server.preload name text))
(fn completion [self file position]
(dispatch.handle* self.server
(message.create-request (next-id! self) :textDocument/completion
{:position {: line : character}
{: position
:textDocument {:uri file}})))
(fn definition [self file line character]
(fn definition [self file position]
(dispatch.handle* self.server
(message.create-request (next-id! self) :textDocument/definition
{:position {: line : character}
{: position
:textDocument {:uri file}})))
(fn hover [self file line character]
(fn hover [self file position]
(dispatch.handle* self.server
(message.create-request (next-id! self) :textDocument/hover
{:position {: line : character}
{: position
:textDocument {:uri file}})))
(fn references [self file line character ?includeDeclaration]
(fn references [self file position ?includeDeclaration]
(dispatch.handle* self.server
(message.create-request (next-id! self) :textDocument/references
{:position {: line : character}
{: position
:textDocument {:uri file}
:context {:includeDeclaration (not (not ?includeDeclaration))}})))
(fn rename [self file line character newName]
(fn rename [self file position newName]
(dispatch.handle* self.server
(message.create-request (next-id! self) :textDocument/rename
{:position {: line : character}
{: position
:textDocument {:uri file}
: newName})))
(set mt.__index
{: open-file!
: pretend-this-file-exists!
: completion
: definition
: hover
@ -91,5 +96,6 @@
: rename})
{: create-client
: default-encoding
: ROOT-URI
: ROOT-PATH}

68
test/utils/init.fnl Normal file
View File

@ -0,0 +1,68 @@
(local {: ROOT-URI
: create-client
: default-encoding} (require :test.utils.client))
(local utils (require :fennel-ls.utils))
(fn get-markup [text ?encoding]
"find the | character, which represents the cursor position"
(var text text)
(let [result {:ranges []}
encoding (or ?encoding default-encoding)]
(while
(case
(case (values (text:find "|") (text:find "=="))
(where (| ==) (< | ==)) [| "|"]
(_ ==) [== "=="]
(| _) [| "|"])
[i "|"]
(do
(set text (.. (text:sub 1 (- i 1)) (text:sub (+ i 1))))
(set result.cursor (utils.byte->position text i encoding))
true)
[i "=="]
(do
(set text (.. (text:sub 1 (- i 1)) (text:sub (+ i 2))))
(let [position (utils.byte->position text i encoding)]
(if result.unmatched-range
(do
(table.insert result.ranges {:start result.unmatched-range :end position})
(set result.unmatched-range nil))
(set result.unmatched-range position)))
true)
nil nil))
(set result.text text)
result))
(fn create-client-with-files [file-contents ?client-options]
(let [file-contents (if (= (type file-contents) :string)
{:main.fnl file-contents}
file-contents)
self (create-client ?client-options)
locations []]
(each [name marked (pairs file-contents)]
(if (not= name :main.fnl)
(let [uri (.. ROOT-URI "/" name)
{: text : ranges} (get-markup marked)]
(icollect [_ range (ipairs ranges) &into locations]
{: range : uri})
(self:pretend-this-file-exists! uri text))))
(let [uri (.. ROOT-URI "/" :main.fnl)
main-file-contents (. file-contents :main.fnl)
{: text : ranges : cursor} (get-markup main-file-contents)]
(icollect [_ range (ipairs ranges) &into locations]
{: range : uri})
(let [[{:params {: diagnostics}}] (self:open-file! uri text)]
{: self
: diagnostics
: cursor
: locations
: text
: uri}))))
(fn position-past-end-of-text [text ?encoding]
(utils.byte->position text (+ (length text) 1) (or ?encoding default-encoding)))
{: create-client-with-files
: position-past-end-of-text
: default-encoding
: get-markup}