diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/lux/test.lux | 88 |
1 files changed, 65 insertions, 23 deletions
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index cca7205fd..18f487ff4 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -10,10 +10,12 @@ ["<>" parser ["<c>" code]]] [data + ["." maybe] ["." product] ["." name] [number - ["n" nat]] + ["n" nat] + ["f" frac]] ["." text ["%" format (#+ format)]] [collection @@ -162,17 +164,48 @@ (-> Duration Counters Text) (let [successes (get@ #successes counters) failures (get@ #failures counters) - missing-coverage (set.difference (get@ #actual-coverage counters) - (get@ #expected-coverage counters)) - unexpected-coverage (set.difference (get@ #expected-coverage counters) - (get@ #actual-coverage counters))] + missing (set.difference (get@ #actual-coverage counters) + (get@ #expected-coverage counters)) + unexpected (set.difference (get@ #expected-coverage counters) + (get@ #actual-coverage counters)) + report (: (-> (Set Name) Text) + (|>> set.to-list + (list.sort (:: name.order <)) + (exception.enumerate %.name))) + expected-definitions-to-cover (set.size (get@ #expected-coverage counters)) + actual-definitions-covered (set.size (get@ #actual-coverage counters)) + coverage (case expected-definitions-to-cover + 0 "N/A" + expected (let [missing-ratio (f./ (n.frac expected) + (n.frac (set.size missing))) + max-percent +100.0 + done-percent (|> +1.0 + (f.- missing-ratio) + (f.* max-percent))] + (if (f.= max-percent done-percent) + "100%" + (let [raw (|> done-percent + %.frac + (text.replace-once "+" ""))] + (|> raw + (text.clip 0 (if (f.>= +10.0 done-percent) + 5 ## XX.XX + 4 ## X.XX + )) + (maybe.default raw) + (text.suffix "%"))))))] (exception.report ["Duration" (%.duration duration)] - ["Tests" (%.nat (n.+ successes failures))] - ["Successes" (%.nat successes)] - ["Failures" (%.nat failures)] - ["Missing Coverage" (|> missing-coverage set.to-list (exception.enumerate %.name))] - ["Unexpected Coverage" (|> unexpected-coverage set.to-list (exception.enumerate %.name))]))) + ["# Tests" (%.nat (n.+ successes failures))] + ["# Successes" (%.nat successes)] + ["# Failures" (%.nat failures)] + ["# Expected definitions to cover" (%.nat expected-definitions-to-cover)] + ["# Actual definitions covered" (%.nat actual-definitions-covered)] + ["# Pending definitions to cover" (%.nat (n.- actual-definitions-covered + expected-definitions-to-cover))] + ["Coverage" coverage] + ["Missing definitions to cover" (report missing)] + ["Unexpected definitions covered" (report unexpected)]))) (def: failure-exit-code -1) (def: success-exit-code +0) @@ -193,8 +226,8 @@ 0 ..success-exit-code _ ..failure-exit-code))))) -(def: (cover' coverage condition) - (-> (List Name) Bit Test) +(def: (claim' coverage condition) + (-> (List Name) Bit Assertion) (let [message (|> coverage (list@map %.name) (text.join-with " & ")) @@ -202,8 +235,12 @@ (|> (..assert message condition) (promise@map (function (_ [counters documentation]) [(update@ #actual-coverage (set.union coverage) counters) - documentation])) - (:: random.monad wrap)))) + documentation]))))) + +(def: (cover' coverage condition) + (-> (List Name) Bit Test) + (|> (claim' coverage condition) + (:: random.monad wrap))) (def: (with-cover' coverage test) (-> (List Name) Test Test) @@ -226,15 +263,20 @@ [_ (macro.find-export name)] (wrap (list (name-code name))))) -(syntax: #export (cover {coverage (<c>.tuple (<>.many <c>.any))} - condition) - (let [coverage (list@map (function (_ definition) - (` ((~! ..reference) (~ definition)))) - coverage)] - (wrap (list (` ((~! ..cover') - (: (.List .Name) - (.list (~+ coverage))) - (~ condition))))))) +(template [<macro> <function>] + [(syntax: #export (<macro> {coverage (<c>.tuple (<>.many <c>.any))} + condition) + (let [coverage (list@map (function (_ definition) + (` ((~! ..reference) (~ definition)))) + coverage)] + (wrap (list (` ((~! <function>) + (: (.List .Name) + (.list (~+ coverage))) + (~ condition)))))))] + + [claim ..claim'] + [cover ..cover'] + ) (syntax: #export (with-cover {coverage (<c>.tuple (<>.many <c>.any))} test) |