diff options
Diffstat (limited to 'stdlib/source/test')
| -rw-r--r-- | stdlib/source/test/lux/control/concurrency/actor.lux | 54 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/concurrency/frp.lux | 21 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/collection.lux | 2 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/collection/array.lux | 24 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/collection/set/multi.lux | 216 | ||||
| -rw-r--r-- | stdlib/source/test/lux/target/jvm.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world/console.lux | 43 |
8 files changed, 346 insertions, 22 deletions
diff --git a/stdlib/source/test/lux/control/concurrency/actor.lux b/stdlib/source/test/lux/control/concurrency/actor.lux index 1b1a01242..7ab561360 100644 --- a/stdlib/source/test/lux/control/concurrency/actor.lux +++ b/stdlib/source/test/lux/control/concurrency/actor.lux @@ -11,13 +11,18 @@ [number ["n" nat]] [text - ["%" format (#+ format)]]] + ["%" format (#+ format)]] + [collection + ["." list] + ["." row (#+ Row)]]] [math ["." random]]] {1 ["." / (#+ actor: message:) [// - ["." promise (#+ Promise Resolver) ("#@." monad)]]]}) + ["." atom (#+ Atom)] + ["." promise (#+ Promise Resolver) ("#@." monad)] + ["." frp]]]}) (exception: got-wrecked) @@ -43,7 +48,7 @@ (def: #export test Test - (do random.monad + (do {! random.monad} [initial-state random.nat #let [as-mail (: (All [a] (-> (-> a a) (/.Mail a))) (function (_ transform) @@ -189,4 +194,47 @@ false)))))] (_.claim [/.actor] verdict))) + (do ! + [num-events (:: ! map (|>> (n.% 10) inc) random.nat) + events (random.list num-events random.nat) + num-observations (:: ! map (n.% num-events) random.nat) + #let [expected (list.take num-observations events) + sink (: (Atom (Row Nat)) + (atom.atom row.empty)) + [signal signal!] (: [(Promise Any) (Resolver Any)] + (promise.promise []))]] + (wrap (do promise.monad + [agent (promise.future + (do {! io.monad} + [agent (/.actor {Nat 0}) + _ (/.observe (function (_ event stop) + (function (_ events-seen self) + (promise.future + (cond (n.< num-observations events-seen) + (do ! + [_ (atom.update (row.add event) sink)] + (wrap (#try.Success (inc events-seen)))) + + (n.= num-observations events-seen) + (do ! + [_ stop + _ (signal! [])] + (wrap (#try.Success (inc events-seen)))) + + (wrap (#try.Failure "YOLO")))))) + (frp.sequential 0 events) + agent)] + (wrap agent))) + _ signal + actual (promise.future (atom.read sink)) + died? (promise.time-out 1,000 (/.await agent)) + #let [died? (case died? + (#.Some _) + true + + #.None + false)]] + (_.claim [/.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 43198ff5b..e7d418bf7 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -16,7 +16,7 @@ [number ["n" nat]] [collection - ["." list ("#@." functor fold)] + ["." list ("#@." functor fold monoid)] ["." row (#+ Row)]]] [math ["." random]]] @@ -124,18 +124,23 @@ (wrap (do {! promise.monad} [#let [sink (: (Atom (Row Nat)) (atom.atom row.empty)) - channel (/.sequential 0 inputs)] - _ (promise.future (/.listen (function (_ value) - (do io.monad - [_ (atom.update (row.add value) sink)] - (wrap []))) - channel)) + channel (/.sequential 0 (list@compose inputs inputs))] + _ (promise.future (/.subscribe (function (_ value) + (do {! io.monad} + [current (atom.read sink)] + (if (n.< (list.size inputs) + (row.size current)) + (do ! + [_ (atom.update (row.add value) sink)] + (wrap (#.Some []))) + (wrap (#.Some []))))) + channel)) output (/.consume channel) listened (|> sink atom.read promise.future (:: ! map row.to-list))] - (_.claim [/.listen] + (_.claim [/.Subscriber /.subscribe] (and (list@= inputs output) (list@= output diff --git a/stdlib/source/test/lux/data/collection.lux b/stdlib/source/test/lux/data/collection.lux index 82643dfde..497123614 100644 --- a/stdlib/source/test/lux/data/collection.lux +++ b/stdlib/source/test/lux/data/collection.lux @@ -14,6 +14,7 @@ ["#." queue ["#/." priority]] ["#." set + ["#/." multi] ["#/." ordered]] ["#." tree ["#/." zipper]]]) @@ -37,6 +38,7 @@ Test ($_ _.and /set.test + /set/multi.test /set/ordered.test )) diff --git a/stdlib/source/test/lux/data/collection/array.lux b/stdlib/source/test/lux/data/collection/array.lux index e09e502bc..7a5e686ac 100644 --- a/stdlib/source/test/lux/data/collection/array.lux +++ b/stdlib/source/test/lux/data/collection/array.lux @@ -31,6 +31,21 @@ (:: random.monad map (|>> (n.% 100) (n.+ 1)) random.nat)) +(def: structures + Test + (do {! random.monad} + [size ..bounded-size] + ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec (/.equivalence n.equivalence) (random.array size random.nat))) + (_.with-cover [/.monoid] + ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.array size random.nat))) + (_.with-cover [/.functor] + ($functor.spec ..injection /.equivalence /.functor)) + (_.with-cover [/.fold] + ($fold.spec ..injection /.equivalence /.fold)) + ))) + (def: #export test Test (<| (_.covering /._) @@ -43,14 +58,7 @@ #let [expected (n.+ base shift)] the-array (random.array size random.nat)] ($_ _.and - (_.with-cover [/.equivalence] - ($equivalence.spec (/.equivalence n.equivalence) (random.array size random.nat))) - (_.with-cover [/.monoid] - ($monoid.spec (/.equivalence n.equivalence) /.monoid (random.array size random.nat))) - (_.with-cover [/.functor] - ($functor.spec ..injection /.equivalence /.functor)) - (_.with-cover [/.fold] - ($fold.spec ..injection /.equivalence /.fold)) + ..structures (_.cover [/.new /.size] (n.= size (/.size (: (Array Nat) diff --git a/stdlib/source/test/lux/data/collection/set/multi.lux b/stdlib/source/test/lux/data/collection/set/multi.lux new file mode 100644 index 000000000..039f67200 --- /dev/null +++ b/stdlib/source/test/lux/data/collection/set/multi.lux @@ -0,0 +1,216 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [hash (#+ Hash)] + [monad (#+ do)] + ["." predicate] + {[0 #spec] + [/ + ["$." equivalence]]}] + [data + ["." bit ("#@." equivalence)] + [number + ["n" nat]] + [collection + ["." set] + ["." list ("#@." fold)]]] + [math + ["." random (#+ Random)]]] + {1 + ["." /]}) + +(def: count + (Random Nat) + (:: random.monad map (|>> (n.% 10) inc) random.nat)) + +(def: #export (random size hash count element) + (All [a] (-> Nat (Hash a) (Random Nat) (Random a) (Random (/.Set a)))) + (do {! random.monad} + [elements (random.set hash size element) + element-counts (random.list size ..count)] + (wrap (list@fold (function (_ [count element] set) + (/.add count element set)) + (/.new hash) + (list.zip/2 element-counts + (set.to-list elements)))))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Set]) + (do {! random.monad} + [diversity (:: ! map (n.% 10) random.nat) + sample (..random diversity n.hash ..count random.nat) + non-member (random.filter (predicate.complement (set.member? (/.support sample))) + random.nat) + addition-count ..count + partial-removal-count (:: ! map (n.% addition-count) random.nat) + another (..random diversity n.hash ..count random.nat)] + (`` ($_ _.and + (_.with-cover [/.equivalence] + ($equivalence.spec /.equivalence (..random diversity n.hash ..count random.nat))) + + (_.cover [/.to-list /.from-list] + (|> sample + /.to-list + (/.from-list n.hash) + (:: /.equivalence = sample))) + (_.cover [/.size] + (n.= (list.size (/.to-list sample)) + (/.size sample))) + (_.cover [/.empty?] + (bit@= (/.empty? sample) + (n.= 0 (/.size sample)))) + (_.cover [/.new] + (/.empty? (/.new n.hash))) + (_.cover [/.support] + (list.every? (set.member? (/.support sample)) + (/.to-list sample))) + (_.cover [/.member?] + (let [non-member-is-not-identified! + (not (/.member? sample non-member)) + + all-members-are-identified! + (list.every? (/.member? sample) + (/.to-list sample))] + (and non-member-is-not-identified! + all-members-are-identified!))) + (_.cover [/.multiplicity] + (let [non-members-have-0-multiplicity! + (n.= 0 (/.multiplicity sample non-member)) + + every-member-has-positive-multiplicity! + (list.every? (|>> (/.multiplicity sample) (n.> 0)) + (/.to-list sample))] + (and non-members-have-0-multiplicity! + every-member-has-positive-multiplicity!))) + (_.cover [/.add] + (let [null-scenario! + (|> sample + (/.add 0 non-member) + (:: /.equivalence = sample)) + + normal-scenario! + (let [sample+ (/.add addition-count non-member sample)] + (and (not (/.member? sample non-member)) + (/.member? sample+ non-member) + (n.= addition-count (/.multiplicity sample+ non-member))))] + (and null-scenario! + normal-scenario!))) + (_.cover [/.remove] + (let [null-scenario! + (:: /.equivalence = + (|> sample + (/.add addition-count non-member)) + (|> sample + (/.add addition-count non-member) + (/.remove 0 non-member))) + + partial-scenario! + (let [sample* (|> sample + (/.add addition-count non-member) + (/.remove partial-removal-count non-member))] + (and (/.member? sample* non-member) + (n.= (n.- partial-removal-count + addition-count) + (/.multiplicity sample* non-member)))) + + total-scenario! + (|> sample + (/.add addition-count non-member) + (/.remove addition-count non-member) + (:: /.equivalence = sample))] + (and null-scenario! + partial-scenario! + total-scenario!))) + (_.cover [/.from-set] + (let [unary (|> sample /.support /.from-set)] + (list.every? (|>> (/.multiplicity unary) (n.= 1)) + (/.to-list unary)))) + (_.cover [/.sub?] + (let [unary (|> sample /.support /.from-set)] + (and (/.sub? sample unary) + (or (not (/.sub? unary sample)) + (:: /.equivalence = sample unary))))) + (_.cover [/.super?] + (let [unary (|> sample /.support /.from-set)] + (and (/.super? unary sample) + (or (not (/.super? sample unary)) + (:: /.equivalence = sample unary))))) + (~~ (template [<name> <composition>] + [(_.cover [<name>] + (let [|sample| (/.support sample) + |another| (/.support another) + sample-only (set.difference |another| |sample|) + another-only (set.difference |sample| |another|) + common (set.intersection |sample| |another|) + composed (<name> sample another) + + no-left-changes! (list.every? (function (_ member) + (n.= (/.multiplicity sample member) + (/.multiplicity composed member))) + (set.to-list sample-only)) + no-right-changes! (list.every? (function (_ member) + (n.= (/.multiplicity another member) + (/.multiplicity composed member))) + (set.to-list another-only)) + common-changes! (list.every? (function (_ member) + (n.= (<composition> (/.multiplicity sample member) + (/.multiplicity another member)) + (/.multiplicity composed member))) + (set.to-list common))] + (and no-left-changes! + no-right-changes! + common-changes!)))] + + [/.sum n.+] + [/.union n.max] + )) + (_.cover [/.intersection] + (let [|sample| (/.support sample) + |another| (/.support another) + sample-only (set.difference |another| |sample|) + another-only (set.difference |sample| |another|) + common (set.intersection |sample| |another|) + composed (/.intersection sample another) + + left-removals! (list.every? (|>> (/.member? composed) not) + (set.to-list sample-only)) + right-removals! (list.every? (|>> (/.member? composed) not) + (set.to-list another-only)) + common-changes! (list.every? (function (_ member) + (n.= (n.min (/.multiplicity sample member) + (/.multiplicity another member)) + (/.multiplicity composed member))) + (set.to-list common))] + (and left-removals! + right-removals! + common-changes!))) + (_.cover [/.difference] + (let [|sample| (/.support sample) + |another| (/.support another) + sample-only (set.difference |another| |sample|) + another-only (set.difference |sample| |another|) + common (set.intersection |sample| |another|) + composed (/.difference sample another) + + ommissions! (list.every? (|>> (/.member? composed) not) + (set.to-list sample-only)) + intact! (list.every? (function (_ member) + (n.= (/.multiplicity another member) + (/.multiplicity composed member))) + (set.to-list another-only)) + subtractions! (list.every? (function (_ member) + (let [sample-multiplicity (/.multiplicity sample member) + another-multiplicity (/.multiplicity another member)] + (n.= (if (n.> another-multiplicity sample-multiplicity) + 0 + (n.- sample-multiplicity + another-multiplicity)) + (/.multiplicity composed member)))) + (set.to-list common))] + (and ommissions! + intact! + subtractions!))) + ))))) diff --git a/stdlib/source/test/lux/target/jvm.lux b/stdlib/source/test/lux/target/jvm.lux index 3a98b5380..2fbfc92b9 100644 --- a/stdlib/source/test/lux/target/jvm.lux +++ b/stdlib/source/test/lux/target/jvm.lux @@ -1010,11 +1010,11 @@ (function (_ expected) (|>> (:coerce Text) (text@= (:coerce Text expected)))))) (<| (_.context "multi") (do {! random.monad} - [#let [size (:: ! map (|>> (n.% 10) (n.+ 1)) + [#let [size (:: ! map (|>> (n.% 5) (n.+ 1)) random.nat)] dimensions size sizesH size - sizesT (monad.seq ! (list.repeat (dec dimensions) size)) + sizesT (random.list (dec dimensions) size) #let [type (loop [dimensions dimensions type (: (Type Object) ..$Object)] diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux index c5b0ecc59..a01bdb929 100644 --- a/stdlib/source/test/lux/world.lux +++ b/stdlib/source/test/lux/world.lux @@ -3,11 +3,13 @@ ["_" test (#+ Test)]] ["." / #_ ["#." file] - ["#." shell]]) + ["#." shell] + ["#." console]]) (def: #export test Test ($_ _.and /file.test /shell.test + /console.test )) diff --git a/stdlib/source/test/lux/world/console.lux b/stdlib/source/test/lux/world/console.lux new file mode 100644 index 000000000..d17559cec --- /dev/null +++ b/stdlib/source/test/lux/world/console.lux @@ -0,0 +1,43 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try (#+ Try)] + ["." exception (#+ exception:)]]] + {1 + ["." /]} + {[1 #spec] + ["$." /]}) + +(exception: dead) + +(def: simulation + (/.Simulation Bit) + (structure + (def: (on-read dead?) + (if dead? + (exception.throw ..dead []) + (#try.Success [dead? (char "a")]))) + + (def: (on-read-line dead?) + (if dead? + (exception.throw ..dead []) + (#try.Success [dead? "YOLO"]))) + + (def: (on-write message dead?) + (if dead? + (exception.throw ..dead []) + (#try.Success dead?))) + + (def: (on-close dead?) + (if dead? + (exception.throw ..dead []) + (#try.Success true))))) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.mock /.Simulation] + ($/.spec (/.mock ..simulation false))))) |