aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
authorEduardo Julian2020-11-05 02:31:55 -0400
committerEduardo Julian2020-11-05 02:31:55 -0400
commit11cc4a67001162d689eb827f755424a07b99fccb (patch)
treea689186bf0bef21056a3ad13e8f06f313a3a6989 /stdlib/source/test
parent8ac980fd3b6d2050edc0e631a00028c1e6c28c73 (diff)
Lightweight machinery for agent-oriented programming.
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/lux/control/concurrency/actor.lux54
-rw-r--r--stdlib/source/test/lux/control/concurrency/frp.lux21
-rw-r--r--stdlib/source/test/lux/data/collection.lux2
-rw-r--r--stdlib/source/test/lux/data/collection/array.lux24
-rw-r--r--stdlib/source/test/lux/data/collection/set/multi.lux216
-rw-r--r--stdlib/source/test/lux/target/jvm.lux4
-rw-r--r--stdlib/source/test/lux/world.lux4
-rw-r--r--stdlib/source/test/lux/world/console.lux43
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)))))