diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/test/test/lux/control/region.lux | 100 | ||||
| -rw-r--r-- | stdlib/test/tests.lux | 3 |
2 files changed, 102 insertions, 1 deletions
diff --git a/stdlib/test/test/lux/control/region.lux b/stdlib/test/test/lux/control/region.lux new file mode 100644 index 000000000..8de498dce --- /dev/null +++ b/stdlib/test/test/lux/control/region.lux @@ -0,0 +1,100 @@ +(.module: + lux + (lux (control [monad #+ do] + ["/" region] + [thread #+ Thread] + ["ex" exception #+ exception:]) + (data ["e" error #+ Error] + (coll [list]) + text/format) + ["r" math/random]) + lux/test) + +(exception: Oops) + +(do-template [<name> <success> <error>] + [(def: (<name> result) + (All [a] (-> (Error a) Bool)) + (case result + (#e.Success _) <success> + (#e.Error _) <error>))] + + [success? true false] + [error? false true] + ) + +(context: "Regions." + (<| (times +100) + (do @ + [expected-clean-ups (|> r.nat (:: @ map (n/% +100)))] + ($_ seq + (test "Clean-up functions are always run when region execution is done." + (thread.run + (do thread.Monad<Thread> + [clean-up-counter (thread.box +0) + #let [@@ @ + count-clean-up (function [value] + (do @ + [_ (thread.update n/inc clean-up-counter)] + (wrap (#e.Success []))))] + outcome (/.run @ + (do (/.Monad<Region> @) + [_ (monad.map @ (/.acquire @@ count-clean-up) + (list.n/range +1 expected-clean-ups))] + (wrap []))) + actual-clean-ups (thread.read clean-up-counter)] + (wrap (and (success? outcome) + (n/= expected-clean-ups + actual-clean-ups)))))) + (test "Can clean-up despite errors." + (thread.run + (do thread.Monad<Thread> + [clean-up-counter (thread.box +0) + #let [@@ @ + count-clean-up (function [value] + (do @ + [_ (thread.update n/inc clean-up-counter)] + (wrap (#e.Success []))))] + outcome (/.run @ + (do (/.Monad<Region> @) + [_ (monad.map @ (/.acquire @@ count-clean-up) + (list.n/range +1 expected-clean-ups)) + _ (/.throw @@ Oops "")] + (wrap []))) + actual-clean-ups (thread.read clean-up-counter)] + (wrap (and (error? outcome) + (n/= expected-clean-ups + actual-clean-ups)))))) + (test "Errors can propagate from the cleaners." + (thread.run + (do thread.Monad<Thread> + [clean-up-counter (thread.box +0) + #let [@@ @ + count-clean-up (function [value] + (do @ + [_ (thread.update n/inc clean-up-counter)] + (wrap (: (Error Unit) (ex.throw Oops "")))))] + outcome (/.run @ + (do (/.Monad<Region> @) + [_ (monad.map @ (/.acquire @@ count-clean-up) + (list.n/range +1 expected-clean-ups))] + (wrap []))) + actual-clean-ups (thread.read clean-up-counter)] + (wrap (and (or (n/= +0 expected-clean-ups) + (error? outcome)) + (n/= expected-clean-ups + actual-clean-ups)))))) + (test "Can lift operations." + (thread.run + (do thread.Monad<Thread> + [clean-up-counter (thread.box +0) + #let [@@ @] + outcome (/.run @ + (do (/.Monad<Region> @) + [_ (/.lift @@ (thread.write expected-clean-ups clean-up-counter))] + (wrap []))) + actual-clean-ups (thread.read clean-up-counter)] + (wrap (and (success? outcome) + (n/= expected-clean-ups + actual-clean-ups)))))) + )))) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 87f9c913d..26a4212cc 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -22,7 +22,8 @@ ["_." writer] ["_." state] ["_." parser] - ["_." thread]) + ["_." thread] + ["_." region]) (data ["_." bit] ["_." bool] ["_." error] |