diff options
Diffstat (limited to 'stdlib/source/test')
23 files changed, 427 insertions, 362 deletions
diff --git a/stdlib/source/test/aedifex.lux b/stdlib/source/test/aedifex.lux index 7540b4541..71d9a29bb 100644 --- a/stdlib/source/test/aedifex.lux +++ b/stdlib/source/test/aedifex.lux @@ -14,7 +14,8 @@ ["#/." install] ["#/." deploy] ["#/." deps] - ["#/." build]] + ["#/." build] + ["#/." test]] ["#." local] ["#." cache] ["#." dependency @@ -40,6 +41,7 @@ /command/deploy.test /command/deps.test /command/build.test + /command/test.test /local.test /cache.test /dependency.test diff --git a/stdlib/source/test/aedifex/cache.lux b/stdlib/source/test/aedifex/cache.lux index 7dff44202..81d5fe136 100644 --- a/stdlib/source/test/aedifex/cache.lux +++ b/stdlib/source/test/aedifex/cache.lux @@ -101,14 +101,14 @@ (wrap (do promise.monad [wrote! (/.write-one fs dependency expected-package) read! (/.read-one fs dependency)] - (_.claim [/.write-one /.read-one] - (<| (try.default false) - (do try.monad - [_ wrote! - actual-package read!] - (wrap (:: //package.equivalence = - (set@ #//package.origin #//package.Local expected-package) - actual-package))))))))) + (_.cover' [/.write-one /.read-one] + (<| (try.default false) + (do try.monad + [_ wrote! + actual-package read!] + (wrap (:: //package.equivalence = + (set@ #//package.origin #//package.Local expected-package) + actual-package))))))))) (def: plural Test @@ -119,16 +119,16 @@ (wrap (do promise.monad [wrote! (/.write-all fs expected) read! (/.read-all fs (dictionary.keys expected) //dependency/resolution.empty)] - (_.claim [/.write-all /.read-all] - (<| (try.default false) - (do try.monad - [_ wrote! - actual read!] - (wrap (:: //dependency/resolution.equivalence = - (:: dictionary.functor map - (set@ #//package.origin #//package.Local) - expected) - actual))))))))) + (_.cover' [/.write-all /.read-all] + (<| (try.default false) + (do try.monad + [_ wrote! + actual read!] + (wrap (:: //dependency/resolution.equivalence = + (:: dictionary.functor map + (set@ #//package.origin #//package.Local) + expected) + actual))))))))) (def: #export test Test diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux index 5285b7548..ad72b47c4 100644 --- a/stdlib/source/test/aedifex/command/build.lux +++ b/stdlib/source/test/aedifex/command/build.lux @@ -2,8 +2,7 @@ [lux #* ["_" test (#+ Test)] [abstract - [monad (#+ do)] - ["." predicate]] + [monad (#+ do)]] [control ["." try] ["." exception] @@ -12,30 +11,20 @@ [parser ["." environment]]] [data - [text - ["%" format (#+ format)]] [collection - ["." dictionary] - ["." set]]] + ["." dictionary]]] [math - ["." random (#+ Random)]] + ["." random]] [world ["." file] ["." shell]]] ["$." /// #_ - ["#." package] - ["#." artifact] - ["#." dependency #_ - ["#/." resolution]]] + ["#." package]] {#program ["." / ["//#" /// #_ ["#" profile (#+ Profile)] ["#." action] - ["#." pom] - ["#." package] - ["#." cache] - ["#." repository] ["#." artifact ["#/." type]] ["#." dependency @@ -96,32 +85,32 @@ (wrap (do promise.monad [outcome (/.do! environment fs shell ///dependency/resolution.empty (with-target empty-profile))] - (_.claim [/.no-specified-program] - (case outcome - (#try.Success _) - false + (_.cover' [/.no-specified-program] + (case outcome + (#try.Success _) + false - (#try.Failure error) - (exception.match? /.no-specified-program error))))) + (#try.Failure error) + (exception.match? /.no-specified-program error))))) (wrap (do promise.monad [outcome (/.do! environment fs shell ///dependency/resolution.empty (with-program empty-profile))] - (_.claim [/.no-specified-target] - (case outcome - (#try.Success _) - false + (_.cover' [/.no-specified-target] + (case outcome + (#try.Success _) + false - (#try.Failure error) - (exception.match? /.no-specified-target error))))) + (#try.Failure error) + (exception.match? /.no-specified-target error))))) (wrap (do promise.monad [outcome (/.do! environment fs shell ///dependency/resolution.empty profile)] - (_.claim [/.Compiler /.no-available-compiler] - (case outcome - (#try.Success _) - false + (_.cover' [/.Compiler /.no-available-compiler] + (case outcome + (#try.Success _) + false - (#try.Failure error) - (exception.match? /.no-available-compiler error))))) + (#try.Failure error) + (exception.match? /.no-available-compiler error))))) (do ! [lux-version (random.ascii/alpha 5) [_ compiler-package] $///package.random @@ -141,7 +130,7 @@ (dictionary.put compiler-dependency compiler-package))] _ (/.do! environment fs shell resolution profile)] (wrap true))] - (_.claim [/.do! - /.lux-group /.jvm-compiler-name /.js-compiler-name] - (try.default false verdict))))) + (_.cover' [/.do! + /.lux-group /.jvm-compiler-name /.js-compiler-name] + (try.default false verdict))))) )))) diff --git a/stdlib/source/test/aedifex/command/clean.lux b/stdlib/source/test/aedifex/command/clean.lux index ba9431b95..7246d38a7 100644 --- a/stdlib/source/test/aedifex/command/clean.lux +++ b/stdlib/source/test/aedifex/command/clean.lux @@ -114,5 +114,5 @@ (not target-exists!/post)) (and sub-exists!/pre (not sub-exists!/post)))))] - (_.claim [/.do!] - (try.default false verdict))))))) + (_.cover' [/.do!] + (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux index b27d3c0a7..52b995f6f 100644 --- a/stdlib/source/test/aedifex/command/deploy.lux +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -125,5 +125,5 @@ deployed-pom! deployed-sha-1! deployed-md5!)))] - (_.claim [/.do!] - (try.default false verdict))))))) + (_.cover' [/.do!] + (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux index ce85a2206..8c19df87f 100644 --- a/stdlib/source/test/aedifex/command/deps.lux +++ b/stdlib/source/test/aedifex/command/deps.lux @@ -84,5 +84,5 @@ (not (set.member? pre depender-artifact))) (and (dictionary.contains? dependee post) (dictionary.contains? depender post)))))] - (_.claim [/.do!] - (try.default false verdict))))))) + (_.cover' [/.do!] + (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/command/install.lux b/stdlib/source/test/aedifex/command/install.lux index bcc6bb039..8982bc941 100644 --- a/stdlib/source/test/aedifex/command/install.lux +++ b/stdlib/source/test/aedifex/command/install.lux @@ -86,16 +86,16 @@ (file.file-exists? promise.monad fs pom-path))] (wrap (and library-exists! pom-exists!)))] - (_.claim [/.do!] - (try.default false verdict))) + (_.cover' [/.do!] + (try.default false verdict))) #.None (do {! promise.monad} [outcome (..execute! fs sample)] - (_.claim [/.do!] - (case outcome - (#try.Success _) - false + (_.cover' [/.do!] + (case outcome + (#try.Success _) + false - (#try.Failure error) - true)))))))) + (#try.Failure error) + true)))))))) diff --git a/stdlib/source/test/aedifex/command/pom.lux b/stdlib/source/test/aedifex/command/pom.lux index dc05cced0..169318589 100644 --- a/stdlib/source/test/aedifex/command/pom.lux +++ b/stdlib/source/test/aedifex/command/pom.lux @@ -54,14 +54,14 @@ (:: binary.equivalence = expected actual)]] (wrap (and expected-path! expected-content!)))] - (_.claim [/.do!] - (try.default false verdict))) + (_.cover' [/.do!] + (try.default false verdict))) (#try.Failure error) - (_.claim [/.do!] - (case (get@ #///.identity sample) - (#.Some _) - false + (_.cover' [/.do!] + (case (get@ #///.identity sample) + (#.Some _) + false - #.None - true)))))))) + #.None + true)))))))) diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux new file mode 100644 index 000000000..be1a89c83 --- /dev/null +++ b/stdlib/source/test/aedifex/command/test.lux @@ -0,0 +1,94 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try] + [concurrency + ["." promise]] + [parser + ["." environment]]] + [data + [collection + ["." dictionary]]] + [math + ["." random]] + [world + ["." file] + ["." shell]]] + ["$." /// #_ + ["#." package]] + {#program + ["." / + ["/#" // #_ + ["#." build] + ["/#" // #_ + ["#" profile (#+ Profile)] + ["#." action] + ["#." artifact + ["#/." type]] + ["#." dependency + ["#/." resolution]]]]]}) + +(def: #export test + Test + (<| (_.covering /._) + (do {! random.monad} + [#let [fs (file.mock (:: file.default separator)) + shell (shell.mock + (function (_ [actual-environment actual-working-directory actual-command actual-arguments]) + (#try.Success + (: (shell.Simulation []) + (structure + (def: (on-read state) + (#try.Failure "on-read")) + (def: (on-error state) + (#try.Failure "on-error")) + (def: (on-write input state) + (#try.Failure "on-write")) + (def: (on-destroy state) + (#try.Failure "on-destroy")) + (def: (on-await state) + (#try.Success [state shell.normal])))))) + [])] + program (random.ascii/alpha 5) + target (random.ascii/alpha 5) + working-directory (random.ascii/alpha 5) + #let [empty-profile (: Profile + (:: ///.monoid identity)) + with-target (: (-> Profile Profile) + (set@ #///.target (#.Some target))) + with-program (: (-> Profile Profile) + (set@ #///.program (#.Some program))) + + profile (|> empty-profile + with-program + with-target) + + no-working-directory environment.empty + + environment (dictionary.put "user.dir" working-directory environment.empty)]] + ($_ _.and + (do ! + [lux-version (random.ascii/alpha 5) + [_ compiler-package] $///package.random + #let [jvm-compiler {#///dependency.artifact {#///artifact.group //build.lux-group + #///artifact.name //build.jvm-compiler-name + #///artifact.version lux-version} + #///dependency.type ///artifact/type.lux-library} + js-compiler {#///dependency.artifact {#///artifact.group //build.lux-group + #///artifact.name //build.js-compiler-name + #///artifact.version lux-version} + #///dependency.type ///artifact/type.lux-library}] + compiler-dependency (random.either (wrap jvm-compiler) + (wrap js-compiler))] + (wrap (do promise.monad + [verdict (do ///action.monad + [#let [resolution (|> ///dependency/resolution.empty + (dictionary.put compiler-dependency compiler-package))] + _ (/.do! environment fs shell resolution profile)] + (wrap true))] + (_.cover' [/.do!] + (try.default false verdict))))) + )))) diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux index 0b2fbe2e2..8bd013125 100644 --- a/stdlib/source/test/aedifex/dependency/resolution.lux +++ b/stdlib/source/test/aedifex/dependency/resolution.lux @@ -164,28 +164,28 @@ [actual-package (/.one (///repository.mock good []) {#///dependency.artifact expected-artifact #///dependency.type ///artifact/type.lux-library})] - (_.claim [/.one] - (case actual-package - (#try.Success actual-package) - (:: ///package.equivalence = - (set@ #///package.origin #///package.Remote expected-package) - actual-package) - - (#try.Failure _) - false)))) + (_.cover' [/.one] + (case actual-package + (#try.Success actual-package) + (:: ///package.equivalence = + (set@ #///package.origin #///package.Remote expected-package) + actual-package) + + (#try.Failure _) + false)))) (~~ (template [<exception> <bad>] [(wrap (do promise.monad [actual-package (/.one (///repository.mock <bad> []) {#///dependency.artifact expected-artifact #///dependency.type ///artifact/type.lux-library})] - (_.claim [<exception>] - (case actual-package - (#try.Failure error) - (exception.match? <exception> error) + (_.cover' [<exception>] + (case actual-package + (#try.Failure error) + (exception.match? <exception> error) - (#try.Success _) - false))))] + (#try.Success _) + false))))] [/.sha-1-does-not-match bad-sha-1] [/.md5-does-not-match bad-md5] @@ -271,28 +271,28 @@ (///repository.mock good [])) {#///dependency.artifact expected-artifact #///dependency.type ///artifact/type.lux-library})] - (_.claim [/.any] - (case actual-package - (#try.Success actual-package) - (:: ///package.equivalence = - (set@ #///package.origin #///package.Remote expected-package) - actual-package) - - (#try.Failure _) - false)))) + (_.cover' [/.any] + (case actual-package + (#try.Success actual-package) + (:: ///package.equivalence = + (set@ #///package.origin #///package.Remote expected-package) + actual-package) + + (#try.Failure _) + false)))) (wrap (do promise.monad [actual-package (/.any (list (///repository.mock bad-sha-1 []) (///repository.mock bad-md5 [])) {#///dependency.artifact expected-artifact #///dependency.type ///artifact/type.lux-library})] - (_.claim [/.cannot-resolve] - (case actual-package - (#try.Failure error) - (exception.match? /.cannot-resolve error) + (_.cover' [/.cannot-resolve] + (case actual-package + (#try.Failure error) + (exception.match? /.cannot-resolve error) - (#try.Success _) - false)))) + (#try.Success _) + false)))) ))) (def: all @@ -343,15 +343,15 @@ (///repository.mock (..single ignored-artifact ignored-package) [])) (list depender) /.empty)] - (_.claim [/.all] - (case resolution - (#try.Success resolution) - (and (dictionary.contains? depender resolution) - (dictionary.contains? dependee resolution) - (not (dictionary.contains? ignored resolution))) + (_.cover' [/.all] + (case resolution + (#try.Success resolution) + (and (dictionary.contains? depender resolution) + (dictionary.contains? dependee resolution) + (not (dictionary.contains? ignored resolution))) - (#try.Failure error) - false)))) + (#try.Failure error) + false)))) ))) (def: #export test diff --git a/stdlib/source/test/aedifex/input.lux b/stdlib/source/test/aedifex/input.lux index c7f6a4282..9f85ea5af 100644 --- a/stdlib/source/test/aedifex/input.lux +++ b/stdlib/source/test/aedifex/input.lux @@ -57,5 +57,5 @@ (wrap (:: //.equivalence = (update@ #//.sources ..with-default-source expected) actual)))] - (_.claim [/.read] - (try.default false verdict))))))) + (_.cover' [/.read] + (try.default false verdict))))))) diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index c25d7b07f..0932fba3d 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -97,35 +97,35 @@ (/.poison! actor))) _ (promise.wait 100) result (promise.future (promise.poll read))] - (_.claim [/.poisoned] - (case result - (#.Some error) - (exception.match? /.poisoned error) + (_.cover' [/.poisoned] + (case result + (#.Some error) + (exception.match? /.poisoned error) - #.None - false))))) + #.None + false))))) (wrap (do promise.monad [sent? (promise.future (do io.monad [actor (/.spawn! /.default 0) sent? (/.mail! inc! actor)] (wrap (..mailed? sent?))))] - (_.claim [/.Behavior /.Mail - /.default /.spawn! /.mail!] - sent?))) + (_.cover' [/.Behavior /.Mail + /.default /.spawn! /.mail!] + sent?))) (wrap (do promise.monad [result (promise.future (do io.monad [counter (/.spawn! /.default 0) _ (/.poison! counter)] (/.mail! inc! counter)))] - (_.claim [/.dead] - (case result - (#try.Success outcome) - false + (_.cover' [/.dead] + (case result + (#try.Success outcome) + false - (#try.Failure error) - (exception.match? /.dead error))))) + (#try.Failure error) + (exception.match? /.dead error))))) (let [die! (: (/.Mail Nat) (function (_ state actor) @@ -137,17 +137,17 @@ alive? (/.alive? actor) obituary (/.obituary actor)] (wrap (#try.Success [actor sent? alive? obituary]))))] - (_.claim [/.Obituary /.obituary] - (case result - (^ (#try.Success [actor sent? alive? (#.Some [error state (list single-pending-message)])])) - (and (..mailed? sent?) - (not alive?) - (exception.match? ..got-wrecked error) - (n.= initial-state state) - (is? die! single-pending-message)) - - _ - false))))) + (_.cover' [/.Obituary /.obituary] + (case result + (^ (#try.Success [actor sent? alive? (#.Some [error state (list single-pending-message)])])) + (and (..mailed? sent?) + (not alive?) + (exception.match? ..got-wrecked error) + (n.= initial-state state) + (is? die! single-pending-message)) + + _ + false))))) (wrap (do promise.monad [counter (promise.future (/.spawn! ..counter 0)) @@ -158,13 +158,13 @@ (wrap (and (n.= 1 output-1) (n.= 2 output-2) (n.= 3 output-3))))] - (_.claim [/.actor: /.message: /.tell!] - (case result - (#try.Success outcome) - outcome + (_.cover' [/.actor: /.message: /.tell!] + (case result + (#try.Success outcome) + outcome - (#try.Failure error) - false)))) + (#try.Failure error) + false)))) (wrap (do promise.monad [verdict (promise.future @@ -192,8 +192,8 @@ _ false)))))] - (_.claim [/.actor] - verdict))) + (_.cover' [/.actor] + verdict))) (do ! [num-events (:: ! map (|>> (n.% 10) inc) random.nat) events (random.list num-events random.nat) @@ -234,7 +234,7 @@ #.None false)]] - (_.claim [/.observe] - (and (:: (list.equivalence n.equivalence) = expected (row.to-list actual)) - (not died?)))))) + (_.cover' [/.observe] + (and (:: (list.equivalence n.equivalence) = expected (row.to-list actual)) + (not died?)))))) )))) diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index c9b19f1c7..fd5e7be02 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -103,24 +103,24 @@ promise.resolved /.from-promise /.consume)] - (_.claim [/.from-promise /.consume] - (list\= (list sample) - output)))) + (_.cover' [/.from-promise /.consume] + (list\= (list sample) + output)))) (wrap (do promise.monad [output (|> inputs (/.sequential 0) /.consume)] - (_.claim [/.sequential] - (list\= inputs - output)))) + (_.cover' [/.sequential] + (list\= inputs + output)))) (wrap (do promise.monad [output (|> inputs (/.sequential 0) (/.filter n.even?) /.consume)] - (_.claim [/.filter] - (list\= (list.filter n.even? inputs) - output)))) + (_.cover' [/.filter] + (list\= (list.filter n.even? inputs) + output)))) (wrap (do {! promise.monad} [#let [sink (: (Atom (Row Nat)) (atom.atom row.empty)) @@ -140,19 +140,19 @@ atom.read promise.future (:: ! map row.to-list))] - (_.claim [/.Subscriber /.subscribe] - (and (list\= inputs - output) - (list\= output - listened))))) + (_.cover' [/.Subscriber /.subscribe] + (and (list\= inputs + output) + (list\= output + listened))))) (wrap (do promise.monad [actual (/.fold (function (_ input total) (promise.resolved (n.+ input total))) 0 (/.sequential 0 inputs))] - (_.claim [/.fold] - (n.= (list\fold n.+ 0 inputs) - actual)))) + (_.cover' [/.fold] + (n.= (list\fold n.+ 0 inputs) + actual)))) (wrap (do promise.monad [actual (|> inputs (/.sequential 0) @@ -160,9 +160,9 @@ (promise.resolved (n.+ input total))) 0) /.consume)] - (_.claim [/.folds] - (list\= (list.folds n.+ 0 inputs) - actual)))) + (_.cover' [/.folds] + (list\= (list.folds n.+ 0 inputs) + actual)))) (wrap (do promise.monad [actual (|> (list distint/0 distint/0 distint/0 distint/1 @@ -170,9 +170,9 @@ (/.sequential 0) (/.distinct n.equivalence) /.consume)] - (_.claim [/.distinct] - (list\= (list distint/0 distint/1 distint/2) - actual)))) + (_.cover' [/.distinct] + (list\= (list distint/0 distint/1 distint/2) + actual)))) (let [polling-delay 10 wiggle-room (n.* 5 polling-delay) amount-of-polls 5 @@ -185,16 +185,16 @@ _ (promise.schedule total-delay (io.io [])) _ (promise.future (:: sink close)) actual (/.consume channel)] - (_.claim [/.poll] - (and (list.every? (n.= sample) actual) - (n.>= amount-of-polls (list.size actual)))))) + (_.cover' [/.poll] + (and (list.every? (n.= sample) actual) + (n.>= amount-of-polls (list.size actual)))))) (wrap (do promise.monad [#let [[channel sink] (/.periodic polling-delay)] _ (promise.schedule total-delay (io.io [])) _ (promise.future (:: sink close)) actual (/.consume channel)] - (_.claim [/.periodic] - (n.>= amount-of-polls (list.size actual))))))) + (_.cover' [/.periodic] + (n.>= amount-of-polls (list.size actual))))))) (wrap (do promise.monad [#let [max-iterations 10] actual (|> [0 sample] @@ -205,8 +205,8 @@ current]) #.None)))) /.consume)] - (_.claim [/.iterate] - (and (n.= max-iterations (list.size actual)) - (list\= (list.folds n.+ sample (list.repeat (dec max-iterations) shift)) - actual))))) + (_.cover' [/.iterate] + (and (n.= max-iterations (list.size actual)) + (list\= (list.folds n.+ sample (list.repeat (dec max-iterations) shift)) + actual))))) ))))) diff --git a/stdlib/source/test/lux/control/concurrency/promise.lux b/stdlib/source/test/lux/control/concurrency/promise.lux index 0dc28819d..852dca607 100644 --- a/stdlib/source/test/lux/control/concurrency/promise.lux +++ b/stdlib/source/test/lux/control/concurrency/promise.lux @@ -68,97 +68,97 @@ (/.promise []))] resolved? (/.future (resolver expected)) actual promise] - (_.claim [/.Promise /.Resolver /.promise] - (and resolved? - (n.= expected actual))))) + (_.cover' [/.Promise /.Resolver /.promise] + (and resolved? + (n.= expected actual))))) (wrap (do /.monad [actual (/.resolved expected)] - (_.claim [/.resolved] - (n.= expected actual)))) + (_.cover' [/.resolved] + (n.= expected actual)))) (wrap (do /.monad [actual (/.future (io.io expected))] - (_.claim [/.future] - (n.= expected actual)))) + (_.cover' [/.future] + (n.= expected actual)))) (wrap (do /.monad [pre (/.future instant.now) actual (/.schedule to-wait (io.io expected)) post (/.future instant.now)] - (_.claim [/.schedule] - (and (n.= expected actual) - (i.>= (.int to-wait) - (duration.to-millis (instant.span pre post))))))) + (_.cover' [/.schedule] + (and (n.= expected actual) + (i.>= (.int to-wait) + (duration.to-millis (instant.span pre post))))))) (wrap (do /.monad [pre (/.future instant.now) _ (/.wait to-wait) post (/.future instant.now)] - (_.claim [/.wait] - (i.>= (.int to-wait) - (duration.to-millis (instant.span pre post)))))) + (_.cover' [/.wait] + (i.>= (.int to-wait) + (duration.to-millis (instant.span pre post)))))) (wrap (do /.monad [[leftA rightA] (/.and (/.future (io.io leftE)) (/.future (io.io rightE)))] - (_.claim [/.and] - (n.= (n.+ leftE rightE) - (n.+ leftA rightA))))) + (_.cover' [/.and] + (n.= (n.+ leftE rightE) + (n.+ leftA rightA))))) (wrap (do /.monad [pre (/.future instant.now) actual (/.delay to-wait expected) post (/.future instant.now)] - (_.claim [/.delay] - (and (n.= expected actual) - (i.>= (.int to-wait) - (duration.to-millis (instant.span pre post))))))) + (_.cover' [/.delay] + (and (n.= expected actual) + (i.>= (.int to-wait) + (duration.to-millis (instant.span pre post))))))) (wrap (do /.monad [?left (/.or (/.delay 100 leftE) (/.delay 200 dummy)) ?right (/.or (/.delay 200 dummy) (/.delay 100 rightE))] - (_.claim [/.or] - (case [?left ?right] - [(#.Left leftA) (#.Right rightA)] - (n.= (n.+ leftE rightE) - (n.+ leftA rightA)) + (_.cover' [/.or] + (case [?left ?right] + [(#.Left leftA) (#.Right rightA)] + (n.= (n.+ leftE rightE) + (n.+ leftA rightA)) - _ - false)))) + _ + false)))) (wrap (do /.monad [leftA (/.either (/.delay 100 leftE) (/.delay 200 dummy)) rightA (/.either (/.delay 200 dummy) (/.delay 100 rightE))] - (_.claim [/.either] - (n.= (n.+ leftE rightE) - (n.+ leftA rightA))))) + (_.cover' [/.either] + (n.= (n.+ leftE rightE) + (n.+ leftA rightA))))) (wrap (do /.monad [?actual (/.future (/.poll (/.resolved expected))) #let [[promise resolver] (: [(/.Promise Nat) (/.Resolver Nat)] (/.promise []))] ?never (/.future (/.poll promise))] - (_.claim [/.poll] - (case [?actual ?never] - [(#.Some actual) #.None] - (n.= expected actual) + (_.cover' [/.poll] + (case [?actual ?never] + [(#.Some actual) #.None] + (n.= expected actual) - _ - false)))) + _ + false)))) (wrap (do /.monad [yep (/.future (/.resolved? (/.resolved expected))) #let [[promise resolver] (: [(/.Promise Nat) (/.Resolver Nat)] (/.promise []))] nope (/.future (/.resolved? promise))] - (_.claim [/.resolved?] - (and yep - (not nope))))) + (_.cover' [/.resolved?] + (and yep + (not nope))))) (wrap (do /.monad [?none (/.time-out to-wait (/.delay extra-time dummy)) ?actual (/.time-out extra-time (/.delay to-wait expected))] - (_.claim [/.time-out] - (case [?none ?actual] - [#.None (#.Some actual)] - (n.= expected actual) + (_.cover' [/.time-out] + (case [?none ?actual] + [#.None (#.Some actual)] + (n.= expected actual) - _ - false)))) + _ + false)))) (wrap (do /.monad [#let [box (: (Atom Nat) (atom.atom dummy))] @@ -166,6 +166,6 @@ (atom.write value box)) (/.resolved expected))) actual (/.future (atom.read box))] - (_.claim [/.await] - (n.= expected actual)))) + (_.cover' [/.await] + (n.= expected actual)))) )))) diff --git a/stdlib/source/test/lux/control/concurrency/semaphore.lux b/stdlib/source/test/lux/control/concurrency/semaphore.lux index fa81183cd..d1c6ac1e4 100644 --- a/stdlib/source/test/lux/control/concurrency/semaphore.lux +++ b/stdlib/source/test/lux/control/concurrency/semaphore.lux @@ -35,26 +35,26 @@ #let [semaphore (/.semaphore initial-open-positions)]] (wrap (do promise.monad [result (promise.time-out 10 (/.wait semaphore))] - (_.claim [/.semaphore] - (case result - (#.Some _) - true + (_.cover' [/.semaphore] + (case result + (#.Some _) + true - #.None - false))))) + #.None + false))))) (do {! random.monad} [initial-open-positions (|> random.nat (:: ! map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial-open-positions)]] (wrap (do {! promise.monad} [_ (monad.map ! /.wait (list.repeat initial-open-positions semaphore)) result (promise.time-out 10 (/.wait semaphore))] - (_.claim [/.wait] - (case result - (#.Some _) - false + (_.cover' [/.wait] + (case result + (#.Some _) + false - #.None - true))))) + #.None + true))))) (do {! random.monad} [initial-open-positions (|> random.nat (:: ! map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial-open-positions)]] @@ -64,25 +64,25 @@ result/0 (promise.time-out 10 block) open-positions (/.signal semaphore) result/1 (promise.time-out 10 block)] - (_.claim [/.signal] - (case [result/0 result/1 open-positions] - [#.None (#.Some _) (#try.Success +0)] - true + (_.cover' [/.signal] + (case [result/0 result/1 open-positions] + [#.None (#.Some _) (#try.Success +0)] + true - _ - false))))) + _ + false))))) (do {! random.monad} [initial-open-positions (|> random.nat (:: ! map (|>> (n.% 10) (n.max 1)))) #let [semaphore (/.semaphore initial-open-positions)]] (wrap (do promise.monad [outcome (/.signal semaphore)] - (_.claim [/.semaphore-is-maxed-out] - (case outcome - (#try.Failure error) - (exception.match? /.semaphore-is-maxed-out error) + (_.cover' [/.semaphore-is-maxed-out] + (case outcome + (#try.Failure error) + (exception.match? /.semaphore-is-maxed-out error) - _ - false))))) + _ + false))))) ))) (def: mutex @@ -115,11 +115,11 @@ [_ processA _ processB #let [outcome (io.run (atom.read resource))]] - (_.claim [/.mutex /.synchronize] - (or (text\= (format expected-As expected-Bs) - outcome) - (text\= (format expected-Bs expected-As) - outcome)))))) + (_.cover' [/.mutex /.synchronize] + (or (text\= (format expected-As expected-Bs) + outcome) + (text\= (format expected-Bs expected-As) + outcome)))))) ))) (def: (waiter resource barrier id) @@ -161,12 +161,12 @@ ids)] _ (monad.seq ! waiters) #let [outcome (io.run (atom.read resource))]] - (_.claim [/.barrier /.block] - (and (text.ends-with? ending outcome) - (list.every? (function (_ id) - (text.contains? (%.nat id) outcome)) - ids) - ))))) + (_.cover' [/.barrier /.block] + (and (text.ends-with? ending outcome) + (list.every? (function (_ id) + (text.contains? (%.nat id) outcome)) + ids) + ))))) ))) (def: #export test diff --git a/stdlib/source/test/lux/control/concurrency/stm.lux b/stdlib/source/test/lux/control/concurrency/stm.lux index ca2a0eb92..234c9a64e 100644 --- a/stdlib/source/test/lux/control/concurrency/stm.lux +++ b/stdlib/source/test/lux/control/concurrency/stm.lux @@ -52,12 +52,12 @@ (wrap (do promise.monad [actual (/.commit (:: /.monad wrap expected))] - (_.claim [/.commit] - (n.= expected actual)))) + (_.cover' [/.commit] + (n.= expected actual)))) (wrap (do promise.monad [actual (/.commit (/.read (/.var expected)))] - (_.claim [/.Var /.var /.read] - (n.= expected actual)))) + (_.cover' [/.Var /.var /.read] + (n.= expected actual)))) (wrap (do promise.monad [actual (let [box (/.var dummy)] (/.commit (do /.monad @@ -68,17 +68,17 @@ [_ (/.write expected box) actual (/.read box)] (wrap (n.= expected actual)))))] - (_.claim [/.write] - (and (n.= expected actual) - verdict)))) + (_.cover' [/.write] + (and (n.= expected actual) + verdict)))) (wrap (do promise.monad [#let [box (/.var dummy)] output (/.commit (do /.monad [_ (/.update (n.+ expected) box)] (/.read box)))] - (_.claim [/.update] - (n.= (n.+ expected dummy) - output)))) + (_.cover' [/.update] + (n.= (n.+ expected dummy) + output)))) (wrap (do promise.monad [#let [box (/.var dummy) [follower sink] (io.run (/.follow box))] @@ -87,17 +87,17 @@ _ (promise.future (:: sink close)) _ (/.commit (/.update (n.* 3) box)) changes (frp.consume follower)] - (_.claim [/.follow] - (:: (list.equivalence n.equivalence) = - (list expected (n.* 2 expected)) - changes)))) + (_.cover' [/.follow] + (:: (list.equivalence n.equivalence) = + (list expected (n.* 2 expected)) + changes)))) (wrap (let [var (/.var 0)] (do {! promise.monad} [_ (|> (list.repeat iterations-per-process []) (list\map (function (_ _) (/.commit (/.update inc var)))) (monad.seq !)) cummulative (/.commit (/.read var))] - (_.claim [/.STM] - (n.= iterations-per-process - cummulative))))) + (_.cover' [/.STM] + (n.= iterations-per-process + cummulative))))) )))) diff --git a/stdlib/source/test/lux/control/concurrency/thread.lux b/stdlib/source/test/lux/control/concurrency/thread.lux index 6d59672ca..7794be1b9 100644 --- a/stdlib/source/test/lux/control/concurrency/thread.lux +++ b/stdlib/source/test/lux/control/concurrency/thread.lux @@ -39,8 +39,8 @@ (atom.write [execution-time expected] box)))) _ (promise.wait delay) [execution-time actual] (promise.future (atom.read box))] - (_.claim [/.schedule] - (and (i.>= (.int delay) - (duration.to-millis (instant.span reference-time execution-time))) - (n.= expected actual))))) + (_.cover' [/.schedule] + (and (i.>= (.int delay) + (duration.to-millis (instant.span reference-time execution-time))) + (n.= expected actual))))) )))) diff --git a/stdlib/source/test/lux/control/security/capability.lux b/stdlib/source/test/lux/control/security/capability.lux index b102c6a33..f8f757641 100644 --- a/stdlib/source/test/lux/control/security/capability.lux +++ b/stdlib/source/test/lux/control/security/capability.lux @@ -40,6 +40,6 @@ (wrap (let [capability (..can-io (function (_ _) (io.io expected)))] (do promise.monad [actual (/.use (/.async capability) [])] - (_.claim [/.async] - (n.= expected actual))))) + (_.cover' [/.async] + (n.= expected actual))))) ))))) diff --git a/stdlib/source/test/lux/control/security/policy.lux b/stdlib/source/test/lux/control/security/policy.lux index 13ad42f3f..6206206e3 100644 --- a/stdlib/source/test/lux/control/security/policy.lux +++ b/stdlib/source/test/lux/control/security/policy.lux @@ -78,8 +78,8 @@ raw-password (random.ascii 10) #let [password (:: policy-0 password raw-password)]] ($_ _.and - (_.with-cover [/.Privacy /.Private - /.Can-Conceal /.Can-Reveal] + (_.with-cover [/.Privacy /.Private /.Can-Conceal /.Can-Reveal + /.Safety /.Safe /.Can-Trust /.Can-Distrust] ($_ _.and (_.with-cover [/.functor] ($functor.spec (..injection (:: policy-0 can-upgrade)) (..comparison (:: policy-0 can-downgrade)) /.functor)) diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index 531326d92..9798625d5 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -10,7 +10,7 @@ ["$." codec]]}] [control pipe - ["E" try] + ["." try] ["p" parser ["</>" xml]]] [data @@ -23,7 +23,7 @@ ["." dictionary] ["." list ("#\." functor)]]] [math - ["r" random (#+ Random) ("#\." monad)]]] + ["." random (#+ Random) ("#\." monad)]]] {1 ["." / (#+ XML)]}) @@ -35,81 +35,61 @@ (def: char (Random Nat) - (do {! r.monad} - [idx (|> r.nat (:: ! map (n.% (text.size char-range))))] + (do {! random.monad} + [idx (|> random.nat (:: ! map (n.% (text.size char-range))))] (wrap (maybe.assume (text.nth idx char-range))))) (def: (size bottom top) (-> Nat Nat (Random Nat)) (let [constraint (|>> (n.% top) (n.max bottom))] - (r\map constraint r.nat))) + (random\map constraint random.nat))) (def: (text bottom top) (-> Nat Nat (Random Text)) - (do r.monad + (do random.monad [size (..size bottom top)] - (r.text ..char size))) + (random.text ..char size))) -(def: xml-identifier^ +(def: identifier (Random Name) - (r.and (..text 0 10) - (..text 1 10))) + (random.and (..text 0 10) + (..text 1 10))) (def: #export xml (Random XML) - (r.rec (function (_ xml) - (r.or (..text 1 10) - (do r.monad - [size (..size 0 2)] - ($_ r.and - xml-identifier^ - (r.dictionary name.hash size xml-identifier^ (..text 0 10)) - (r.list size xml))))))) + (random.rec (function (_ xml) + (random.or (..text 1 10) + (do random.monad + [size (..size 0 2)] + ($_ random.and + ..identifier + (random.dictionary name.hash size ..identifier (..text 0 10)) + (random.list size xml))))))) (def: #export test Test - (<| (_.context (%.name (name-of /.XML))) + (<| (_.covering /._) + (_.with-cover [/.XML]) ($_ _.and - ($equivalence.spec /.equivalence ..xml) - ($codec.spec /.equivalence /.codec ..xml) + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence ..xml)) + (_.with-cover [/.codec] + ($codec.spec /.equivalence /.codec ..xml)) - (do {! r.monad} - [text (..text 1 10) - num-children (|> r.nat (:: ! map (n.% 5))) - children (r.list num-children (..text 1 10)) - tag xml-identifier^ - attribute xml-identifier^ - value (..text 1 10) - #let [node (#/.Node tag - (dictionary.put attribute value /.attrs) - (list\map (|>> #/.Text) children))]] - ($_ _.and - (_.test "Can parse text." - (E.default #0 - (do E.monad - [output (</>.run </>.text - (#/.Text text))] - (wrap (text\= text output))))) - (_.test "Can parse attributes." - (E.default #0 - (do E.monad - [output (</>.run (p.before </>.ignore - (</>.attribute attribute)) - node)] - (wrap (text\= value output))))) - (_.test "Can parse nodes." - (E.default #0 - (do E.monad - [_ (</>.run (p.before </>.ignore - (</>.node tag)) - node)] - (wrap #1)))) - (_.test "Can parse children." - (E.default #0 - (do E.monad - [outputs (</>.run (</>.children (p.some </>.text)) node)] - (wrap (:: (list.equivalence text.equivalence) = - children - outputs))))) - )) + (do {! random.monad} + [(^@ identifier [namespace name]) ..identifier] + (`` ($_ _.and + (~~ (template [<type> <format>] + [(_.cover [<type> <format>] + (and (text\= name (<format> ["" name])) + (let [identifier (<format> identifier)] + (and (text.starts-with? namespace identifier) + (text.ends-with? name identifier)))))] + + [/.Tag /.tag] + [/.Attribute /.attribute] + )) + (_.cover [/.Attrs /.attributes] + (dictionary.empty? /.attributes)) + ))) ))) diff --git a/stdlib/source/test/lux/math/infix.lux b/stdlib/source/test/lux/math/infix.lux index 87f1c9d57..aeba020d5 100644 --- a/stdlib/source/test/lux/math/infix.lux +++ b/stdlib/source/test/lux/math/infix.lux @@ -20,7 +20,7 @@ [subject r.nat parameter r.nat extra r.nat - angle r.frac] + angle r.safe-frac] ($_ _.and (_.test "Constant values don't change." (n.= subject diff --git a/stdlib/source/test/lux/world/environment.lux b/stdlib/source/test/lux/world/environment.lux index 2ab284132..28bcfc377 100644 --- a/stdlib/source/test/lux/world/environment.lux +++ b/stdlib/source/test/lux/world/environment.lux @@ -24,8 +24,8 @@ [_ (wrap [])] (wrap (do promise.monad [environment (promise.future /.read)] - (_.claim [/.read] - (and (not (dictionary.empty? environment)) - (|> environment - dictionary.keys - (list.every? (|>> text.empty? not)))))))))) + (_.cover' [/.read] + (and (not (dictionary.empty? environment)) + (|> environment + dictionary.keys + (list.every? (|>> text.empty? not)))))))))) diff --git a/stdlib/source/test/lux/world/shell.lux b/stdlib/source/test/lux/world/shell.lux index dd37f63ba..b7848cba4 100644 --- a/stdlib/source/test/lux/world/shell.lux +++ b/stdlib/source/test/lux/world/shell.lux @@ -138,6 +138,6 @@ wrote! destroyed! (i.= exit await))))] - (_.claim [/.async /.Can-Write] - (try.default false verdict))))) + (_.cover' [/.async /.Can-Write] + (try.default false verdict))))) ))) |