diff options
| -rw-r--r-- | documentation/bookmark/paradigm/cop__context_oriented_programming.md | 7 | ||||
| -rw-r--r-- | stdlib/source/library/lux.lux | 9 | ||||
| -rw-r--r-- | stdlib/source/library/lux/control/function/polymorphism/context.lux | 203 | ||||
| -rw-r--r-- | stdlib/source/library/lux/control/function/predicate.lux | 10 | ||||
| -rw-r--r-- | stdlib/source/library/lux/test/unit.lux | 26 | ||||
| -rw-r--r-- | stdlib/source/test/lux.lux | 6 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/function.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/function/polymorphism/context.lux | 117 | ||||
| -rw-r--r-- | stdlib/source/test/lux/program.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/lux/test.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/lux/test/property.lux | 58 | ||||
| -rw-r--r-- | stdlib/source/test/lux/test/unit.lux | 126 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world/time/day.lux | 91 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world/time/month.lux | 136 |
14 files changed, 630 insertions, 167 deletions
diff --git a/documentation/bookmark/paradigm/cop__context_oriented_programming.md b/documentation/bookmark/paradigm/cop__context_oriented_programming.md new file mode 100644 index 000000000..72d3dc098 --- /dev/null +++ b/documentation/bookmark/paradigm/cop__context_oriented_programming.md @@ -0,0 +1,7 @@ +# Reference + +0. []() +0. [A Context-Oriented Extension of F#](https://arxiv.org/abs/1512.07681) +0. [Context-oriented Programming (COP)](http://www.swa.hpi.uni-potsdam.de/cop/) +0. [Context-oriented Programming](https://www.jot.fm/issues/issue_2008_03/article4/) + diff --git a/stdlib/source/library/lux.lux b/stdlib/source/library/lux.lux index d5c43cc7f..8a829ae10 100644 --- a/stdlib/source/library/lux.lux +++ b/stdlib/source/library/lux.lux @@ -3769,7 +3769,7 @@ {#None} (failure (..wrong_syntax_error (symbol ..def)))))) -(with_template [<name> <form> <message>] +(with_template [<name> <nullary> <form>] [(def .public <name> (macro (_ tokens) (when (list#reversed tokens) @@ -3780,10 +3780,11 @@ init))) _ - (failure <message>))))] + (meta#in (list (` <nullary>))))))] - [and (if (, pre) (, post) #0) "'and' requires >=1 clauses."] - [or (if (, pre) #1 (, post)) "'or' requires >=1 clauses."]) + [and #1 (if (, pre) (, post) #0)] + [or #0 (if (, pre) #1 (, post))] + ) (def (index part text) (-> Text Text (Maybe Nat)) diff --git a/stdlib/source/library/lux/control/function/polymorphism/context.lux b/stdlib/source/library/lux/control/function/polymorphism/context.lux new file mode 100644 index 000000000..ee47ece31 --- /dev/null +++ b/stdlib/source/library/lux/control/function/polymorphism/context.lux @@ -0,0 +1,203 @@ +(.require + [library + [lux (.except def with) + [abstract + [monad (.only do)] + ["[0]" hash]] + [control + [reader (.only Reader)] + ["?" parser (.use "[1]#[0]" monad)] + [function + ["[0]" predicate (.only Predicate)]]] + [data + ["[0]" product] + ["[0]" text (.use "[1]#[0]" equivalence)] + [collection + ["[0]" set (.only Set)] + ["[0]" list (.use "[1]#[0]" functor)]]] + ["[0]" meta (.only) + ["[0]" symbol] + ["[0]" static] + ["[0]" code (.only) + ["?[1]" \\parser (.only Parser)]] + ["[0]" macro (.only with_symbols) + ["[0]" context] + [syntax (.only syntax) + ["[0]" export]]] + [type + [primitive (.except #name)]]]]] + [/// + ["//" mixin]]) + +(.def .public (altered alteration scope) + (All (_ context value) + (-> (-> context context) (Reader context value) + (Reader context value))) + (function (_ context) + (scope (alteration context)))) + +(with_expansions [<representation> Symbol] + (primitive .public Layer + <representation> + + (.def .public layer + (syntax (_ [[export_policy name] (export.parser ?code.local)]) + (do meta.monad + [@ meta.current_module_name] + (in (list (` (.def (, export_policy) (, (code.local name)) + Layer + (<| (as Layer) + (is <representation>) + [(, (code.text @)) + (, (code.text name))])))))))) + + (type .public Context + (Set Layer)) + + (.def .public empty + Context + (set.empty (at hash.functor each (|>> representation) symbol.hash))) + )) + +(with_template [<name> <change>] + [(.def .public (<name> layer scope) + (All (_ value) + (-> Layer (Reader Context value) + (Reader Context value))) + (function (_ context) + (scope (<change> layer context))))] + + [with set.has] + [without set.lacks] + ) + +(.def .public (active? layer) + (All (_ value) + (-> Layer (Predicate Context))) + (function (_ context) + (set.member? context layer))) + +(.def .public inactive? + (All (_ value) + (-> Layer (Predicate Context))) + (|>> active? predicate.complement)) + +(type Polymorphism + (Record + [#function Text + #quantifications (List Code) + #context Code + #inputs (List Code) + #output Code + #default Code + #export_policy Code + #scenarios (List Code)])) + +(context.def [stack expression declaration] Polymorphism) + +(type Signature + (Record + [#name Text + #next Text + #parameters (List Code)])) + +(.def signature + (Parser Signature) + (?code.form + (all ?.and + ?code.local + ?code.local + (?.many ?code.any)))) + +(.def (quoted it) + (-> Code Code) + (` ((,' .,') (, it)))) + +(.def .public def + (syntax (_ [[export_policy signature] (export.parser ..signature) + quantifications (?code.tuple (?.some ?code.any)) + context ?code.any + inputs (?code.tuple (?.many ?code.any)) + output ?code.any + default ?code.any + methods (?.some ?code.any)]) + (<| (with_symbols [g!self g!_ g!scenarios g!scenario g!mixin]) + (..declaration [#function (the #name signature) + #quantifications quantifications + #context context + #inputs inputs + #output output + #default default + #export_policy export_policy + #scenarios (list)]) + (let [name (quoted (code.local (the #name signature))) + next (quoted (code.local (the #next signature))) + parameters (list#each quoted (the #parameters signature)) + [@ _] (symbol .._) + + g!self (quoted g!self)]) + (` (these (,* methods) + + (static.expansion + (do meta.monad + [[(, g!_) (, g!_) (, g!_) (, g!_) (, g!_) (, g!_) (, g!_) (, g!scenarios)] + (context.search' (|>> product.left + (at text.equivalence (,' =) (, (code.text (the #name signature))))) + [("lux in-module" (, (code.text @)) ..stack) + (symbol ..stack)])] + (at meta.monad (,' in) + (list (` (.def (, export_policy) (, name) + (, (quoted (` (<| (,* quantifications) + (-> (,* inputs) (Reader (, context) (, output))))))) + (let [(, (quoted g!mixin)) (is (, (quoted (` (<| (,* quantifications) + (-> [(,* inputs)] (Reader (, context) (, output))))))) + (//.fixed (all //.mixed + ((,' .,*) (, g!scenarios)) + (is (, (quoted (` (<| (,* quantifications) + (//.Mixin [(,* inputs)] (Reader (, context) (, output))))))) + (function ((, g!self) (, next) (, name) [(,* parameters)]) + (, (quoted default)))) + )))] + (, (when (the #parameters signature) + (list _) + (quoted g!mixin) + + _ + (` (function ((, name) (,* parameters)) + ((, (quoted g!mixin)) [(,* parameters)])))))))))))) + ))))) + +(.def .public method + (syntax (_ [signature ..signature + predicate ?code.any + body ?code.any]) + (do [! meta.monad] + [.let [criterion (is (Predicate Polymorphism) + (|>> (the #function) + (text#= (the #name signature))))] + it (context.search criterion ..stack)] + (with_symbols [g!self g!predicate g!parameters g!context g!_ g!next g!again] + (do ! + [_ (context.revised {.#Some criterion} + (revised #scenarios (|>> {.#Item (` (let [(, g!predicate) (is (<| (,* (the #quantifications it)) + (Predicate (, (the #context it)))) + (, predicate))] + (is (<| (,* (the #quantifications it)) + (//.Mixin [(,* (the #inputs it))] + (Reader (, (the #context it)) + (, (the #output it))))) + (function ((, g!_) (, g!next) (, g!again) (, g!parameters) (, g!context)) + (if ((, g!predicate) (, g!context)) + ((, g!self) (, g!next) (, g!again) (, g!parameters) (, g!context)) + ((, g!next) (, g!parameters) (, g!context)))))))})) + ..stack)] + (in (list (` (.def (, (the #export_policy it)) (, g!self) + (<| (,* (the #quantifications it)) + (//.Mixin [(,* (the #inputs it))] + (Reader (, (the #context it)) + (, (the #output it))))) + (function ((, g!self) + (, (code.local (the #next signature))) + (, (code.local (the #name signature))) + [(,* (the #parameters signature))]) + (, body))))))))))) diff --git a/stdlib/source/library/lux/control/function/predicate.lux b/stdlib/source/library/lux/control/function/predicate.lux index 131a6520f..80703dbb6 100644 --- a/stdlib/source/library/lux/control/function/predicate.lux +++ b/stdlib/source/library/lux/control/function/predicate.lux @@ -1,6 +1,6 @@ (.require [library - [lux (.except all or and) + [lux (.except all or and not) [abstract [monoid (.only Monoid)] [functor @@ -38,13 +38,17 @@ (def .public (complement predicate) (All (_ a) (-> (Predicate a) (Predicate a))) - (|>> predicate not)) + (|>> predicate .not)) + +(def .public not + (All (_ a) (-> (Predicate a) (Predicate a))) + ..complement) (def .public (difference sub base) (All (_ a) (-> (Predicate a) (Predicate a) (Predicate a))) (function (_ value) (.and (base value) - (not (sub value))))) + (.not (sub value))))) (def .public (rec predicate) (All (_ a) diff --git a/stdlib/source/library/lux/test/unit.lux b/stdlib/source/library/lux/test/unit.lux index 62e075537..14b09f014 100644 --- a/stdlib/source/library/lux/test/unit.lux +++ b/stdlib/source/library/lux/test/unit.lux @@ -1,6 +1,7 @@ (.require [library [lux (.except and for) + ["[0]" debug] [abstract [monad (.only do)]] [control @@ -92,7 +93,7 @@ (%.Format Symbol) (|>> %.symbol (format ..clean_up_marker))) -(def .public (with_coverage coverage condition) +(def (with_coverage coverage condition) (-> (List Symbol) Bit Test) (let [message (|> coverage (list#each ..coverage_format) @@ -109,11 +110,12 @@ (let [coverage (list#each (function (_ definition) (` (coverage.of (, definition)))) coverage)] - (in (list (` (..with_coverage (is (.List .Symbol) - (.list (,* coverage))) - (, condition)))))))) + (in (list (` ((debug.private ..with_coverage) + (is (.List .Symbol) + (.list (,* coverage))) + (, condition)))))))) -(def .public (for' coverage test) +(def (for' coverage test) (-> (List Symbol) Test Test) (let [context (|> coverage (list#each ..coverage_format) @@ -130,11 +132,12 @@ (let [coverage (list#each (function (_ definition) (` (coverage.of (, definition)))) coverage)] - (in (list (` (..for' (is (.List .Symbol) - (.list (,* coverage))) - (, test)))))))) + (in (list (` ((debug.private ..for') + (is (.List .Symbol) + (.list (,* coverage))) + (, test)))))))) -(def .public (covering' module coverage test) +(def (covering' module coverage test) (-> Text Text Test Test) (let [coverage (coverage.decoded module coverage)] (|> (..context' module test) @@ -157,4 +160,7 @@ aggregate)) {.#End}) coverage.encoded)]] - (in (list (` (..covering' (, (code.text module)) (, (code.text coverage)) (, test)))))))) + (in (list (` ((debug.private ..covering') + (, (code.text module)) + (, (code.text coverage)) + (, test)))))))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index e4dbc056b..67a23e73b 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -77,12 +77,14 @@ expected dummy))) (_.coverage [/.or] - (and (not (/.or /.false /.false)) + (and (not (/.or)) + (not (/.or /.false /.false)) (/.or /.false /.true) (/.or /.true /.false) (/.or /.true /.true))) (_.coverage [/.and] - (and (not (/.and /.false /.false)) + (and (/.and) + (not (/.and /.false /.false)) (not (/.and /.false /.true)) (not (/.and /.true /.false)) (/.and /.true /.true))) diff --git a/stdlib/source/test/lux/control/function.lux b/stdlib/source/test/lux/control/function.lux index f4333d520..fe8c69b07 100644 --- a/stdlib/source/test/lux/control/function.lux +++ b/stdlib/source/test/lux/control/function.lux @@ -26,7 +26,8 @@ ["[1][0]" trampoline] ["[1][0]" polymorphism ["[1]/[0]" type] - ["[1]/[0]" predicate]]]) + ["[1]/[0]" predicate] + ["[1]/[0]" context]]]) (def .public test Test @@ -78,4 +79,5 @@ /trampoline.test /polymorphism/type.test /polymorphism/predicate.test + /polymorphism/context.test )))) diff --git a/stdlib/source/test/lux/control/function/polymorphism/context.lux b/stdlib/source/test/lux/control/function/polymorphism/context.lux new file mode 100644 index 000000000..6b12a0360 --- /dev/null +++ b/stdlib/source/test/lux/control/function/polymorphism/context.lux @@ -0,0 +1,117 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["context" reader (.use "[1]#[0]" monad)]] + [data + [collection + ["[0]" set]]] + [math + ["[0]" random (.only Random)] + [number + ["i" int]]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" /]]) + +(/.def .public (arbitrary _ negative zero positive) + [(All (_ value))] + Int + [value value value] + value + + (context#in zero) + + (/.method (arbitrary next negative zero positive) + (i.> +0) + (context#in positive)) + + (/.method (arbitrary next negative zero positive) + (i.< +0) + (context#in negative)) + ) + +(/.layer positive) +(/.layer negative) + +(/.def .public (layered _ negative zero positive) + [(All (_ value))] + /.Context + [value value value] + value + + (context#in zero) + + (/.method (layered next negative zero positive) + (/.active? ..positive) + (context#in positive)) + + (/.method (layered next negative zero positive) + (/.active? ..negative) + (context#in negative)) + ) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [negative random.nat + zero random.nat + positive random.nat + choice random.int]) + (all _.and + (_.coverage [/.def /.method] + (|> (arbitrary negative zero positive) + (context.result choice) + (same? (cond (i.> +0 choice) positive + (i.< +0 choice) negative + ... else + zero)))) + (_.coverage [/.altered] + (|> (arbitrary negative zero positive) + (/.altered (i.* -1)) + (context.result choice) + (same? (cond (i.> +0 choice) negative + (i.< +0 choice) positive + ... else + zero)))) + (_.for [/.Context] + (all _.and + (_.coverage [/.empty] + (|> (layered negative zero positive) + (context.result /.empty) + (same? zero))) + (_.coverage [/.with] + (and (|> (layered negative zero positive) + (/.with ..positive) + (context.result /.empty) + (same? positive)) + (|> (layered negative zero positive) + (/.with ..negative) + (context.result /.empty) + (same? negative)))) + (_.coverage [/.without] + (|> (layered negative zero positive) + (/.without ..positive) + (/.with ..positive) + (context.result /.empty) + (same? zero))))) + (_.for [/.Layer /.layer] + (all _.and + (_.coverage [/.active?] + (|> (do context.monad + [it context.read] + (in (/.active? ..positive it))) + (/.with ..positive) + (context.result /.empty))) + (_.coverage [/.inactive?] + (|> (do context.monad + [it context.read] + (in (/.inactive? ..negative it))) + (/.with ..positive) + (context.result /.empty))) + )) + ))) diff --git a/stdlib/source/test/lux/program.lux b/stdlib/source/test/lux/program.lux index a4382595d..dbe034606 100644 --- a/stdlib/source/test/lux/program.lux +++ b/stdlib/source/test/lux/program.lux @@ -98,7 +98,7 @@ (do random.monad [inputs (random.list 5 (random.upper_case 5))] (all _.and - (_.coverage [/.program] + (_.coverage [/.Program /.program] (let [(open "list#[0]") (list.equivalence text.equivalence)] (and (let [outcome ((is /.Program (/.program all_arguments diff --git a/stdlib/source/test/lux/test.lux b/stdlib/source/test/lux/test.lux index 6400db17f..8d9be9f39 100644 --- a/stdlib/source/test/lux/test.lux +++ b/stdlib/source/test/lux/test.lux @@ -6,6 +6,7 @@ ["[0]" / ["[1][0]" coverage] ["[1][0]" tally] + ["[1][0]" unit] ["[1][0]" property]]) (def .public test @@ -13,5 +14,6 @@ (all _.and /coverage.test /tally.test + /unit.test /property.test )) diff --git a/stdlib/source/test/lux/test/property.lux b/stdlib/source/test/lux/test/property.lux index 8a1fa2f0d..e1bc232dd 100644 --- a/stdlib/source/test/lux/test/property.lux +++ b/stdlib/source/test/lux/test/property.lux @@ -32,39 +32,6 @@ (n.= successes (the tally.#successes tally)) (n.= failures (the tally.#failures tally)))) -(def unit_test - /.Test - (do [! random.monad] - [expected_message/0 (random.lower_case 5) - expected_message/1 (random.only (|>> (text#= expected_message/0) not) - (random.lower_case 5))] - (all /.and - (in (do async.monad - [[success_tally success_message] (unit.test expected_message/0 true) - [failure_tally failure_message] (unit.test expected_message/0 false)] - (unit.coverage [unit.test] - (and (text.ends_with? (%.text expected_message/0) success_message) - (text.ends_with? (%.text expected_message/0) failure_message) - (and (n.= 1 (the tally.#successes success_tally)) - (n.= 0 (the tally.#successes failure_tally))) - (and (n.= 0 (the tally.#failures success_tally)) - (n.= 1 (the tally.#failures failure_tally))))))) - (in (do async.monad - [tt (unit.and (unit.test expected_message/0 true) - (unit.test expected_message/1 true)) - ff (unit.and (unit.test expected_message/0 false) - (unit.test expected_message/1 false)) - tf (unit.and (unit.test expected_message/0 true) - (unit.test expected_message/1 false)) - ft (unit.and (unit.test expected_message/0 false) - (unit.test expected_message/1 true))] - (unit.coverage [unit.and] - (and (..verify expected_message/0 expected_message/1 2 0 tt) - (..verify expected_message/0 expected_message/1 0 2 ff) - (..verify expected_message/0 expected_message/1 1 1 tf) - (..verify expected_message/0 expected_message/1 1 1 ft))))) - ))) - (def seed /.Test (do [! random.monad] @@ -197,17 +164,6 @@ (set.member? (the tally.#actual covering) (symbol ..dummy_target)))))))) (do random.monad [not_covering (/.covering .._ (/.test "" true)) - covering (/.covering .._ (in (unit.coverage [..dummy_target] true)))] - (in (do async.monad - [[not_covering _] not_covering - [covering _] covering] - (unit.coverage [unit.coverage] - (and (and (not (set.empty? (the tally.#expected not_covering))) - (not (set.member? (the tally.#actual not_covering) (symbol ..dummy_target)))) - (and (not (set.empty? (the tally.#expected covering))) - (set.member? (the tally.#actual covering) (symbol ..dummy_target)))))))) - (do random.monad - [not_covering (/.covering .._ (/.test "" true)) covering (/.covering .._ (/.for [..dummy_target] (/.test "" true)))] (in (do async.monad [[not_covering _] not_covering @@ -230,8 +186,6 @@ expected_message/1 (random.only (|>> (text#= expected_message/0) not) (random.lower_case 5))] (all /.and - (/.for [unit.Test] - ..unit_test) (/.for [/.Seed] seed) (do ! @@ -282,13 +236,21 @@ (and (n.= 0 (the tally.#successes failure_tally)) (n.= 1 (the tally.#failures failure_tally)))))))) (do ! + [success_unit_test (/.success expected_message/0)] + (in (do async.monad + [[success_tally success_message] success_unit_test] + (unit.coverage [/.success] + (and (text.contains? expected_message/0 success_message) + (n.= 1 (the tally.#successes success_tally)) + (n.= 0 (the tally.#failures success_tally))))))) + (do ! [failure_unit_test (/.failure expected_message/0)] (in (do async.monad [[failure_tally failure_message] failure_unit_test] (unit.coverage [/.failure] (and (text.contains? expected_message/0 failure_message) - (and (n.= 0 (the tally.#successes failure_tally)) - (n.= 1 (the tally.#failures failure_tally)))))))) + (n.= 0 (the tally.#successes failure_tally)) + (n.= 1 (the tally.#failures failure_tally))))))) (do ! [success_unit_test (/.lifted expected_message/0 (in true)) failure_unit_test (/.lifted expected_message/0 (in false))] diff --git a/stdlib/source/test/lux/test/unit.lux b/stdlib/source/test/lux/test/unit.lux new file mode 100644 index 000000000..edfc8224a --- /dev/null +++ b/stdlib/source/test/lux/test/unit.lux @@ -0,0 +1,126 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + [concurrency + ["[0]" async]]] + [data + ["[0]" text (.only) + ["%" \\format]] + [collection + ["[0]" set (.use "[1]#[0]" equivalence)]]] + [math + ["[0]" random (.only Random) (.use "[1]#[0]" monad)] + [number + ["n" nat]]] + [meta + ["[0]" static] + ["[0]" code]] + [test + ["_" property (.only Test)]]]] + [\\library + ["[0]" / (.only) + [// + ["[0]" tally (.only Tally)]]]]) + +(def (verify expected_message/0 expected_message/1 successes failures [tally message]) + (-> Text Text Nat Nat [Tally Text] Bit) + (and (text.contains? expected_message/0 message) + (text.contains? expected_message/1 message) + (n.= successes (the tally.#successes tally)) + (n.= failures (the tally.#failures tally)))) + +(with_expansions [expected_message/0 (static.random (|>> %.nat code.text) random.nat) + expected_message/1 (static.random (|>> %.int code.text) random.int) + <context> (static.random (|>> %.rev code.text) random.rev) + <success?> (static.random code.bit random.bit)] + (these (def .public dummy_target + (static.random_nat)) + + (def .public test + Test + (<| random#in + (/.covering /._) + (/.for [/.Test]) + (all /.and + (do async.monad + [[success_tally success_message] (/.success expected_message/0)] + (/.coverage [/.success] + (and (text.contains? (%.text expected_message/0) success_message) + (n.= 1 (the tally.#successes success_tally)) + (n.= 0 (the tally.#failures success_tally))))) + (do async.monad + [[failure_tally failure_message] (/.failure expected_message/0)] + (/.coverage [/.failure] + (and (text.contains? expected_message/0 failure_message) + (n.= 0 (the tally.#successes failure_tally)) + (n.= 1 (the tally.#failures failure_tally))))) + (do async.monad + [[success_tally success_message] (/.test expected_message/0 true) + [failure_tally failure_message] (/.test expected_message/0 false)] + (/.coverage [/.test] + (and (text.ends_with? (%.text expected_message/0) success_message) + (text.ends_with? (%.text expected_message/0) failure_message) + (and (n.= 1 (the tally.#successes success_tally)) + (n.= 0 (the tally.#successes failure_tally))) + (and (n.= 0 (the tally.#failures success_tally)) + (n.= 1 (the tally.#failures failure_tally)))))) + (do async.monad + [tt (/.and (/.test expected_message/0 true) + (/.test expected_message/1 true)) + ff (/.and (/.test expected_message/0 false) + (/.test expected_message/1 false)) + tf (/.and (/.test expected_message/0 true) + (/.test expected_message/1 false)) + ft (/.and (/.test expected_message/0 false) + (/.test expected_message/1 true))] + (/.coverage [/.and] + (and (..verify expected_message/0 expected_message/1 2 0 tt) + (..verify expected_message/0 expected_message/1 0 2 ff) + (..verify expected_message/0 expected_message/1 1 1 tf) + (..verify expected_message/0 expected_message/1 1 1 ft)))) + (do async.monad + [[tally _] (/.covering .._ (/.test "" true))] + (/.coverage [/.covering] + (set.member? (the tally.#expected tally) (symbol ..dummy_target)))) + (do async.monad + [[not_covering _] (/.covering .._ (/.test "" true)) + [covering _] (/.covering .._ (/.coverage [..dummy_target] true))] + (/.coverage [/.coverage] + (and (and (set.member? (the tally.#expected not_covering) (symbol ..dummy_target)) + (not (set.member? (the tally.#actual not_covering) (symbol ..dummy_target)))) + (and (set.member? (the tally.#expected covering) (symbol ..dummy_target)) + (set.member? (the tally.#actual covering) (symbol ..dummy_target)))))) + (do async.monad + [[reference_tally reference_message] (/.test expected_message/0 <success?>) + [context_tally context_message] (/.context <context> + (/.test expected_message/0 <success?>))] + (/.coverage [/.context] + (and (set#= (the tally.#expected context_tally) + (the tally.#expected reference_tally)) + (set#= (the tally.#actual context_tally) + (the tally.#actual reference_tally)) + (n.= (the tally.#successes context_tally) + (the tally.#successes reference_tally)) + (n.= (the tally.#failures context_tally) + (the tally.#failures reference_tally)) + (text.contains? (%.text <context>) context_message) + (not (text.contains? (%.text <context>) reference_message))))) + (do async.monad + [[reference_tally reference_message] (/.test expected_message/0 <success?>) + [context_tally context_message] (<| (/.for [..dummy_target]) + (/.test expected_message/0 <success?>))] + (/.coverage [/.for] + (and (set#= (the tally.#expected reference_tally) + (the tally.#expected context_tally)) + (not (set#= (the tally.#actual reference_tally) + (the tally.#actual context_tally))) + (n.= (the tally.#successes reference_tally) + (the tally.#successes context_tally)) + (n.= (the tally.#failures reference_tally) + (the tally.#failures context_tally)) + (not (text.contains? (%.symbol (symbol ..dummy_target)) reference_message)) + (text.contains? (%.symbol (symbol ..dummy_target)) context_message)))) + ))))) diff --git a/stdlib/source/test/lux/world/time/day.lux b/stdlib/source/test/lux/world/time/day.lux index c6471ffae..a893a1405 100644 --- a/stdlib/source/test/lux/world/time/day.lux +++ b/stdlib/source/test/lux/world/time/day.lux @@ -45,46 +45,59 @@ [expected ..random invalid (random.only (predicate.or (n.< (/.number {/.#Sunday})) (n.> (/.number {/.#Saturday}))) - random.nat)] - (all _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) - (_.for [/.order] - ($order.spec /.order ..random)) - (_.for [/.enum] - ($enum.spec /.enum ..random)) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec ..random)) + random.nat)]) + (`` (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) + (_.for [/.order] + ($order.spec /.order ..random)) + (_.for [/.enum] + ($enum.spec /.enum ..random)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec ..random)) - (do random.monad - [not_a_day (random.upper_case 1)] - (_.coverage [/.not_a_day_of_the_week] - (when (at /.codec decoded not_a_day) + (,, (with_template [<before> <current> <after>] + [(_.coverage [<current>] + (and (at /.equivalence = {<before>} (at /.enum pred {<current>})) + (at /.equivalence = {<after>} (at /.enum succ {<current>}))))] + + [/.#Saturday /.#Sunday /.#Monday] + [/.#Sunday /.#Monday /.#Tuesday] + [/.#Monday /.#Tuesday /.#Wednesday] + [/.#Tuesday /.#Wednesday /.#Thursday] + [/.#Wednesday /.#Thursday /.#Friday] + [/.#Thursday /.#Friday /.#Saturday] + [/.#Friday /.#Saturday /.#Sunday] + )) + (do random.monad + [not_a_day (random.upper_case 1)] + (_.coverage [/.not_a_day_of_the_week] + (when (at /.codec decoded not_a_day) + {try.#Failure error} + (exception.match? /.not_a_day_of_the_week error) + + {try.#Success _} + false))) + (_.coverage [/.number /.by_number] + (|> expected + /.number + /.by_number + (try#each (at /.equivalence = expected)) + (try.else false))) + (_.coverage [/.invalid_day] + (when (/.by_number invalid) {try.#Failure error} - (exception.match? /.not_a_day_of_the_week error) + (exception.match? /.invalid_day error) {try.#Success _} - false))) - (_.coverage [/.number /.by_number] - (|> expected - /.number - /.by_number - (try#each (at /.equivalence = expected)) - (try.else false))) - (_.coverage [/.invalid_day] - (when (/.by_number invalid) - {try.#Failure error} - (exception.match? /.invalid_day error) - - {try.#Success _} - false)) - (_.coverage [/.week] - (let [all (list.size /.week) - uniques (set.size (set.of_list /.hash /.week))] - (and (n.= (/.number {/.#Saturday}) - all) - (n.= all - uniques)))) - )))) + false)) + (_.coverage [/.week] + (let [all (list.size /.week) + uniques (set.size (set.of_list /.hash /.week))] + (and (n.= (/.number {/.#Saturday}) + all) + (n.= all + uniques)))) + )))) diff --git a/stdlib/source/test/lux/world/time/month.lux b/stdlib/source/test/lux/world/time/month.lux index 29117b8d3..d259985c6 100644 --- a/stdlib/source/test/lux/world/time/month.lux +++ b/stdlib/source/test/lux/world/time/month.lux @@ -40,63 +40,81 @@ Test (<| (_.covering /._) (_.for [/.Month]) - (all _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) - (_.for [/.hash] - ($hash.spec /.hash ..random)) - (_.for [/.order] - ($order.spec /.order ..random)) - (_.for [/.enum] - ($enum.spec /.enum ..random)) - (_.for [/.codec] - ($codec.spec /.equivalence /.codec ..random)) + (`` (all _.and + (_.for [/.equivalence] + ($equivalence.spec /.equivalence ..random)) + (_.for [/.hash] + ($hash.spec /.hash ..random)) + (_.for [/.order] + ($order.spec /.order ..random)) + (_.for [/.enum] + ($enum.spec /.enum ..random)) + (_.for [/.codec] + ($codec.spec /.equivalence /.codec ..random)) - (do random.monad - [expected ..random - invalid (random.only (predicate.or (n.< (/.number {/.#January})) - (n.> (/.number {/.#December}))) - random.nat)] - (all _.and - (_.coverage [/.number /.by_number] - (|> expected - /.number - /.by_number - (try#each (at /.equivalence = expected)) - (try.else false))) - (_.coverage [/.invalid_month] - (when (/.by_number invalid) - {try.#Failure error} - (exception.match? /.invalid_month error) - - {try.#Success _} - false)) - (_.coverage [/.year] - (let [all (list.size /.year) - uniques (set.size (set.of_list /.hash /.year))] - (and (n.= (/.number {/.#December}) - all) - (n.= all - uniques)))) - (_.coverage [/.days] - (let [expected (.nat (duration.ticks duration.day duration.normal_year))] - (|> /.year - (list#each /.days) - (list#mix n.+ 0) - (n.= expected)))) - (_.coverage [/.leap_year_days] - (let [expected (.nat (duration.ticks duration.day duration.leap_year))] - (|> /.year - (list#each /.leap_year_days) - (list#mix n.+ 0) - (n.= expected)))) - (do random.monad - [not_a_month (random.upper_case 1)] - (_.coverage [/.not_a_month_of_the_year] - (when (at /.codec decoded not_a_month) - {try.#Failure error} - (exception.match? /.not_a_month_of_the_year error) - - {try.#Success _} - false))) - ))))) + (,, (with_template [<before> <current> <after>] + [(_.coverage [<current>] + (and (at /.equivalence = {<before>} (at /.enum pred {<current>})) + (at /.equivalence = {<after>} (at /.enum succ {<current>}))))] + + [/.#December /.#January /.#February] + [/.#January /.#February /.#March] + [/.#February /.#March /.#April] + [/.#March /.#April /.#May] + [/.#April /.#May /.#June] + [/.#May /.#June /.#July] + [/.#June /.#July /.#August] + [/.#July /.#August /.#September] + [/.#August /.#September /.#October] + [/.#September /.#October /.#November] + [/.#October /.#November /.#December] + [/.#November /.#December /.#January] + )) + (do random.monad + [expected ..random + invalid (random.only (predicate.or (n.< (/.number {/.#January})) + (n.> (/.number {/.#December}))) + random.nat)] + (all _.and + (_.coverage [/.number /.by_number] + (|> expected + /.number + /.by_number + (try#each (at /.equivalence = expected)) + (try.else false))) + (_.coverage [/.invalid_month] + (when (/.by_number invalid) + {try.#Failure error} + (exception.match? /.invalid_month error) + + {try.#Success _} + false)) + (_.coverage [/.year] + (let [all (list.size /.year) + uniques (set.size (set.of_list /.hash /.year))] + (and (n.= (/.number {/.#December}) + all) + (n.= all + uniques)))) + (_.coverage [/.days] + (let [expected (.nat (duration.ticks duration.day duration.normal_year))] + (|> /.year + (list#each /.days) + (list#mix n.+ 0) + (n.= expected)))) + (_.coverage [/.leap_year_days] + (let [expected (.nat (duration.ticks duration.day duration.leap_year))] + (|> /.year + (list#each /.leap_year_days) + (list#mix n.+ 0) + (n.= expected)))) + (do random.monad + [not_a_month (random.upper_case 1)] + (_.coverage [/.not_a_month_of_the_year] + (when (at /.codec decoded not_a_month) + {try.#Failure error} + (exception.match? /.not_a_month_of_the_year error) + + {try.#Success _} + false))) + )))))) |