diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/library/lux/test/unit.lux | 223 |
1 files changed, 223 insertions, 0 deletions
diff --git a/stdlib/source/library/lux/test/unit.lux b/stdlib/source/library/lux/test/unit.lux new file mode 100644 index 000000000..0077c18a9 --- /dev/null +++ b/stdlib/source/library/lux/test/unit.lux @@ -0,0 +1,223 @@ +(.require + [library + [lux (.except and for) + [abstract + [monad (.only do)]] + [control + ["<>" parser] + ["[0]" io] + [concurrency + ["[0]" async (.only Async) (.use "[1]#[0]" monad)]]] + [data + ["[0]" text (.only) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor mix)] + ["[0]" set (.only Set)]]] + [math + [number (.only hex) + ["n" nat]]] + ["[0]" meta (.only) + ["[0]" symbol] + ["[0]" code (.only) + ["<[1]>" \\parser]] + [macro + [syntax (.only syntax)]]]]]) + +(type .public Coverage + (Set Symbol)) + +(type .public Tally + (Record + [#successes Nat + #failures Nat + #expected Coverage + #actual Coverage])) + +(def .public (total parameter subject) + (-> Tally Tally Tally) + [#successes (n.+ (the #successes parameter) (the #successes subject)) + #failures (n.+ (the #failures parameter) (the #failures subject)) + #expected (set.union (the #expected parameter) + (the #expected subject)) + #actual (set.union (the #actual parameter) + (the #actual subject))]) + +(def .public start + Tally + [#successes 0 + #failures 0 + #expected (set.empty symbol.hash) + #actual (set.empty symbol.hash)]) + +(with_template [<name> <category>] + [(def <name> + Tally + (revised <category> .++ ..start))] + + [success_tally #successes] + [failure_tally #failures] + ) + +(type .public Test + (Async [Tally Text])) + +(def separator + text.new_line) + +(def .public (and left right) + (-> Test Test Test) + (let [[read! write!] (is [(Async [Tally Text]) + (async.Resolver [Tally Text])] + (async.async [])) + _ (|> left + (async.upon! (function (_ [l_tally l_documentation]) + (async.upon! (function (_ [r_tally r_documentation]) + (write! [(..total l_tally r_tally) + (format l_documentation ..separator r_documentation)])) + right))) + io.run!)] + read!)) + +(def (context' description) + (-> Text Test Test) + (async#each (function (_ [tally documentation]) + [tally (|> documentation + (text.all_split_by ..separator) + (list#each (|>> (format text.tab))) + (text.interposed ..separator) + (format description ..separator))]))) + +(def .public context + (-> Text Test Test) + (|>> %.text context')) + +(def failure_prefix "[Failure] ") +(def success_prefix "[Success] ") + +(def .public failure + (-> Text Test) + (|>> (format ..failure_prefix) + [..failure_tally] + async#in)) + +(def .public success + (-> Text Test) + (|>> (format ..success_prefix) + [..success_tally] + async#in)) + +(def .public (test message condition) + (-> Text Bit Test) + (if condition + (success message) + (failure message))) + +(def definition_separator " & ") + +(def clean_up_marker (text.of_char (hex "05"))) + +(def coverage_format + (%.Format Symbol) + (|>> %.symbol (format ..clean_up_marker))) + +(def .public reference + (let [symbol (is (-> Symbol Code) + (function (_ symbol) + (` (is Symbol + [(, (code.text (symbol.module symbol))) + (, (code.text (symbol.short symbol)))]))))] + (syntax (_ [name <code>.symbol]) + (do meta.monad + [_ (meta.export name)] + (in (list (symbol name))))))) + +(def coverage_separator + Text + (text.of_char 31)) + +(def encoded_coverage + (-> (List Text) Text) + (list#mix (function (_ short aggregate) + (case aggregate + "" short + _ (format aggregate ..coverage_separator short))) + "")) + +(def (coverage_definitions module encoding) + (-> Text Text Coverage) + (loop (again [remaining encoding + output (set.of_list symbol.hash (list))]) + (case (text.split_by ..coverage_separator remaining) + {.#Some [head tail]} + (again tail (set.has [module head] output)) + + {.#None} + (set.has [module remaining] output)))) + +(def .public (with_coverage coverage condition) + (-> (List Symbol) Bit Test) + (let [message (|> coverage + (list#each ..coverage_format) + (text.interposed ..definition_separator)) + coverage (set.of_list symbol.hash coverage)] + (|> (..test message condition) + (async#each (function (_ [tally documentation]) + [(revised #actual (set.union coverage) tally) + documentation]))))) + +(def .public coverage + (syntax (_ [coverage (<code>.tuple (<>.many <code>.any)) + condition <code>.any]) + (let [coverage (list#each (function (_ definition) + (` (..reference (, definition)))) + coverage)] + (in (list (` (..with_coverage (is (.List .Symbol) + (.list (,* coverage))) + (, condition)))))))) + +(def .public (for' coverage test) + (-> (List Symbol) Test Test) + (let [context (|> coverage + (list#each ..coverage_format) + (text.interposed ..definition_separator)) + coverage (set.of_list symbol.hash coverage)] + (async#each (function (_ [tally documentation]) + [(revised #actual (set.union coverage) tally) + documentation]) + (..context' context test)))) + +(def .public for + (syntax (_ [coverage (<code>.tuple (<>.many <code>.any)) + test <code>.any]) + (let [coverage (list#each (function (_ definition) + (` (..reference (, definition)))) + coverage)] + (in (list (` (..for' (is (.List .Symbol) + (.list (,* coverage))) + (, test)))))))) + +(def .public (covering' module coverage test) + (-> Text Text Test Test) + (let [coverage (..coverage_definitions module coverage)] + (|> (..context' module test) + (async#each (function (_ [tally documentation]) + [(revised #expected (set.union coverage) tally) + (|> documentation + (text.replaced (format ..clean_up_marker module symbol.separator) "") + (text.replaced ..clean_up_marker ""))]))))) + +(def .public covering + (syntax (_ [module <code>.symbol + test <code>.any]) + (do meta.monad + [.let [module (symbol.module module)] + definitions (meta.definitions module) + .let [coverage (|> definitions + (list#mix (function (_ [short [exported? _]] aggregate) + (if exported? + {.#Item short aggregate} + aggregate)) + {.#End}) + ..encoded_coverage)]] + (in (list (` (..covering' (, (code.text module)) (, (code.text coverage)) (, test)))))))) |