aboutsummaryrefslogtreecommitdiff
path: root/stdlib
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib')
-rw-r--r--stdlib/source/library/lux.lux9
-rw-r--r--stdlib/source/library/lux/control/function/polymorphism/context.lux203
-rw-r--r--stdlib/source/library/lux/control/function/predicate.lux10
-rw-r--r--stdlib/source/library/lux/test/unit.lux26
-rw-r--r--stdlib/source/test/lux.lux6
-rw-r--r--stdlib/source/test/lux/control/function.lux4
-rw-r--r--stdlib/source/test/lux/control/function/polymorphism/context.lux117
-rw-r--r--stdlib/source/test/lux/program.lux2
-rw-r--r--stdlib/source/test/lux/test.lux2
-rw-r--r--stdlib/source/test/lux/test/property.lux58
-rw-r--r--stdlib/source/test/lux/test/unit.lux126
-rw-r--r--stdlib/source/test/lux/world/time/day.lux91
-rw-r--r--stdlib/source/test/lux/world/time/month.lux136
13 files changed, 623 insertions, 167 deletions
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)))
+ ))))))