diff options
author | Eduardo Julian | 2022-08-26 14:46:05 -0400 |
---|---|---|
committer | Eduardo Julian | 2022-08-26 14:46:05 -0400 |
commit | c9940d292035e3de89ea6e49628136e79436d409 (patch) | |
tree | 5445e9f016ea1743712643bef92bd9d996b109b2 /stdlib/source/test | |
parent | 3f010de748ffccf304c4be09863f77d4020d610d (diff) |
Added support for behavioral programming.
Diffstat (limited to 'stdlib/source/test')
-rw-r--r-- | stdlib/source/test/lux/control.lux | 4 | ||||
-rw-r--r-- | stdlib/source/test/lux/control/concurrency/behavioral.lux | 85 | ||||
-rw-r--r-- | stdlib/source/test/lux/control/function/contract.lux | 16 |
3 files changed, 103 insertions, 2 deletions
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 18ab1d19d..a53c174d5 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -17,7 +17,8 @@ ["[1]/[0]" event] ["[1]/[0]" cps] ["[1]/[0]" incremental] - ["[1]/[0]" structured]] + ["[1]/[0]" structured] + ["[1]/[0]" behavioral]] ["[1][0]" continuation] ["[1][0]" exception] ["[1][0]" function] @@ -52,6 +53,7 @@ /concurrency/cps.test /concurrency/incremental.test /concurrency/structured.test + /concurrency/behavioral.test )) (def security diff --git a/stdlib/source/test/lux/control/concurrency/behavioral.lux b/stdlib/source/test/lux/control/concurrency/behavioral.lux new file mode 100644 index 000000000..6728ad266 --- /dev/null +++ b/stdlib/source/test/lux/control/concurrency/behavioral.lux @@ -0,0 +1,85 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)]] + [control + ["|" pipe] + ["[0]" maybe (.use "[1]#[0]" functor)]] + [math + ["[0]" random (.only Random)] + [number + ["n" nat]]] + [test + ["_" property (.only Test)] + ["[0]" unit]]]] + [\\library + ["[0]" / (.only) + [// + ["[0]" atom (.only Atom)] + ["[0]" async] + ["[0]" frp]]]]) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [expected random.nat + shift (random.only (n.> 0) random.nat)]) + (all _.and + (_.coverage [/.Constructor /.event] + (let [left (is (/.Constructor Nat) + (/.event (|>>))) + right (is (/.Constructor Nat) + (/.event (|>>)))] + (not (same? left right)))) + (_.coverage [/.Event /.event?] + (let [left (is (/.Constructor Nat) + (/.event (|>>))) + right (is (/.Constructor Nat) + (/.event (|>>)))] + (`` (and (,, (with_template [<correct> <incorrect>] + [(|> (<correct> expected) + (/.event? <correct>) + (maybe#each (same? expected)) + (maybe.else false)) + (|> (<correct> expected) + (/.event? <incorrect>) + (|.when + {.#None} true + {.#Some _} false))] + + [left right] + [right left] + )))))) + (in (let [increase (is (/.Constructor Any) + (/.event (|>>))) + decrease (is (/.Constructor Any) + (/.event (|>>))) + counter (is (Atom Nat) + (atom.atom expected)) + [events feed!] (is [(frp.Channel /.Event) (frp.Sink /.Event)] + (frp.channel [])) + scenario/+ (<| (/.scenario events increase expected) + (function (_ _ so_far) + (do async.monad + [[old new] (async.future (atom.update! (n.+ shift) counter))] + (in new)))) + scenario/- (<| (/.scenario events decrease expected) + (function (_ _ so_far) + (do async.monad + [[old new] (async.future (atom.update! (n.- shift) counter))] + (in new))))] + (do async.monad + [_ (async.future (at feed! feed (increase []))) + _ (async.future (at feed! feed (increase []))) + _ (async.future (at feed! feed (decrease []))) + _ (async.future (at feed! close)) + scenario/+ scenario/+ + scenario/- scenario/- + count (async.future (atom.read! counter))] + (unit.coverage [/.scenario] + (and (n.= (all n.+ shift expected) count) + (n.= (all n.+ shift shift expected) scenario/+) + (n.= (all n.+ shift expected) scenario/-)))))) + ))) diff --git a/stdlib/source/test/lux/control/function/contract.lux b/stdlib/source/test/lux/control/function/contract.lux index 44666a08d..e24d6f52f 100644 --- a/stdlib/source/test/lux/control/function/contract.lux +++ b/stdlib/source/test/lux/control/function/contract.lux @@ -21,7 +21,8 @@ Test (<| (_.covering /._) (do [! random.monad] - [expected random.nat]) + [expected random.nat + error_message (random.upper_case 5)]) (all _.and (_.coverage [/.pre /.pre_condition_failed] (when (try (/.pre (n.even? expected) @@ -43,4 +44,17 @@ (and (text.contains? (the exception.#label /.post_condition_failed) error) (not (n.odd? expected))))) + (_.coverage [/.assert!] + (and (when (try (/.assert! error_message true)) + {try.#Success actual} + true + + {try.#Failure error} + false) + (when (try (/.assert! error_message false)) + {try.#Success actual} + false + + {try.#Failure error} + (text.contains? error_message error)))) ))) |