aboutsummaryrefslogtreecommitdiff
path: root/stdlib/test
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/test/test/lux/concurrency/actor.lux99
-rw-r--r--stdlib/test/test/lux/concurrency/atom.lux38
-rw-r--r--stdlib/test/test/lux/concurrency/frp.lux163
-rw-r--r--stdlib/test/test/lux/concurrency/promise.lux91
-rw-r--r--stdlib/test/test/lux/concurrency/stm.lux110
-rw-r--r--stdlib/test/tests.lux51
6 files changed, 375 insertions, 177 deletions
diff --git a/stdlib/test/test/lux/concurrency/actor.lux b/stdlib/test/test/lux/concurrency/actor.lux
index 718ce080a..ff1d831b6 100644
--- a/stdlib/test/test/lux/concurrency/actor.lux
+++ b/stdlib/test/test/lux/concurrency/actor.lux
@@ -1,3 +1,8 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+## If a copy of the MPL was not distributed with this file,
+## You can obtain one at http://mozilla.org/MPL/2.0/.
+
(;module:
lux
(lux (control monad)
@@ -5,7 +10,7 @@
text/format
error)
(concurrency [promise #+ Promise Monad<Promise> "Promise/" Monad<Promise>]
- actor)
+ ["&" actor #+ actor:])
(codata function
[io #- run]))
lux/test)
@@ -23,48 +28,60 @@
(log! (format "Current state: " (%i *state*)))
(wrap []))))
-(test: "lux/concurrency/actor exports"
- (let [counter-proc (: (Proc Int (Promise Int))
+(test: "Actors"
+ (let [counter-proc (: (&;Proc Int (Promise Int))
[(lambda [self output state]
(let [state' (i.inc state)]
(exec (io;run (promise;resolve state' output))
(Promise/wrap (#;Right state')))))
(lambda [?error state] (Promise/wrap []))])]
- (test-all (match true
- (let [counter (: (Actor Int (Promise Int))
- (io;run (spawn 0 counter-proc)))]
- (alive? counter)))
- (match [true false]
- (let [counter (: (Actor Int (Promise Int))
- (io;run (spawn 0 counter-proc)))]
- [(io;run (poison counter))
- (alive? counter)]))
- (match [true false]
- (let [counter (: (Actor Int (Promise Int))
- (io;run (spawn 0 counter-proc)))]
- [(io;run (poison counter))
- (io;run (poison counter))]))
- (match+ [1 2 3]
- (do Monad<Promise>
- [#let [counter (: (Actor Int (Promise Int))
- (io;run (spawn 0 counter-proc)))
- output-1 (: (Promise Int) (promise;promise))
- output-2 (: (Promise Int) (promise;promise))
- output-3 (: (Promise Int) (promise;promise))]
- ?1 (send output-1 counter)
- ?2 (send output-2 counter)
- ?3 (send output-3 counter)]
- (if (and ?1 ?2 ?3)
- (from-promise ($_ promise;seq output-1 output-2 output-3))
- (wrap (#;Left "Uh, oh...")))))
- (match+ [[0 1] [1 3] [3 6]]
- (do Monad<Promise>
- [#let [adder (: Adder
- (io;run (spawn 0 Adder//new)))]
- t1 (add! 1 adder)
- t2 (add! 2 adder)
- t3 (add! 3 adder)
- #let [? (io;run (poison adder))]]
- (wrap (#;Right [t1 t2 t3]))
- ))
- )))
+ ($_ seq
+ (assert "Can check where an actor is alive."
+ (let [counter (: (&;Actor Int (Promise Int))
+ (io;run (&;spawn 0 counter-proc)))]
+ (&;alive? counter)))
+
+ (assert "Can poison/kill actors."
+ (let [counter (: (&;Actor Int (Promise Int))
+ (io;run (&;spawn 0 counter-proc)))]
+ (and (io;run (&;poison counter))
+ (not (&;alive? counter)))))
+
+ (assert "Can't poison an already poisoned actor."
+ (let [counter (: (&;Actor Int (Promise Int))
+ (io;run (&;spawn 0 counter-proc)))]
+ (and (io;run (&;poison counter))
+ (not (io;run (&;poison counter))))))
+
+ (do Monad<Promise>
+ [#let [counter (: (&;Actor Int (Promise Int))
+ (io;run (&;spawn 0 counter-proc)))
+ output-1 (: (Promise Int) (promise;promise))
+ output-2 (: (Promise Int) (promise;promise))
+ output-3 (: (Promise Int) (promise;promise))]
+ _ (&;send output-1 counter)
+ _ (&;send output-2 counter)
+ _ (&;send output-3 counter)
+ =1 output-1
+ =2 output-2
+ =3 output-3]
+ (assert "Can send messages to actors."
+ (and (i.= 1 =1)
+ (i.= 2 =2)
+ (i.= 3 =3))))
+
+ (do Monad<Promise>
+ [#let [adder (: Adder
+ (io;run (&;spawn 0 Adder//new)))]
+ t1 (add! 1 adder)
+ t2 (add! 2 adder)
+ t3 (add! 3 adder)
+ #let [_ (io;run (&;poison adder))]]
+ (assert "Can use custom-defined actors."
+ (case [t1 t2 t3]
+ [[0 1] [1 3] [3 6]]
+ true
+
+ _
+ false)))
+ )))
diff --git a/stdlib/test/test/lux/concurrency/atom.lux b/stdlib/test/test/lux/concurrency/atom.lux
new file mode 100644
index 000000000..6e92e364d
--- /dev/null
+++ b/stdlib/test/test/lux/concurrency/atom.lux
@@ -0,0 +1,38 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+## If a copy of the MPL was not distributed with this file,
+## You can obtain one at http://mozilla.org/MPL/2.0/.
+
+(;module:
+ lux
+ (lux (codata [io])
+ (control monad)
+ (data [number]
+ (struct [list "" Functor<List>])
+ text/format)
+ (concurrency ["&" atom])
+ (math ["R" random])
+ pipe)
+ lux/test)
+
+(test: "Atoms"
+ [value R;nat
+ swap-value R;nat
+ set-value R;nat
+ #let [box (&;atom value)]]
+ ($_ seq
+ (assert "Can obtain the value of an atom."
+ (n.= value (io;run (&;get box))))
+
+ (assert "Can swap the value of an atom."
+ (and (io;run (&;compare-and-swap value swap-value box))
+ (n.= swap-value (io;run (&;get box)))))
+
+ (assert "Can update the value of an atom."
+ (exec (io;run (&;update n.inc box))
+ (n.= (n.inc swap-value) (io;run (&;get box)))))
+
+ (assert "Can immediately set the value of an atom."
+ (exec (io;run (&;set set-value box))
+ (n.= set-value (io;run (&;get box)))))
+ ))
diff --git a/stdlib/test/test/lux/concurrency/frp.lux b/stdlib/test/test/lux/concurrency/frp.lux
index b163aaa3f..65d38b9c2 100644
--- a/stdlib/test/test/lux/concurrency/frp.lux
+++ b/stdlib/test/test/lux/concurrency/frp.lux
@@ -1,3 +1,8 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+## If a copy of the MPL was not distributed with this file,
+## You can obtain one at http://mozilla.org/MPL/2.0/.
+
(;module:
lux
(lux (control monad)
@@ -5,50 +10,122 @@
text/format
error)
(concurrency [promise #+ Promise Monad<Promise> "Promise/" Monad<Promise>]
- frp)
+ ["&" frp])
(codata function
- io))
+ [io #- run]))
lux/test)
(def: (List->Chan values)
- (-> (List Int) (Chan Int))
- (let [_chan (: (Chan Int) (chan))]
- (run (do Monad<IO>
- [_ (mapM Monad<IO>
- (lambda [value]
- (write value _chan))
- values)
- _ (close _chan)]
- (wrap _chan)))))
-
-(test: "lux/concurrency/frp exports"
- (test-all (match+ (^ (list 0 1 2 3 4 5))
- (from-promise (consume (List->Chan (list 0 1 2 3 4 5)))))
- (match+ (^ (list 0 1 2 3 4 5))
- (from-promise (consume (let [input (List->Chan (list 0 1 2 3 4 5))
- output (: (Chan Int) (chan))]
- (exec (pipe input output)
- output)))))
- (match+ (^ (list 0 2 4))
- (from-promise (consume (filter even? (List->Chan (list 0 1 2 3 4 5))))))
- (match+ (^ (list 0 1 2 3 4 5 0 -1 -2 -3 -4 -5))
- (from-promise (consume (merge (list (List->Chan (list 0 1 2 3 4 5))
- (List->Chan (list 0 -1 -2 -3 -4 -5)))))))
- (match+ 15 (from-promise (fold (lambda [base input] (Promise/wrap (i.+ input base))) 0 (List->Chan (list 0 1 2 3 4 5)))))
- (match+ (^ (list 0 1 2 3 4 5))
- (from-promise (consume (no-dups number;Eq<Int> (List->Chan (list 0 0 0 1 2 2 3 3 3 3 4 4 4 5 5))))))
- (match+ (^ (list 12345))
- (from-promise (consume (as-chan (:: promise;Monad<Promise> wrap 12345)))))
- (match+ (^ (list 1 2 3 4 5 6))
- (from-promise (consume (:: Functor<Chan> map i.inc (List->Chan (list 0 1 2 3 4 5))))))
- (match+ (^ (list 12345))
- (from-promise (consume (:: Applicative<Chan> wrap 12345))))
- (match+ (^ (list 12346))
- (from-promise (consume (let [(^open) Applicative<Chan>]
- (apply (wrap i.inc) (wrap 12345))))))
- (match+ (^ (list 12346))
- (from-promise (consume (do Monad<Chan>
- [f (wrap i.inc)
- a (wrap 12345)]
- (wrap (f a))))))
- ))
+ (-> (List Int) (&;Chan Int))
+ (let [_chan (: (&;Chan Int) (&;chan))]
+ (io;run (do Monad<IO>
+ [_ (mapM @ (lambda [value] (&;write value _chan))
+ values)
+ _ (&;close _chan)]
+ (wrap _chan)))))
+
+(test: "FRP"
+ ($_ seq
+ (do Monad<Promise>
+ [elems (&;consume (List->Chan (list 0 1 2 3 4 5)))]
+ (assert "Can consume a chan into a list."
+ (case elems
+ (^ (list 0 1 2 3 4 5))
+ true
+
+ _
+ false)))
+
+ (do Monad<Promise>
+ [elems (&;consume (let [input (List->Chan (list 0 1 2 3 4 5))
+ output (: (&;Chan Int) (&;chan))]
+ (exec (&;pipe input output)
+ output)))]
+ (assert "Can pipe one channel into another."
+ (case elems
+ (^ (list 0 1 2 3 4 5))
+ true
+
+ _
+ false)))
+
+ (do Monad<Promise>
+ [elems (&;consume (&;filter i.even? (List->Chan (list 0 1 2 3 4 5))))]
+ (assert "Can filter a channel's elements."
+ (case elems
+ (^ (list 0 2 4))
+ true
+
+ _
+ false)))
+
+ (do Monad<Promise>
+ [elems (&;consume (&;merge (list (List->Chan (list 0 1 2 3 4 5))
+ (List->Chan (list 0 -1 -2 -3 -4 -5)))))]
+ (assert "Can merge channels."
+ (case elems
+ (^ (list 0 1 2 3 4 5 0 -1 -2 -3 -4 -5))
+ true
+
+ _
+ false)))
+
+ (do Monad<Promise>
+ [output (&;fold (lambda [base input] (Promise/wrap (i.+ input base))) 0 (List->Chan (list 0 1 2 3 4 5)))]
+ (assert "Can fold over a channel."
+ (i.= 15 output)))
+
+ (do Monad<Promise>
+ [elems (&;consume (&;no-dups number;Eq<Int> (List->Chan (list 0 0 0 1 2 2 3 3 3 3 4 4 4 5 5))))]
+ (assert "Can avoid immediate repetition in the channel."
+ (case elems
+ (^ (list 0 1 2 3 4 5))
+ true
+
+ _
+ false)))
+
+ (do Monad<Promise>
+ [elems (&;consume (&;as-chan (:: promise;Monad<Promise> wrap 12345)))]
+ (assert "Can convert a promise into a single-value channel."
+ (case elems
+ (^ (list 12345))
+ true
+
+ _
+ false)))
+
+ (do Monad<Promise>
+ [elems (&;consume (:: &;Functor<Chan> map i.inc (List->Chan (list 0 1 2 3 4 5))))]
+ (assert "Functor goes over every element in a channel."
+ (case elems
+ (^ (list 1 2 3 4 5 6))
+ true
+
+ _
+ false)))
+
+ (do Monad<Promise>
+ [elems (&;consume (let [(^open) &;Applicative<Chan>]
+ (apply (wrap i.inc) (wrap 12345))))]
+ (assert "Applicative works over all channel values."
+ (case elems
+ (^ (list 12346))
+ true
+
+ _
+ false)))
+
+ (do Monad<Promise>
+ [elems (&;consume (do &;Monad<Chan>
+ [f (wrap i.inc)
+ a (wrap 12345)]
+ (wrap (f a))))]
+ (assert "Monad works over all channel values."
+ (case elems
+ (^ (list 12346))
+ true
+
+ _
+ false)))
+ ))
diff --git a/stdlib/test/test/lux/concurrency/promise.lux b/stdlib/test/test/lux/concurrency/promise.lux
index 77e5a0aed..c8e8acad7 100644
--- a/stdlib/test/test/lux/concurrency/promise.lux
+++ b/stdlib/test/test/lux/concurrency/promise.lux
@@ -1,31 +1,78 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+## If a copy of the MPL was not distributed with this file,
+## You can obtain one at http://mozilla.org/MPL/2.0/.
+
(;module:
lux
(lux (control monad)
(data [number]
text/format
error)
- (concurrency promise)
+ (concurrency ["&" promise])
(codata function
- [io #*]))
+ [io #- run])
+ (math ["R" random])
+ pipe)
lux/test)
-(test: "lux/concurrency/promise exports"
- (test-all (match+ true (from-promise (future (io true))))
- (match+ [] (from-promise (wait +500)))
- (match+ [true false] (from-promise (seq (future (io true))
- (future (io false)))))
- (match+ (#;Left true) (from-promise (alt (delay +100 true)
- (delay +200 false))))
- (match+ (#;Right false) (from-promise (alt (delay +200 true)
- (delay +100 false))))
- (match+ true (from-promise (either (delay +100 true)
- (delay +200 false))))
- (match+ false (from-promise (either (delay +200 true)
- (delay +100 false))))
- (match (#;Some true) (poll (:: Monad<Promise> wrap true)))
- (match #;None (poll (delay +200 true)))
- (match false (io;run (resolve false (:: Monad<Promise> wrap true))))
- (match true (io;run (resolve true (: (Promise Bool) (promise)))))
- (match+ #;None (from-promise (time-out +100 (delay +200 true))))
- (match+ (#;Some true) (from-promise (time-out +200 (delay +100 true))))
- ))
+(test: "Promises"
+ ($_ seq
+ (do &;Monad<Promise>
+ [running? (&;future (io true))]
+ (assert "Can run IO actions in separate threads."
+ running?))
+
+ (do &;Monad<Promise>
+ [_ (&;wait +500)]
+ (assert "Can wait for a specified amount of time."
+ true))
+
+ (do &;Monad<Promise>
+ [[left right] (&;seq (&;future (io true))
+ (&;future (io false)))]
+ (assert "Can combine promises sequentially."
+ (and left (not right))))
+
+ (do &;Monad<Promise>
+ [?left (&;alt (&;delay +100 true)
+ (&;delay +200 false))
+ ?right (&;alt (&;delay +200 true)
+ (&;delay +100 false))]
+ (assert "Can combine promises alternatively."
+ (case [?left ?right]
+ [(#;Left true) (#;Right false)]
+ true
+
+ _
+ false)))
+
+ (do &;Monad<Promise>
+ [?left (&;either (&;delay +100 true)
+ (&;delay +200 false))
+ ?right (&;either (&;delay +200 true)
+ (&;delay +100 false))]
+ (assert "Can combine promises alternatively [Part 2]."
+ (and ?left (not ?right))))
+
+ (assert "Can poll a promise for its value."
+ (and (|> (&;poll (:: &;Monad<Promise> wrap true))
+ (case> (#;Some true) true _ false))
+ (|> (&;poll (&;delay +200 true))
+ (case> #;None true _ false))))
+
+ (assert "Cant re-resolve a resolved promise."
+ (and (not (io;run (&;resolve false (:: &;Monad<Promise> wrap true))))
+ (io;run (&;resolve true (: (&;Promise Bool) (&;promise))))))
+
+ (do &;Monad<Promise>
+ [?none (&;time-out +100 (&;delay +200 true))
+ ?some (&;time-out +200 (&;delay +100 true))]
+ (assert "Can establish maximum waiting times for promises to be fulfilled."
+ (case [?none ?some]
+ [#;None (#;Some true)]
+ true
+
+ _
+ false)))
+ ))
diff --git a/stdlib/test/test/lux/concurrency/stm.lux b/stdlib/test/test/lux/concurrency/stm.lux
index da3c10dca..71c82dfab 100644
--- a/stdlib/test/test/lux/concurrency/stm.lux
+++ b/stdlib/test/test/lux/concurrency/stm.lux
@@ -1,3 +1,8 @@
+## Copyright (c) Eduardo Julian. All rights reserved.
+## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0.
+## If a copy of the MPL was not distributed with this file,
+## You can obtain one at http://mozilla.org/MPL/2.0/.
+
(;module:
lux
(lux (codata [io])
@@ -5,53 +10,74 @@
(data [number]
(struct [list "" Functor<List>])
text/format)
- (concurrency stm
+ (concurrency ["&" stm]
[promise])
- (codata function))
+ (codata function)
+ (math ["R" random])
+ pipe)
lux/test)
(def: vars Int 5)
(def: processes/vars Int 5)
(def: iterations/processes Int 100)
-(test: "lux/concurrency/stm exports"
- (let [_var (var 0)
- changes (io;run (follow "test" _var))
- tests (: (List (Test Int))
+(test: "STM"
+ (let [_var (&;var 0)
+ changes (io;run (&;follow "test" _var))
+ tests (: (List Test)
(map (lambda [_]
- (let [_concurrency-var (var 0)]
- (from-promise (do promise;Monad<Promise>
- [_ (seqM @
- (map (lambda [_]
- (mapM @ (lambda [_] (commit (update i.inc _concurrency-var)))
- (list;range 1 iterations/processes)))
- (list;range 1 processes/vars)))]
- (commit (read _concurrency-var))))))
- (list;range 1 vars)))]
- (test-all (match+ 0 (commit (do Monad<STM>
- [value (read _var)]
- (wrap (#;Right value)))))
- (match+ 5 (commit (do Monad<STM>
- [_ (write 5 _var)
- value (read _var)]
- (wrap (#;Right value)))))
- (match+ 5 (commit (do Monad<STM>
- [value (read _var)]
- (wrap (#;Right value)))))
- (match+ 15 (commit (do Monad<STM>
- [_ (update (i.* 3) _var)
- value (read _var)]
- (wrap (#;Right value)))))
- (match+ 15 (commit (do Monad<STM>
- [value (read _var)]
- (wrap (#;Right value)))))
- (match+ [5 15] (do promise;Monad<Promise>
- [?c1+changes' changes
- #let [[c1 changes'] (default [-1 changes] ?c1+changes')]
- ?c2+changes' changes'
- #let [[c2 changes'] (default [-1 changes] ?c2+changes')]]
- (wrap (#;Right [c1 c2]))))
- ## Temporarily commented-out due to type-checking bug in
- ## compiler...
- ## (match+ _ (seqM Monad<Test> tests))
- )))
+ (let [_concurrency-var (&;var 0)]
+ (do promise;Monad<Promise>
+ [_ (seqM @
+ (map (lambda [_]
+ (mapM @ (lambda [_] (&;commit (&;update i.inc _concurrency-var)))
+ (list;i.range 1 iterations/processes)))
+ (list;i.range 1 processes/vars)))
+ _ (&;commit (&;read _concurrency-var))]
+ (assert "" true))))
+ (list;i.range 1 vars)))]
+ ($_ seq
+ (do promise;Monad<Promise>
+ [output (&;commit (do &;Monad<STM>
+ [value (&;read _var)]
+ (wrap value)))]
+ (assert "" (i.= 0 output)))
+
+ (do promise;Monad<Promise>
+ [output (&;commit (do &;Monad<STM>
+ [_ (&;write 5 _var)
+ value (&;read _var)]
+ (wrap value)))]
+ (assert "" (i.= 5 output)))
+
+ (do promise;Monad<Promise>
+ [output (&;commit (do &;Monad<STM>
+ [value (&;read _var)]
+ (wrap value)))]
+ (assert "" (i.= 5 output)))
+
+ (do promise;Monad<Promise>
+ [output (&;commit (do &;Monad<STM>
+ [_ (&;update (i.* 3) _var)
+ value (&;read _var)]
+ (wrap value)))]
+ (assert "" (i.= 15 output)))
+
+ (do promise;Monad<Promise>
+ [output (&;commit (do &;Monad<STM>
+ [value (&;read _var)]
+ (wrap value)))]
+ (assert "" (i.= 15 output)))
+
+ (do promise;Monad<Promise>
+ [?c1+changes' changes
+ #let [[c1 changes'] (default [-1 changes] ?c1+changes')]
+ ?c2+changes' changes'
+ #let [[c2 changes'] (default [-1 changes] ?c2+changes')]]
+ (assert ""
+ (and (i.= 5 c1)
+ (i.= 15 c2))))
+ ## Temporarily commented-out due to type-checking bug in
+ ## compiler...
+ ## (match+ _ (seqM Monad<Test> tests))
+ )))
diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux
index 2a373a872..7b2e05f01 100644
--- a/stdlib/test/tests.lux
+++ b/stdlib/test/tests.lux
@@ -17,6 +17,11 @@
[env]
[state]
(struct [stream]))
+ (concurrency [actor]
+ ["_;" atom]
+ [frp]
+ ["_;" promise]
+ [stm])
(data [bit]
[bool]
[char]
@@ -39,18 +44,12 @@
[stack]
[tree]
[vector]
- [zipper]
- )
- (text [format])
- )
+ [zipper])
+ (text [format]))
+
## (macro [ast]
## [syntax])
## [type]
- ## (concurrency ["_;" promise]
- ## [frp]
- ## [stm]
- ## [actor]
- ## )
## [math]
## [pipe]
## [lexer]
@@ -58,27 +57,21 @@
## (data (format [json]))
)
)
- ## (lux ## (codata [cont])
- ## ## (data (struct [stack]
- ## ## [tree]
- ## ## [zipper])
- ## ## (error exception))
- ## ## (concurrency [atom])
- ## ## [macro]
- ## ## (macro [template]
- ## ## [poly]
- ## ## (poly ["poly_;" eq]
- ## ## ["poly_;" text-encoder]
- ## ## ["poly_;" functor]))
- ## ## (math [ratio]
- ## ## [complex]
- ## ## [random])
- ## ## (type [check] [auto])
- ## ## (control [effect])
+ ## (lux (codata [cont])
+ ## (concurrency [atom])
+ ## [macro]
+ ## (macro [template]
+ ## [poly]
+ ## (poly ["poly_;" eq]
+ ## ["poly_;" text-encoder]
+ ## ["poly_;" functor]))
+ ## (math [ratio]
+ ## [complex]
+ ## [random])
+ ## (type [check] [auto])
+ ## (control [effect])
## ["_;" lexer]
- ## ["_;" regex]
- ## (data (format ["_;" json]))
- ## )
+ ## ["_;" regex])
)
## [Program]