aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/aedifex.lux4
-rw-r--r--stdlib/source/test/aedifex/cache.lux36
-rw-r--r--stdlib/source/test/aedifex/command/build.lux61
-rw-r--r--stdlib/source/test/aedifex/command/clean.lux4
-rw-r--r--stdlib/source/test/aedifex/command/deploy.lux4
-rw-r--r--stdlib/source/test/aedifex/command/deps.lux4
-rw-r--r--stdlib/source/test/aedifex/command/install.lux16
-rw-r--r--stdlib/source/test/aedifex/command/pom.lux16
-rw-r--r--stdlib/source/test/aedifex/command/test.lux94
-rw-r--r--stdlib/source/test/aedifex/dependency/resolution.lux76
-rw-r--r--stdlib/source/test/aedifex/input.lux4
-rw-r--r--stdlib/source/test/lux/control/concurrency/actor.lux74
-rw-r--r--stdlib/source/test/lux/control/concurrency/frp.lux64
-rw-r--r--stdlib/source/test/lux/control/concurrency/promise.lux96
-rw-r--r--stdlib/source/test/lux/control/concurrency/semaphore.lux70
-rw-r--r--stdlib/source/test/lux/control/concurrency/stm.lux34
-rw-r--r--stdlib/source/test/lux/control/concurrency/thread.lux8
-rw-r--r--stdlib/source/test/lux/control/security/capability.lux4
-rw-r--r--stdlib/source/test/lux/control/security/policy.lux4
-rw-r--r--stdlib/source/test/lux/data/format/xml.lux100
-rw-r--r--stdlib/source/test/lux/math/infix.lux2
-rw-r--r--stdlib/source/test/lux/world/environment.lux10
-rw-r--r--stdlib/source/test/lux/world/shell.lux4
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)))))
)))