diff --git a/Makefile b/Makefile index 7fcc6fa..6f1fef0 100644 --- a/Makefile +++ b/Makefile @@ -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 diff --git a/src/fennel-ls/searcher.fnl b/src/fennel-ls/searcher.fnl index 0ea4892..6db669c 100644 --- a/src/fennel-ls/searcher.fnl +++ b/src/fennel-ls/searcher.fnl @@ -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} diff --git a/src/fennel-ls/state.fnl b/src/fennel-ls/state.fnl index 60ddacf..555a2f9 100644 --- a/src/fennel-ls/state.fnl +++ b/src/fennel-ls/state.fnl @@ -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)) diff --git a/test/capabilities-test.fnl b/test/capabilities-test.fnl deleted file mode 100644 index 1c05ee2..0000000 --- a/test/capabilities-test.fnl +++ /dev/null @@ -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)))) - - diff --git a/test/capabilities.fnl b/test/capabilities.fnl new file mode 100644 index 0000000..790ad7b --- /dev/null +++ b/test/capabilities.fnl @@ -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} diff --git a/test/completion-test.fnl b/test/completion-test.fnl deleted file mode 100644 index 41c5dd1..0000000 --- a/test/completion-test.fnl +++ /dev/null @@ -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") diff --git a/test/completion.fnl b/test/completion.fnl new file mode 100644 index 0000000..690b017 --- /dev/null +++ b/test/completion.fnl @@ -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} diff --git a/test/diagnostic-test.fnl b/test/diagnostic-test.fnl deleted file mode 100644 index f23162e..0000000 --- a/test/diagnostic-test.fnl +++ /dev/null @@ -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 diff --git a/test/diagnostic.fnl b/test/diagnostic.fnl new file mode 100644 index 0000000..5c8c5c7 --- /dev/null +++ b/test/diagnostic.fnl @@ -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 ) --> (set .) +;; {&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} diff --git a/test/faith/README.md b/test/faith/README.md new file mode 100644 index 0000000..801a7cc --- /dev/null +++ b/test/faith/README.md @@ -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). diff --git a/test/faith/faith.fnl b/test/faith/faith.fnl new file mode 100644 index 0000000..8c3ad99 --- /dev/null +++ b/test/faith/faith.fnl @@ -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} diff --git a/test/goto-definition-test.fnl b/test/goto-definition-test.fnl deleted file mode 100644 index 2eb02df..0000000 --- a/test/goto-definition-test.fnl +++ /dev/null @@ -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 diff --git a/test/goto-definition.fnl b/test/goto-definition.fnl new file mode 100644 index 0000000..894376d --- /dev/null +++ b/test/goto-definition.fnl @@ -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} diff --git a/test/hover-test.fnl b/test/hover-test.fnl deleted file mode 100644 index 576eea5..0000000 --- a/test/hover-test.fnl +++ /dev/null @@ -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.")))) diff --git a/test/hover.fnl b/test/hover.fnl new file mode 100644 index 0000000..65aae35 --- /dev/null +++ b/test/hover.fnl @@ -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} diff --git a/test/init-macros.fnl b/test/init-macros.fnl deleted file mode 100644 index ea5f175..0000000 --- a/test/init-macros.fnl +++ /dev/null @@ -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} diff --git a/test/init.fnl b/test/init.fnl index f5170e8..7e8d0f2 100644 --- a/test/init.fnl +++ b/test/init.fnl @@ -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]) diff --git a/test/is.fnl b/test/is.fnl deleted file mode 100644 index cace418..0000000 --- a/test/is.fnl +++ /dev/null @@ -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)}) diff --git a/test/json-rpc-test.fnl b/test/json-rpc-test.fnl deleted file mode 100644 index 1ff315e..0000000 --- a/test/json-rpc-test.fnl +++ /dev/null @@ -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)))))) diff --git a/test/json-rpc.fnl b/test/json-rpc.fnl new file mode 100644 index 0000000..9205f2d --- /dev/null +++ b/test/json-rpc.fnl @@ -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} diff --git a/test/lust.lua b/test/lust.lua deleted file mode 100644 index f3b9fd0..0000000 --- a/test/lust.lua +++ /dev/null @@ -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 diff --git a/test/misc-test.fnl b/test/misc-test.fnl deleted file mode 100644 index f4a670f..0000000 --- a/test/misc-test.fnl +++ /dev/null @@ -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 ")))) diff --git a/test/misc.fnl b/test/misc.fnl new file mode 100644 index 0000000..346c452 --- /dev/null +++ b/test/misc.fnl @@ -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} diff --git a/test/references-test.fnl b/test/references-test.fnl deleted file mode 100644 index 1dd869e..0000000 --- a/test/references-test.fnl +++ /dev/null @@ -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))) - diff --git a/test/references.fnl b/test/references.fnl new file mode 100644 index 0000000..a130544 --- /dev/null +++ b/test/references.fnl @@ -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} diff --git a/test/rename-test.fnl b/test/rename-test.fnl deleted file mode 100644 index c078b95..0000000 --- a/test/rename-test.fnl +++ /dev/null @@ -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))"))) diff --git a/test/rename.fnl b/test/rename.fnl new file mode 100644 index 0000000..4fc8eca --- /dev/null +++ b/test/rename.fnl @@ -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} diff --git a/test/settings-test.fnl b/test/settings-test.fnl deleted file mode 100644 index 8d9ec50..0000000 --- a/test/settings-test.fnl +++ /dev/null @@ -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")))) diff --git a/test/settings.fnl b/test/settings.fnl new file mode 100644 index 0000000..14c6f39 --- /dev/null +++ b/test/settings.fnl @@ -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} diff --git a/test/string-processing-test.fnl b/test/string-processing-test.fnl deleted file mode 100644 index b4c6c84..0000000 --- a/test/string-processing-test.fnl +++ /dev/null @@ -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") diff --git a/test/string-processing.fnl b/test/string-processing.fnl new file mode 100644 index 0000000..75087b3 --- /dev/null +++ b/test/string-processing.fnl @@ -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} diff --git a/test/test-project/bar.fnl b/test/test-project/bar.fnl deleted file mode 100644 index 0967ef4..0000000 --- a/test/test-project/bar.fnl +++ /dev/null @@ -1 +0,0 @@ -{} diff --git a/test/test-project/baz.fnl b/test/test-project/baz.fnl deleted file mode 100644 index ad3e105..0000000 --- a/test/test-project/baz.fnl +++ /dev/null @@ -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} diff --git a/test/test-project/foo.fnl b/test/test-project/foo.fnl deleted file mode 100644 index e866187..0000000 --- a/test/test-project/foo.fnl +++ /dev/null @@ -1,6 +0,0 @@ -(local constant 5) - -(fn my-export [a] - a) - -{: my-export : constant} diff --git a/test/test-project/hover.fnl b/test/test-project/hover.fnl deleted file mode 100644 index cdb98cc..0000000 --- a/test/test-project/hover.fnl +++ /dev/null @@ -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)) diff --git a/test/test-project/modname/modname.fnl b/test/test-project/modname/modname.fnl deleted file mode 100644 index 9d260bc..0000000 --- a/test/test-project/modname/modname.fnl +++ /dev/null @@ -1,5 +0,0 @@ -(fn this-is-in-modname [] - "this is a docstring" - nil) - -{: this-is-in-modname} diff --git a/test/client.fnl b/test/utils/client.fnl similarity index 81% rename from test/client.fnl rename to test/utils/client.fnl index c59fd29..d858d7e 100644 --- a/test/client.fnl +++ b/test/utils/client.fnl @@ -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} diff --git a/test/utils/init.fnl b/test/utils/init.fnl new file mode 100644 index 0000000..f9ccbfa --- /dev/null +++ b/test/utils/init.fnl @@ -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}