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

upgrade to faith 0.2.0

Browse Source
This commit is contained in:
XeroOl 2024-06-14 18:18:21 -05:00
parent 3d2d738636
commit e165aa1402
2 changed files with 128 additions and 89 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

208
deps/faith.fnl vendored
View File

@ -2,13 +2,16 @@
;; https://git.sr.ht/~technomancy/faith
;; SPDX-License-Identifier: MIT
;; SPDX-FileCopyrightText: Scott Vokes, Phil Hagelberg, and contributors
;; 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
;; Copyright © 2023-2024 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
@ -45,21 +48,11 @@
: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 "")
(string.format "FAIL: %s:\n%s: %s%s\n"
name where (or reason "")
(or (and msg (.. " - " (tostring msg))) "")))
(fn err->string [{: msg} name]
@ -68,7 +61,7 @@
(fn get-where [start]
(let [traceback (fennel.traceback nil start)
(_ _ where) (traceback:find "\n *([^:]+:[0-9]+):")]
(_ _ where) (traceback:find "\n\t*([^:]+:[0-9]+):")]
(or where "?")))
;;; assertions
@ -77,7 +70,11 @@
;; 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)
(var checked 0)
(var diff-cmd (or (os.getenv "FAITH_DIFF")
(if (os.getenv "NO_COLOR")
"diff -u %s %s"
"diff -u --color=always %s %s")))
(macro wrap [flag msg ...]
`(do (set ,(sym :checked) (+ ,(sym :checked) 1))
@ -95,17 +92,11 @@
(fn is [got ?msg]
(wrap got ?msg "Expected truthy value"))
(fn error* [f ?msg]
(fn error* [pat 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))
(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
(wrap (err-string:match pat) ?msg
"Expected error to match pattern %s, was %s"
pat err-string))))
@ -127,9 +118,30 @@
(or (= x y)
(and (= (type x) :table (type y)) (table= x y equal?))))
(fn diff-report [expv gotv]
(let [exp-file (os.tmpname "faithdiff1")
got-file (os.tmpname "faithdiff2")]
(with-open [f (io.open exp-file :w)]
(f:write expv))
(with-open [f (io.open got-file :w)]
(f:write gotv))
(let [diff (doto (io.popen (diff-cmd:format exp-file got-file))
(: :read) (: :read) (: :read)) ; omit header lines
out (diff:read :*all)]
(os.remove exp-file)
(os.remove got-file)
(let [(closed _ code) (diff:close)]
(if (or closed (= 1 code))
(.. "\n" out)
(string.format "Expected:\n%s\nGot:\n%s" expv gotv))))))
(fn =* [exp got ?msg]
(wrap (equal? exp got) ?msg "Expected %s, got %s"
(fennel.view exp) (fennel.view got)))
(let [expv (fennel.view exp)
gotv (fennel.view got)
report (if (and (not= expv gotv) (or (expv:find "\n") (gotv:find "\n")))
(diff-report expv gotv)
(string.format "Expected %s, got %s" expv gotv))]
(wrap (equal? exp got) ?msg report)))
(fn not=* [exp got ?msg]
(wrap (not (equal? exp got)) ?msg "Expected something other than %s"
@ -158,7 +170,7 @@
"Expected %s +/- %s, got %s" exp tolerance got))
(fn identical [exp got ?msg]
(wrap (= exp got) ?msg
(wrap (rawequal exp got) ?msg
"Expected %s, got %s" (fennel.view exp) (fennel.view got)))
(fn match* [pat s ?msg]
@ -171,19 +183,23 @@
;;; running
(fn dot [c ran]
(io.write c)
(when (= 0 (math.fmod ran 76))
(fn dot [char total-count]
(io.write char)
(when (= 0 (math.fmod total-count 76))
(io.write "\n"))
(io.stdout:flush))
(fn print-totals [{: pass : fail : skip : err : started-at : ended-at}]
(let [duration (fn [start end]
(fn print-totals [report]
(let [{: started-at : ended-at : results} report
duration (fn [start end]
(let [decimal-places 2]
(: (.. "%." (tonumber decimal-places) "f")
:format
(math.max (- end start)
(math.pow 10 (- decimal-places))))))]
(^ 10 (- decimal-places))))))
counts (accumulate [counts {:pass 0 :fail 0 :err 0 :skip 0}
_ {:type type*} (ipairs results)]
(doto counts (tset type* (+ (. counts type*) 1))))]
(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")
@ -194,25 +210,30 @@
(: "in approximately %s second(s)" :format
(- ended-at.approx started-at.approx)))
checked
(count pass) (count fail) (count err) (count skip)
counts.pass
counts.fail
counts.err
counts.skip
(duration started-at.cpu ended-at.cpu)))))
(fn begin-module [s-env tests]
(fn begin-module [report tests]
(print (string.format "\nStarting module %s with %d test(s)"
s-env.name (count tests))))
(fn done [results]
report.module-name
(accumulate [count 0 _ (pairs tests)] (+ count 1)))))
(fn done [report]
(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))
(each [_ result (ipairs report.results)]
(when result.tostring (print (result:tostring result.name))))
(print-totals report))
(local default-hooks {:begin false
: done
: begin-module
:end-module false
:begin-test false
:end-test (fn [_name result ran] (dot result.char ran))})
:end-test (fn [_name result total-count]
(dot result.char total-count))})
(fn test-key? [k]
(and (= (type k) :string) (k:match :^test.*)))
@ -226,77 +247,94 @@
(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]
(fn run-test [name ?setup test ?teardown report 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)
(let [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))))
(table.insert report.results (doto result (tset :name name)))
(when (fn? hooks.end-test)
(hooks.end-test name result (length report.results)))))
(fn run-setup-all [setup-all results module-name]
(fn run-setup-all [setup-all report 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))
(table.insert report.results
(doto (error-result msg)
(tset :name module-name)))
(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)
(fn run-module [hooks report module-name test-module]
(assert (= :table (type test-module))
(.. "test module must be table: " module-name))
(let [module-report {: module-name :started-at (now) :results []}]
(case (run-setup-all test-module.setup-all report 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)))
(when hooks.begin-module
(hooks.begin-module module-report test-module))
(each [_ {: name : test}
(ipairs (doto (icollect [name test (pairs test-module)]
(if (test-key? name)
{:line (. (debug.getinfo test :S)
:linedefined)
: name : test}))
(table.sort #(< $1.line $2.line))))]
(run-test name
test-module.setup
test
test-module.teardown
module-report
hooks
context))
(case test-module.teardown-all
teardown (pcall teardown (unpack context)))
(when hooks.end-module (hooks.end-module result))
(combine-results results result)))))
(when hooks.end-module (hooks.end-module module-report))
(icollect [_ value
(ipairs module-report.results)
&into report.results]
value)))))
(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)
(fn run [module-names ?opts]
(set (checked diff-cmd) (values 0 (or (and ?opts ?opts.diff-cmd) diff-cmd)))
(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)]
(each [_ m (ipairs module-names)] (require m))
(let [hooks (setmetatable (or (?. ?opts :hooks) {}) {:__index default-hooks})
report {:module-name :main :started-at (now) :results []}]
(when hooks.begin
(hooks.begin results module-names))
(hooks.begin report 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))
(true test-module) (run-module hooks report module-name test-module)
(false err) (let [error (: "ERROR: Cannot load %q:\n%s"
:format module-name err)]
(table.insert report.results
(doto (error-result error)
(tset :name module-name))))))
(set report.ended-at (now))
(when hooks.done (hooks.done report))
(when (accumulate [red false
_ {:type type*} (ipairs report.results)
&until red]
(or (= type* :fail)
(= type* :err)))
(exit hooks))))
{: run : skip :version "0.1.2"
: is :error error* : error-match := =* :not= not=* :< <* :<= <=* : almost=
(when (= ... "--tests")
(run (doto [...] (table.remove 1)))
(os.exit 0))
{: run : skip :version "0.2.0"
: is :error error* := =* :not= not=* :< <* :<= <=* : almost=
: identical :match match* : not-match}

9
tools/get-deps.fnl
View File

@ -6,9 +6,10 @@
(sh :git :clone :-c :advice.detachedHead=false :--depth=1 url location)))
(local fennel-version "1.4.2")
(local faith-version "0.1.2")
(local faith-version "0.2.0")
(local penlight-version "1.14.0")
(local dkjson-version "2.7")
;; dkjson is hosted over http (unencrypted), so I check to make sure the file's not been tampered
(local dkjson-md5sum "94320e64e95f9bb5b06d9955e5391a78 build/dkjson.lua")
(local dkjson-sha1sum "6926b65aa74ae8278b6c5923c0c5568af4f1fef1 build/dkjson.lua")
@ -29,11 +30,11 @@
(when (not (io.open "build/penlight/lua/pl/stringio.lua"))
(git-clone "build/penlight" "https://github.com/lunarmodules/Penlight" penlight-version))
;; get dkjson
(when (not (io.open "build/dkjson.lua"))
(sh :curl (.. "http://dkolf.de/dkjson-lua/dkjson-" dkjson-version ".lua") [:>] "build/dkjson.lua")
(assert (= 0 (sh :echo dkjson-md5sum [:|] :md5sum "--check --status")))
(assert (= 0 (sh :echo dkjson-sha1sum [:|] :sha1sum "--check --status"))))
(assert (sh :echo dkjson-md5sum [:|] :md5sum "--check" "--status"))
(assert (sh :echo dkjson-sha1sum [:|] :sha1sum "--check" "--status")))
;; copy to the "deps" folder
(sh :mkdir :-p "deps/")