From 68d78235694c633c956bb9e8a007cad7d65370bc Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 10 Aug 2022 19:38:43 -0400 Subject: Extracted property-based testing machinery into its own module. --- stdlib/source/library/lux/test.lux | 284 ---------------------------- stdlib/source/library/lux/test/property.lux | 284 ++++++++++++++++++++++++++++ 2 files changed, 284 insertions(+), 284 deletions(-) delete mode 100644 stdlib/source/library/lux/test.lux create mode 100644 stdlib/source/library/lux/test/property.lux (limited to 'stdlib/source/library') diff --git a/stdlib/source/library/lux/test.lux b/stdlib/source/library/lux/test.lux deleted file mode 100644 index 16df02a68..000000000 --- a/stdlib/source/library/lux/test.lux +++ /dev/null @@ -1,284 +0,0 @@ -(.require - [library - [lux (.except and for) - ["[0]" debug] - [abstract - [monad (.only do)]] - [control - ["[0]" pipe] - ["[0]" maybe] - ["[0]" try] - ["[0]" exception (.only exception)] - ["[0]" io] - [concurrency - ["[0]" atom (.only Atom)] - ["[0]" async (.only Async) (.use "[1]#[0]" monad)]]] - [data - ["[0]" product] - ["[0]" text (.only) - ["%" \\format (.only format)]] - [collection - ["[0]" list (.use "[1]#[0]" functor mix)] - ["[0]" set] - ["[0]" dictionary - ["[1]" ordered (.only Dictionary)]]]] - [math - ["[0]" random (.only Random) (.use "[1]#[0]" monad)] - [number (.only hex) - ["n" nat] - ["f" frac]]] - [meta - ["@" target] - ["[0]" symbol] - ["[0]" code - ["<[1]>" \\parser]] - [macro - [syntax (.only syntax)]]] - [world - ["[0]" environment] - ["[0]" console] - [time - [duration (.only Duration)] - ["[0]" instant]]]]] - [/ - ["//" unit] - ["[0]" coverage (.only Coverage)] - ["[0]" tally (.only Tally)]]) - -(type .public Test - (Random //.Test)) - -(def .public (and left right) - (-> Test Test Test) - (do [! random.monad] - [left left] - (at ! each (//.and left) right))) - -(def .public context - (-> Text Test Test) - (|>> %.text - //.context - random#each)) - -(def .public failure - (-> Text Test) - (|>> //.failure - random#in)) - -(def .public success - (-> Text Test) - (|>> //.success - random#in)) - -(def .public (test message condition) - (-> Text Bit Test) - (random#in (//.test message condition))) - -(def .public (lifted message random) - (-> Text (Random Bit) Test) - (do random.monad - [it random] - (test message it))) - -(def pcg_32_magic_inc - Nat - (hex "FEDCBA9876543210")) - -(type .public Seed - Nat) - -(def .public (seed value test) - (-> Seed Test Test) - (function (_ prng) - (let [[_ result] (random.result (random.pcg_32 [..pcg_32_magic_inc value]) - test)] - [prng result]))) - -(def failed? - (-> Tally Bit) - (|>> (the tally.#failures) (n.> 0))) - -(def separator - text.new_line) - -(def (times_failure seed documentation) - (-> Seed Text Text) - (format documentation ..separator ..separator - "Failed with this seed: " (%.nat seed))) - -(exception .public must_try_test_at_least_once) - -(def .public (times amount test) - (-> Nat Test Test) - (case amount - 0 (..failure (exception.error ..must_try_test_at_least_once [])) - _ (do random.monad - [seed random.nat] - (function (again prng) - (let [[prng' instance] (random.result (random.pcg_32 [..pcg_32_magic_inc seed]) test)] - [prng' (do [! async.monad] - [[tally documentation] instance] - (if (..failed? tally) - (in [tally (times_failure seed documentation)]) - (case amount - 1 instance - _ (|> test - (times (-- amount)) - (random.result prng') - product.right))))]))))) - -(def (description duration tally) - (-> Duration Tally Text) - (let [successes (the tally.#successes tally) - failures (the tally.#failures tally) - missing (set.difference (the tally.#actual tally) - (the tally.#expected tally)) - unexpected (set.difference (the tally.#expected tally) - (the tally.#actual tally)) - report (is (-> Coverage Text) - (|>> set.list - (list.sorted (at symbol.order <)) - (exception.listing %.symbol))) - expected_coverage (set.size (the tally.#expected tally)) - unexpected_coverage (set.size unexpected) - actual_coverage (n.- unexpected_coverage - (set.size (the tally.#actual tally))) - coverage (case expected_coverage - 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.replaced_once "+" ""))] - (|> raw - (text.clip 0 (if (f.< +10.0 done_percent) - 4 ... X.XX - 5 ... XX.XX - )) - (maybe.else raw) - (text.suffix "%"))))))] - (exception.report - (list ["Duration" (%.duration duration)] - - ["Tests" (%.nat (n.+ successes failures))] - ["Successes" (%.nat successes)] - ["Failures" (%.nat failures)] - - ["Expected coverage" (%.nat expected_coverage)] - ["Actual coverage" (%.nat actual_coverage)] - ["Pending coverage" (%.nat (n.- actual_coverage - expected_coverage))] - ["Unexpected coverage" (%.nat unexpected_coverage)] - - ["Coverage" coverage] - ["Pending" (report missing)] - ["Unexpected" (report unexpected)])))) - -(def failure_exit_code +1) -(def success_exit_code +0) - -(def .public (run! test) - (-> Test (Async Nothing)) - (do async.monad - [pre (async.future instant.now) - .let [seed (instant.millis pre) - prng (random.pcg_32 [..pcg_32_magic_inc seed])] - [tally documentation] (|> test (random.result prng) product.right) - post (async.future instant.now) - .let [duration (instant.span pre post) - report (format documentation - text.new_line text.new_line - (..description duration tally) - text.new_line)] - _ (with_expansions [ (in {try.#Success (debug.log! report)})] - (.for @.js (case console.default - {.#None} - - - {.#Some console} - (console.write_line report console)) - ))] - (async.future (at environment.default exit - (case (the tally.#failures tally) - 0 ..success_exit_code - _ ..failure_exit_code))))) - -(def .public coverage - (syntax (_ [coverage .any - condition .any]) - (in (list (` (at random.monad (,' in) (//.coverage (, coverage) (, condition)))))))) - -(def .public for - (syntax (_ [coverage .any - test .any]) - (in (list (` (at random.functor - (,' each) - (|>> (//.for (, coverage))) - (, test))))))) - -(def .public covering - (syntax (_ [module .any - test .any]) - (in (list (` (at random.functor - (,' each) - (|>> (//.covering (, module))) - (, test))))))) - -(exception .public (error_during_execution [error Text]) - (exception.report - (list ["Error" (%.text error)]))) - -(def .public (in_parallel tests) - (-> (List Test) Test) - (case (list.size tests) - 0 - (random#in (async#in [tally.empty ""])) - - expected_tests - (do random.monad - [seed random.nat - .let [prng (random.pcg_32 [..pcg_32_magic_inc seed]) - run! (is (-> Test //.Test) - (|>> (random.result prng) - product.right - (function (_ _)) - "lux try" - (pipe.case - {try.#Success output} - output - - {try.#Failure error} - (//.test (exception.error ..error_during_execution [error]) false)))) - state (is (Atom (Dictionary Nat [Tally Text])) - (atom.atom (dictionary.empty n.order))) - [read! write!] (is [//.Test - (async.Resolver [Tally Text])] - (async.async [])) - _ (list#mix (function (_ test index) - (exec - (|> (run! test) - (async.upon! (function (_ assertion) - (do io.monad - [[_ results] (atom.update! (dictionary.has index assertion) state)] - (if (n.= expected_tests (dictionary.size results)) - (let [assertions (|> results - dictionary.entries - (list#each product.right))] - (write! [(|> assertions - (list#each product.left) - (list#mix tally.and tally.empty)) - (|> assertions - (list#each product.right) - (text.interposed ..separator))])) - (in []))))) - io.run!) - (++ index))) - 0 - tests)]] - (in read!)))) diff --git a/stdlib/source/library/lux/test/property.lux b/stdlib/source/library/lux/test/property.lux new file mode 100644 index 000000000..ff61d64d5 --- /dev/null +++ b/stdlib/source/library/lux/test/property.lux @@ -0,0 +1,284 @@ +(.require + [library + [lux (.except and for) + ["[0]" debug] + [abstract + [monad (.only do)]] + [control + ["[0]" pipe] + ["[0]" maybe] + ["[0]" try] + ["[0]" exception (.only exception)] + ["[0]" io] + [concurrency + ["[0]" atom (.only Atom)] + ["[0]" async (.only Async) (.use "[1]#[0]" monad)]]] + [data + ["[0]" product] + ["[0]" text (.only) + ["%" \\format (.only format)]] + [collection + ["[0]" list (.use "[1]#[0]" functor mix)] + ["[0]" set] + ["[0]" dictionary + ["[1]" ordered (.only Dictionary)]]]] + [math + ["[0]" random (.only Random) (.use "[1]#[0]" monad)] + [number (.only hex) + ["n" nat] + ["f" frac]]] + [meta + ["@" target] + ["[0]" symbol] + ["[0]" code + ["<[1]>" \\parser]] + [macro + [syntax (.only syntax)]]] + [world + ["[0]" environment] + ["[0]" console] + [time + [duration (.only Duration)] + ["[0]" instant]]]]] + [// + ["//" unit] + ["[0]" coverage (.only Coverage)] + ["[0]" tally (.only Tally)]]) + +(type .public Test + (Random //.Test)) + +(def .public (and left right) + (-> Test Test Test) + (do [! random.monad] + [left left] + (at ! each (//.and left) right))) + +(def .public context + (-> Text Test Test) + (|>> %.text + //.context + random#each)) + +(def .public failure + (-> Text Test) + (|>> //.failure + random#in)) + +(def .public success + (-> Text Test) + (|>> //.success + random#in)) + +(def .public (test message condition) + (-> Text Bit Test) + (random#in (//.test message condition))) + +(def .public (lifted message random) + (-> Text (Random Bit) Test) + (do random.monad + [it random] + (test message it))) + +(def pcg_32_magic_inc + Nat + (hex "FEDCBA9876543210")) + +(type .public Seed + Nat) + +(def .public (seed value test) + (-> Seed Test Test) + (function (_ prng) + (let [[_ result] (random.result (random.pcg_32 [..pcg_32_magic_inc value]) + test)] + [prng result]))) + +(def failed? + (-> Tally Bit) + (|>> (the tally.#failures) (n.> 0))) + +(def separator + text.new_line) + +(def (times_failure seed documentation) + (-> Seed Text Text) + (format documentation ..separator ..separator + "Failed with this seed: " (%.nat seed))) + +(exception .public must_try_test_at_least_once) + +(def .public (times amount test) + (-> Nat Test Test) + (case amount + 0 (..failure (exception.error ..must_try_test_at_least_once [])) + _ (do random.monad + [seed random.nat] + (function (again prng) + (let [[prng' instance] (random.result (random.pcg_32 [..pcg_32_magic_inc seed]) test)] + [prng' (do [! async.monad] + [[tally documentation] instance] + (if (..failed? tally) + (in [tally (times_failure seed documentation)]) + (case amount + 1 instance + _ (|> test + (times (-- amount)) + (random.result prng') + product.right))))]))))) + +(def (description duration tally) + (-> Duration Tally Text) + (let [successes (the tally.#successes tally) + failures (the tally.#failures tally) + missing (set.difference (the tally.#actual tally) + (the tally.#expected tally)) + unexpected (set.difference (the tally.#expected tally) + (the tally.#actual tally)) + report (is (-> Coverage Text) + (|>> set.list + (list.sorted (at symbol.order <)) + (exception.listing %.symbol))) + expected_coverage (set.size (the tally.#expected tally)) + unexpected_coverage (set.size unexpected) + actual_coverage (n.- unexpected_coverage + (set.size (the tally.#actual tally))) + coverage (case expected_coverage + 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.replaced_once "+" ""))] + (|> raw + (text.clip 0 (if (f.< +10.0 done_percent) + 4 ... X.XX + 5 ... XX.XX + )) + (maybe.else raw) + (text.suffix "%"))))))] + (exception.report + (list ["Duration" (%.duration duration)] + + ["Tests" (%.nat (n.+ successes failures))] + ["Successes" (%.nat successes)] + ["Failures" (%.nat failures)] + + ["Expected coverage" (%.nat expected_coverage)] + ["Actual coverage" (%.nat actual_coverage)] + ["Pending coverage" (%.nat (n.- actual_coverage + expected_coverage))] + ["Unexpected coverage" (%.nat unexpected_coverage)] + + ["Coverage" coverage] + ["Pending" (report missing)] + ["Unexpected" (report unexpected)])))) + +(def failure_exit_code +1) +(def success_exit_code +0) + +(def .public (run! test) + (-> Test (Async Nothing)) + (do async.monad + [pre (async.future instant.now) + .let [seed (instant.millis pre) + prng (random.pcg_32 [..pcg_32_magic_inc seed])] + [tally documentation] (|> test (random.result prng) product.right) + post (async.future instant.now) + .let [duration (instant.span pre post) + report (format documentation + text.new_line text.new_line + (..description duration tally) + text.new_line)] + _ (with_expansions [ (in {try.#Success (debug.log! report)})] + (.for @.js (case console.default + {.#None} + + + {.#Some console} + (console.write_line report console)) + ))] + (async.future (at environment.default exit + (case (the tally.#failures tally) + 0 ..success_exit_code + _ ..failure_exit_code))))) + +(def .public coverage + (syntax (_ [coverage .any + condition .any]) + (in (list (` (at random.monad (,' in) (//.coverage (, coverage) (, condition)))))))) + +(def .public for + (syntax (_ [coverage .any + test .any]) + (in (list (` (at random.functor + (,' each) + (|>> (//.for (, coverage))) + (, test))))))) + +(def .public covering + (syntax (_ [module .any + test .any]) + (in (list (` (at random.functor + (,' each) + (|>> (//.covering (, module))) + (, test))))))) + +(exception .public (error_during_execution [error Text]) + (exception.report + (list ["Error" (%.text error)]))) + +(def .public (in_parallel tests) + (-> (List Test) Test) + (case (list.size tests) + 0 + (random#in (async#in [tally.empty ""])) + + expected_tests + (do random.monad + [seed random.nat + .let [prng (random.pcg_32 [..pcg_32_magic_inc seed]) + run! (is (-> Test //.Test) + (|>> (random.result prng) + product.right + (function (_ _)) + "lux try" + (pipe.case + {try.#Success output} + output + + {try.#Failure error} + (//.test (exception.error ..error_during_execution [error]) false)))) + state (is (Atom (Dictionary Nat [Tally Text])) + (atom.atom (dictionary.empty n.order))) + [read! write!] (is [//.Test + (async.Resolver [Tally Text])] + (async.async [])) + _ (list#mix (function (_ test index) + (exec + (|> (run! test) + (async.upon! (function (_ assertion) + (do io.monad + [[_ results] (atom.update! (dictionary.has index assertion) state)] + (if (n.= expected_tests (dictionary.size results)) + (let [assertions (|> results + dictionary.entries + (list#each product.right))] + (write! [(|> assertions + (list#each product.left) + (list#mix tally.and tally.empty)) + (|> assertions + (list#each product.right) + (text.interposed ..separator))])) + (in []))))) + io.run!) + (++ index))) + 0 + tests)]] + (in read!)))) -- cgit v1.2.3