From 1790c10bd359c90ac62be2553b4c4ec49002eff9 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Sun, 31 Dec 2017 23:52:25 -0400 Subject: - Added region-based resource management. --- stdlib/test/test/lux/control/region.lux | 100 ++++++++++++++++++++++++++++++++ stdlib/test/tests.lux | 3 +- 2 files changed, 102 insertions(+), 1 deletion(-) create mode 100644 stdlib/test/test/lux/control/region.lux (limited to 'stdlib/test') 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 [ ] + [(def: ( result) + (All [a] (-> (Error a) Bool)) + (case result + (#e.Success _) + (#e.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 + [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 @) + [_ (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 + [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 @) + [_ (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 + [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 @) + [_ (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 + [clean-up-counter (thread.box +0) + #let [@@ @] + outcome (/.run @ + (do (/.Monad @) + [_ (/.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] -- cgit v1.2.3