diff options
| author | Eduardo Julian | 2022-08-18 21:34:21 -0400 |
|---|---|---|
| committer | Eduardo Julian | 2022-08-18 21:34:21 -0400 |
| commit | 81b6e0d7038a99c66456033c8285f740a3b0c719 (patch) | |
| tree | 4d09e45791f19bd40170260502ebc958b07ee1af /stdlib | |
| parent | ecda0d219cf7dc25bd9b0b76815a8880e20232c2 (diff) | |
Added support for Communicating Sequential Processes (CSP).
Diffstat (limited to 'stdlib')
| -rw-r--r-- | stdlib/source/library/lux/control/concurrency/cps.lux | 76 | ||||
| -rw-r--r-- | stdlib/source/test/lux.lux | 2533 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/lux/control/concurrency/cps.lux | 92 | ||||
| -rw-r--r-- | stdlib/source/test/lux/meta/static.lux | 29 |
5 files changed, 1463 insertions, 1271 deletions
diff --git a/stdlib/source/library/lux/control/concurrency/cps.lux b/stdlib/source/library/lux/control/concurrency/cps.lux new file mode 100644 index 000000000..f8cd41a77 --- /dev/null +++ b/stdlib/source/library/lux/control/concurrency/cps.lux @@ -0,0 +1,76 @@ +(.require + [library + [lux (.except try) + [abstract + [functor (.only Functor)] + [monad (.only Monad do)]] + [control + ["[0]" try (.only Try) (.use "[1]#[0]" monad)] + ["[0]" exception (.only Exception)]]]] + [// + ["[0]" async (.only Async) (.use "[1]#[0]" monad)] + ["[0]" frp]]) + +(type .public (Process a) + (Async (Try a))) + +(type .public Channel' frp.Channel') +(type .public Channel frp.Channel) +(type .public Sink frp.Sink) + +(def .public channel + (All (_ a) (-> Any [(Channel a) (Sink a)])) + frp.channel) + +(def .public functor + (Functor Process) + (implementation + (def (each $) + (async#each (try#each $))))) + +(def .public monad + (Monad Process) + (implementation + (def functor ..functor) + (def in (|>> try#in async#in)) + (def (conjoint atatx) + (do async.monad + [tatx atatx] + (when tatx + {try.#Success atx} + atx + + {try.#Failure error} + (in {try.#Failure error})))))) + +(exception.def .public channel_has_been_closed) + +(def .public (read it) + (All (_ r w) + (-> (Channel' r w) (Process [r (Channel' r w)]))) + (let [[output resolver] (async.async [])] + (exec + (async.future + (async.upon! (function (_ head,tail) + (resolver (when head,tail + {.#Some [head tail]} + {try.#Success [head tail]} + + {.#None} + (exception.except ..channel_has_been_closed [])))) + it)) + output))) + +(def .public (write value sink) + (All (_ w) + (-> w (Sink w) (Process Any))) + (async.future (at sink feed value))) + +(def .public (close sink) + (All (_ w) + (-> (Sink w) (Process Any))) + (async.future (at sink close))) + +(def .public try + (All (_ a) (-> (Process a) (Process (Try a)))) + (async#each (|>> {try.#Success}))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 46ef4d8b0..fb2df3a0c 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -6,1279 +6,1272 @@ [monad (.only do)]] [control ["[0]" io] - ... ["[0]" maybe (.use "[1]#[0]" functor)] - ... [concurrency - ... ["[0]" atom (.only Atom)]] - ] - ... [data - ... ["[0]" product] - ... ["[0]" bit (.use "[1]#[0]" equivalence)] - ... ["[0]" text (.use "[1]#[0]" equivalence) - ... ["%" \\format (.only format)]] - ... [collection - ... ["[0]" set (.only Set) (.use "[1]#[0]" equivalence)] - ... ["[0]" list (.use "[1]#[0]" functor) - ... ["[0]" property]]]] - ... ["[0]" math - ... ["[0]" random (.use "[1]#[0]" functor)] - ... [number - ... [i8 (.only)] - ... [i16 (.only)] - ... ["n" nat] - ... ["i" int] - ... ["r" rev] - ... ["f" frac] - ... ["[0]" i64]]] - ... ["[0]" meta (.use "[1]#[0]" monad) - ... ["@" target] - ... ["[0]" static] - ... ["[0]" location (.use "[1]#[0]" equivalence)] - ... ["[0]" code (.use "[1]#[0]" equivalence) - ... ["<[1]>" \\parser]] - ... ["[0]" macro (.only) - ... [syntax (.only syntax)] - ... ["^" pattern] - ... ["[0]" template]]] - ... [test - ... ["_" property (.only Test)]] - ]] + ["[0]" maybe (.use "[1]#[0]" functor)] + [concurrency + ["[0]" atom (.only Atom)]]] + [data + ["[0]" product] + ["[0]" bit (.use "[1]#[0]" equivalence)] + ["[0]" text (.use "[1]#[0]" equivalence) + ["%" \\format (.only format)]] + [collection + ["[0]" set (.only Set) (.use "[1]#[0]" equivalence)] + ["[0]" list (.use "[1]#[0]" functor) + ["[0]" property]]]] + ["[0]" math + ["[0]" random (.use "[1]#[0]" functor)] + [number + [i8 (.only)] + [i16 (.only)] + ["n" nat] + ["i" int] + ["r" rev] + ["f" frac] + ["[0]" i64]]] + ["[0]" meta (.use "[1]#[0]" monad) + ["@" target] + ["[0]" static] + ["[0]" location (.use "[1]#[0]" equivalence)] + ["[0]" code (.use "[1]#[0]" equivalence) + ["<[1]>" \\parser]] + ["[0]" macro (.only) + [syntax (.only syntax)] + ["^" pattern] + ["[0]" template]]] + [test + ["_" property (.only Test)]]]] ... TODO: Must have 100% coverage on tests. - ... ["[0]" / - ... ["[1][0]" abstract] - ... ["[1][0]" control] - ... ["[1][0]" data] - ... ["[1][0]" debug] - - ... ["[1][0]" documentation] - ... ["[1][0]" math] - - ... ["[1][0]" meta] - ... ["[1][0]" program] - ... ["[1][0]" test/property] - - ... ["[1][0]" world] - - ... ["[1][0]" ffi]] + ["[0]" / + ["[1][0]" abstract] + ["[1][0]" control] + ["[1][0]" data] + ["[1][0]" debug] + + ["[1][0]" documentation] + ["[1][0]" math] + + ["[1][0]" meta] + ["[1][0]" program] + ["[1][0]" test/property] + + ["[1][0]" world] + + ["[1][0]" ffi]] ) -... (def for_bit -... Test -... (do random.monad -... [expected random.nat -... dummy random.nat] -... (_.for [/.Bit /.if] -... (all _.and -... (_.coverage [/.false] -... (n.= expected -... (/.if /.false -... dummy -... expected))) -... (_.coverage [/.true] -... (n.= expected -... (/.if /.true -... expected -... dummy))) -... (_.coverage [/.or] -... (and (not (/.or /.false /.false)) -... (/.or /.false /.true) -... (/.or /.true /.false) -... (/.or /.true /.true))) -... (_.coverage [/.and] -... (and (not (/.and /.false /.false)) -... (not (/.and /.false /.true)) -... (not (/.and /.true /.false)) -... (/.and /.true /.true))) -... (_.coverage [/.not] -... (and (bit#= /.true (/.not /.false)) -... (bit#= /.false (/.not /.true)))) -... (_.coverage [/.cond] -... (and (n.= expected -... (/.cond /.true -... expected - -... ... else -... dummy)) -... (n.= expected -... (/.cond /.false -... dummy - -... ... else -... expected)) -... (n.= expected -... (/.cond /.true -... expected - -... /.false -... dummy - -... ... else -... dummy)) -... (n.= expected -... (/.cond /.false -... dummy - -... /.true -... expected - -... ... else -... dummy)))) -... )))) - -... (def for_try -... Test -... (do random.monad -... [expected_error (random.lower_case 5) -... expected random.nat] -... (all _.and -... (_.coverage [/.try] -... (when (/.try expected) -... {.#Left _} -... false - -... {.#Right actual} -... (n.= expected actual))) -... (_.coverage [/.undefined] -... (when (/.try (/.undefined)) -... {.#Left _} -... true - -... {.#Right _} -... false)) -... (_.coverage [/.panic!] -... (when (/.try (/.panic! expected_error)) -... {.#Left actual_error} -... (text.contains? expected_error actual_error) - -... {.#Right _} -... false)) -... ))) - -... (def for_list -... Test -... (do random.monad -... [e/0 random.nat -... e/1 random.nat -... e/2 random.nat -... e/3 random.nat] -... (all _.and -... (_.coverage [/.list] -... (when (/.list e/0 e/1) -... (/.list a/0 a/1) -... (and (n.= e/0 a/0) -... (n.= e/1 a/1)) - -... _ -... false)) -... ))) - -... (type (Returner a) -... (/.Interface -... (is (-> Any a) -... return))) - -... (def (global_returner value) -... (All (_ a) (-> a (Returner a))) -... (/.implementation -... (def (return _) -... value))) - -... (def static_return 123) - -... (/.use "global#[0]" (..global_returner ..static_return)) - -... (def for_interface -... Test -... (do random.monad -... [expected random.nat -... .let [local_returner (is (Returner Nat) -... (/.implementation -... (def (return _) -... expected)))]] -... (_.for [/.Interface] -... (all _.and -... (_.coverage [/.implementation] -... (n.= expected (at local_returner return []))) -... (_.coverage [/.use] -... (n.= static_return (global#return []))) -... (_.coverage [/.open] -... (let [(/.open "local#[0]") local_returner] -... (n.= expected (local#return [])))) -... (_.coverage [/.at] -... (n.= expected (/.at local_returner return []))) -... )))) - -... (def for_module -... Test -... (all _.and -... (let [[module short] (/.symbol .example)] -... (_.coverage [/.symbol /.prelude] -... (and (text#= /.prelude module) -... (text#= short "example")))) -... (let [[module short] (/.symbol ..example)] -... (_.coverage [/.module_separator] -... (and (text.contains? /.module_separator module) -... (not (text.contains? /.module_separator short))))) -... )) - -... (def for_pipe -... Test -... (do random.monad -... [start random.nat -... factor random.nat -... .let [expected (n.* factor (++ start))]] -... (all _.and -... (_.coverage [/.|>] -... (n.= expected -... (/.|> start ++ (n.* factor)))) -... (_.coverage [/.|>>] -... (n.= expected -... ((/.|>> ++ (n.* factor)) start))) -... (_.coverage [/.<|] -... (n.= expected -... (/.<| (n.* factor) ++ start))) -... (_.coverage [/.<<|] -... (n.= expected -... ((/.<<| (n.* factor) ++) start))) -... ))) - -... (def example_symbol "YOLO") -... (def i8 8) - -... (def current_module -... Text -... (let [[module _] (symbol .._)] -... module)) - -... (def for_code/' -... Test -... (do random.monad -... [example_nat random.nat] -... (_.coverage [/.' /.literal_quote] -... (and (code#= (code.nat 0) (/.' 0)) -... (code#= (code.int -1) (/.' -1)) -... (code#= (code.rev .2) (/.' .2)) -... (code#= (code.frac +3.4) (/.' +3.4)) -... (code#= (code.text "5") (/.' "5")) -... (code#= (code.symbol ["" "example_symbol"]) -... (/.' example_symbol)) -... (code#= (code.symbol [/.prelude "example_symbol"]) -... (/.' .example_symbol)) -... (code#= (code.symbol [..current_module "example_symbol"]) -... (/.' ..example_symbol)) -... (code#= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) -... (/.' (6 +7 .8))) -... (code#= (code.variant (list (code.frac +9.0) -... (code.text "9") -... (code.symbol ["" "i8"]))) -... (/.' {+9.0 "9" i8})) -... (code#= (code.tuple (list (code.frac +9.0) -... (code.text "9") -... (code.symbol ["" "i8"]))) -... (/.' [+9.0 "9" i8])) -... )))) - -... (def for_code/` -... Test -... (do random.monad -... [example_nat random.nat] -... (_.coverage [/.` /.syntax_quote] -... (and (code#= (code.nat 0) (/.` 0)) -... (code#= (code.int -1) (/.` -1)) -... (code#= (code.rev .2) (/.` .2)) -... (code#= (code.frac +3.4) (/.` +3.4)) -... (code#= (code.text "5") (/.` "5")) -... (code#= (code.symbol [..current_module "example_symbol"]) -... (/.` example_symbol)) -... (code#= (code.symbol [/.prelude "example_symbol"]) -... (/.` .example_symbol)) -... (code#= (code.symbol [..current_module "example_symbol"]) -... (/.` ..example_symbol)) -... (code#= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) -... (/.` (6 +7 .8))) -... (code#= (code.variant (list (code.frac +9.0) -... (code.text "9") -... (code.symbol [..current_module "i8"]))) -... (/.` {+9.0 "9" i8})) -... (code#= (code.tuple (list (code.frac +9.0) -... (code.text "9") -... (code.symbol [..current_module "i8"]))) -... (/.` [+9.0 "9" i8])) -... )))) - -... (def for_code/`' -... Test -... (do random.monad -... [example_nat random.nat] -... (_.coverage [/.`' /.partial_quote] -... (and (code#= (code.nat 0) (/.`' 0)) -... (code#= (code.int -1) (/.`' -1)) -... (code#= (code.rev .2) (/.`' .2)) -... (code#= (code.frac +3.4) (/.`' +3.4)) -... (code#= (code.text "5") (/.`' "5")) -... (code#= (code.symbol ["" "example_symbol"]) -... (/.`' example_symbol)) -... (code#= (code.symbol [/.prelude "example_symbol"]) -... (/.`' .example_symbol)) -... (code#= (code.symbol [..current_module "example_symbol"]) -... (/.`' ..example_symbol)) -... (code#= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) -... (/.`' (6 +7 .8))) -... (code#= (code.variant (list (code.frac +9.0) -... (code.text "9") -... (code.symbol ["" "i8"]))) -... (/.`' {+9.0 "9" i8})) -... (code#= (code.tuple (list (code.frac +9.0) -... (code.text "9") -... (code.symbol ["" "i8"]))) -... (/.`' [+9.0 "9" i8])) -... )))) - -... (def for_code -... Test -... (do [! random.monad] -... [example (at ! each code.nat random.nat) -... example_bit random.bit -... example_nat random.nat -... example_int random.int] -... (all _.and -... (_.for [/.Code /.Code'] -... (all _.and -... ..for_code/' -... ..for_code/` -... ..for_code/`' -... )) -... (_.coverage [/.Ann] -... (|> example -... (the /.#meta) -... (location#= location.dummy))) -... (_.for [/.UnQuote] -... (all _.and -... (_.coverage [/.unquote_macro] -... (exec -... (is /.Macro' -... (/.unquote_macro /.,)) -... (is /.Macro' -... (/.unquote_macro /.,')) -... true)) -... (_.coverage [/.unquote] -... (exec -... (is /.UnQuote -... (/.unquote ("lux macro" (/.unquote_macro /.,)))) -... (is /.UnQuote -... (/.unquote ("lux macro" (/.unquote_macro /.,')))) -... true)) -... (_.coverage [/., /.but] -... (with_expansions [<nat> (code.nat example_nat)] -... (and (not (code#= <nat> -... (/.' (/., <nat>)))) -... (code#= <nat> -... (/.` (/., <nat>))) -... (code#= <nat> -... (/.`' (/., <nat>)))))) -... (_.coverage [/.,* /.also] -... (with_expansions [<bit> (code.bit example_bit) -... <nat> (code.nat example_nat) -... <int> (code.int example_int) -... <expected> (code.tuple (list <bit> <nat> <int>)) -... <actual> [(/.,* (list <bit> <nat> <int>))]] -... (and (not (code#= <expected> -... (/.' <actual>))) -... (code#= <expected> -... (/.` <actual>)) -... (code#= <expected> -... (/.`' <actual>))))) -... (_.coverage [/.,' /.literally] -... (with_expansions [<bit> (code.bit example_bit) -... <nat> (code.nat example_nat) -... <int> (code.int example_int) -... <expected> (/.' [(list <bit> <nat> <int>)]) -... <actual> [(/.,' (list <bit> <nat> <int>))]] -... (and (not (code#= <expected> -... (/.' <actual>))) -... (code#= <expected> -... (/.` <actual>)) -... (code#= <expected> -... (/.`' <actual>))))) -... )) -... ))) - -... (def identity_macro -... (/.macro (_ tokens) -... (at meta.monad in tokens))) - -... (def crosshair -... "This is an arbitrary text whose only purpose is to be found, somewhere, in the source-code.") - -... (def found_crosshair? -... (macro (_ tokens lux) -... (let [[_ _ source_code] (the .#source lux)] -... {.#Right [lux (list (code.bit (text.contains? ..crosshair source_code)))]}))) - -... (def for_macro -... Test -... (let [macro (is /.Macro' -... (function (_ tokens lux) -... {.#Right [lux (list)]}))] -... (do random.monad -... [expected random.nat] -... (`` (`` (all _.and -... (_.coverage [/.Macro'] -... (|> macro -... (is /.Macro') -... (same? macro))) -... (_.coverage [/.Macro] -... (|> macro -... "lux macro" -... (is /.Macro) -... (is Any) -... (same? (is Any macro)))) -... (_.coverage [/.macro] -... (same? expected (..identity_macro expected))) -... (,, (for @.old (,, (these)) -... (_.coverage [/.Source] -... (..found_crosshair?)))) -... ... (_.coverage [/.require] -... ... (`` (with_expansions [<referral> ("lux in-module" "library/lux" library/lux.refer) -... ... <alias> (static.random code.text (random.lower_case 1)) -... ... <definition> (static.random code.local (random.lower_case 1)) -... ... <module/0> (static.random code.text (random.lower_case 2)) -... ... <module/0>' (template.symbol [<module/0>]) -... ... <module/1> (static.random code.text (random.lower_case 3)) -... ... <module/1>' (template.symbol [<module/1>]) -... ... <module/2> (static.random code.text (random.lower_case 4)) -... ... <module/2>' (template.symbol [<module/2>]) -... ... <m0/1> (template.text [<module/0> "/" <module/1>]) -... ... <//> (template.text [// <module/2>']) -... ... <//>' (template.symbol [<//>]) -... ... <\\> (template.text [\\ <module/2>']) -... ... <\\>' (template.symbol [<\\>]) -... ... <m0/2> (template.text [<module/0> "/" <module/2>]) -... ... <m2/1> (template.text [<module/2> "/" <module/1>]) -... ... <m0/1/2> (template.text [<module/0> "/" <module/1> "/" <module/2>]) -... ... <open/0> (template.text [<module/0> "#[0]"])] -... ... (and (,, (with_template [<input> <module> <referrals>] -... ... [(with_expansions [<input>' (macro.final <input>)] -... ... (let [scenario (is (-> Any Bit) -... ... (function (_ _) -... ... ... TODO: Remove this hack once Jython is no longer being used as the Python interpreter. -... ... (`` (for @.python (when (' [<input>']) -... ... (^.` [<module> -... ... ("lux def" (, [_ {.#Symbol ["" _]}]) [] #0) -... ... (,, (template.spliced <referrals>))]) -... ... true - -... ... _ -... ... false) -... ... (when (' [<input>']) -... ... (^.` [<module> (,, (template.spliced <referrals>))]) -... ... true - -... ... _ -... ... false)))))] -... ... (scenario [])))] - -... ... [(.require [<module/0>']) -... ... ("lux def module" []) -... ... []] - -... ... [(.require [<alias> <module/0>' (.except)]) -... ... ("lux def module" [[<module/0> <alias>]]) -... ... [(<referral> <module/0> (.except))]] - -... ... [(.require [<alias> <module/0>' (.only <definition>)]) -... ... ("lux def module" [[<module/0> <alias>]]) -... ... [(<referral> <module/0> (.only <definition>))]] - -... ... [(.require [<alias> <module/0>' (.except <definition>)]) -... ... ("lux def module" [[<module/0> <alias>]]) -... ... [(<referral> <module/0> (.except <definition>))]] - -... ... [(.require [<alias> <module/0>']) -... ... ("lux def module" []) -... ... []] - -... ... [(.require [<module/0>' -... ... [<alias> <module/1>']]) -... ... ("lux def module" [[<m0/1> <alias>]]) -... ... [(<referral> <m0/1>)]] - -... ... [(.require ["[0]" <module/0>' -... ... ["[0]" <module/1>']]) -... ... ("lux def module" [[<module/0> <module/0>] -... ... [<m0/1> <module/1>]]) -... ... [(<referral> <module/0>) -... ... (<referral> <m0/1>)]] - -... ... [(.require ["[0]" <module/0>' -... ... ["[1]" <module/1>']]) -... ... ("lux def module" [[<m0/1> <module/0>]]) -... ... [(<referral> <m0/1>)]] - -... ... [(.require ["[0]" <module/0>' -... ... ["[1]" <module/1>' -... ... ["[2]" <module/2>']]]) -... ... ("lux def module" [[<m0/1/2> <module/0>]]) -... ... [(<referral> <m0/1/2>)]] - -... ... [(.require [<module/0>' -... ... ["[0]" <module/1>' -... ... ["[0]" <//>']]]) -... ... ("lux def module" [[<m0/1> <module/1>] -... ... [<m0/2> <//>]]) -... ... [(<referral> <m0/1>) -... ... (<referral> <m0/2>)]] - -... ... [(.require ["[0]" <module/0>' -... ... [<module/1>' -... ... ["[0]" <\\>']]]) -... ... ("lux def module" [[<module/0> <module/0>] -... ... [<m2/1> <\\>]]) -... ... [(<referral> <module/0>) -... ... (<referral> <m2/1>)]] - -... ... [(.require ["[0]" <module/0>' (.use "[1]#[0]" <definition>)]) -... ... ("lux def module" [[<module/0> <module/0>]]) -... ... [(<referral> <module/0> (<open/0> <definition>))]] -... ... )))))) -... )))))) - -... (/.type for_type/variant -... (Variant -... {#Case/0} -... {#Case/1 Nat} -... {#Case/2 Int Text})) - -... (/.type for_type/record -... (Record -... [#slot/0 Bit -... #slot/1 Rev])) - -... (/.type (for_type/all parameter) -... [parameter parameter]) - -... (def for_type -... Test -... (do [! random.monad] -... [expected random.nat - -... expected_left random.nat -... expected_right random.nat - -... .let [existential_type (at ! each (|>> {.#Ex}) random.nat)] -... expected/0 existential_type -... expected/1 existential_type] -... (<| (_.for [/.Type]) -... (all _.and -... (_.coverage [/.is] -... (|> expected -... (/.is Any) -... (same? (/.is Any expected)))) -... (_.coverage [/.as] -... (|> expected -... (/.is Any) -... (/.as /.Nat) -... (same? expected))) -... (_.coverage [/.as_expected] -... (|> expected -... (/.is Any) -... /.as_expected -... (/.is /.Nat) -... (same? expected))) -... (_.coverage [/.type_of] -... (same? /.Nat (/.type_of expected))) -... (_.coverage [/.Primitive] -... (when (/.Primitive "foo" [expected/0 expected/1]) -... {.#Primitive "foo" (list actual/0 actual/1)} -... (and (same? expected/0 actual/0) -... (same? expected/1 actual/1)) - -... _ -... false)) -... (_.coverage [/.type_literal] -... (and (when (/.type_literal [expected/0 expected/1]) -... {.#Product actual/0 actual/1} -... (and (same? expected/0 actual/0) -... (same? expected/1 actual/1)) - -... _ -... false) -... (when (/.type_literal (/.Or expected/0 expected/1)) -... {.#Sum actual/0 actual/1} -... (and (same? expected/0 actual/0) -... (same? expected/1 actual/1)) - -... _ -... false) -... (when (/.type_literal (-> expected/0 expected/1)) -... {.#Function actual/0 actual/1} -... (and (same? expected/0 actual/0) -... (same? expected/1 actual/1)) - -... _ -... false) -... (when (/.type_literal (expected/0 expected/1)) -... {.#Apply actual/1 actual/0} -... (and (same? expected/0 actual/0) -... (same? expected/1 actual/1)) - -... _ -... false))) -... (_.coverage [/.type] -... (exec -... (is /.Type ..for_type/variant) -... (is /.Type ..for_type/record) -... (is /.Type ..for_type/all) -... true)) -... (_.coverage [/.Variant] -... (exec -... (is for_type/variant -... {#Case/1 expected_left}) -... true)) -... (_.coverage [/.Record] -... (exec -... (is for_type/record -... [#slot/0 (n.= expected_left expected_right) -... #slot/1 (.rev expected_right)]) -... true)) -... )))) - -... (def for_i64 -... Test -... (do random.monad -... [expected random.i64] -... (all _.and -... (_.coverage [/.i64] -... (same? (is Any expected) -... (is Any (/.i64 expected)))) -... (_.coverage [/.nat] -... (same? (is Any expected) -... (is Any (/.nat expected)))) -... (_.coverage [/.int] -... (same? (is Any expected) -... (is Any (/.int expected)))) -... (_.coverage [/.rev] -... (same? (is Any expected) -... (is Any (/.rev expected)))) -... (_.coverage [/.++] -... (n.= 1 (n.- expected -... (/.++ expected)))) -... (_.coverage [/.--] -... (n.= 1 (n.- (/.-- expected) -... expected))) -... ))) - -... (def for_function -... Test -... (do random.monad -... [expected_left random.nat -... expected_right random.nat] -... (_.coverage [/.-> /.function] -... (and (let [actual (is (/.-> Nat Nat Nat) -... (/.function (_ actual_left actual_right) -... (n.* (++ actual_left) (-- actual_right))))] -... (n.= (n.* (++ expected_left) (-- expected_right)) -... (actual expected_left expected_right))) -... (let [actual (is (/.-> [Nat Nat] Nat) -... (/.function (_ [actual_left actual_right]) -... (n.* (++ actual_left) (-- actual_right))))] -... (n.= (n.* (++ expected_left) (-- expected_right)) -... (actual [expected_left expected_right]))))))) - -... (def !n/+ -... (/.template (_ <left> <right>) -... [(n.+ <left> <right>)])) - -... (def for_template -... Test -... (`` (all _.and -... (_.coverage [/.with_template] -... (let [bits (list (,, (/.with_template [_] -... [true] - -... [0] [1] [2] -... )))] -... (and (n.= 3 (list.size bits)) -... (list.every? (bit#= true) bits)))) -... (do random.monad -... [left random.nat -... right random.nat] -... (_.coverage [/.template] -... (n.= (n.+ left right) -... (!n/+ left right)))) -... ))) - -... (def option/0 "0") -... (def option/1 "1") -... (def static_char "@") - -... (def for_static -... Test -... (do random.monad -... [sample (random.either (in option/0) -... (in option/1))] -... (all _.and -... (_.coverage [/.static] -... (when sample -... (/.static option/0) true -... (/.static option/1) true -... _ false)) -... (_.coverage [/.char] -... (|> (`` (/.char (,, (/.static static_char)))) -... text.of_char -... (text#= static_char))) -... ))) - -... (type Small -... (Record -... [#small_left Nat -... #small_right Text])) - -... (type Big -... (Record -... [#big_left Nat -... #big_right Small])) - -... (def for_slot -... Test -... (do random.monad -... [start/s random.nat -... start/b random.nat -... shift/s random.nat -... shift/b random.nat -... text (random.lower_case 1) -... .let [expected/s (n.+ shift/s start/s) -... expected/b (n.+ shift/b start/b) - -... sample [#big_left start/b -... #big_right [#small_left start/s -... #small_right text]]]] -... (all _.and -... (_.coverage [/.the] -... (and (and (|> sample -... (/.the #big_left) -... (same? start/b)) -... (|> sample -... ((/.the #big_left)) -... (same? start/b))) -... (and (|> sample -... (/.the [#big_right #small_left]) -... (same? start/s)) -... (|> sample -... ((/.the [#big_right #small_left])) -... (same? start/s))))) -... (_.coverage [/.has] -... (and (and (|> sample -... (/.has #big_left shift/b) -... (/.the #big_left) -... (same? shift/b)) -... (|> sample -... ((/.has #big_left shift/b)) -... (/.the #big_left) -... (same? shift/b)) -... (|> sample -... ((/.has #big_left) shift/b) -... (/.the #big_left) -... (same? shift/b))) -... (and (|> sample -... (/.has [#big_right #small_left] shift/s) -... (/.the [#big_right #small_left]) -... (same? shift/s)) -... (|> sample -... ((/.has [#big_right #small_left] shift/s)) -... (/.the [#big_right #small_left]) -... (same? shift/s)) -... (|> sample -... ((/.has [#big_right #small_left]) shift/s) -... (/.the [#big_right #small_left]) -... (same? shift/s))))) -... (_.coverage [/.revised] -... (and (and (|> sample -... (/.revised #big_left (n.+ shift/b)) -... (/.the #big_left) -... (n.= expected/b)) -... (|> sample -... ((/.revised #big_left (n.+ shift/b))) -... (/.the #big_left) -... (n.= expected/b)) -... (|> sample -... ((is (-> (-> Nat Nat) (-> Big Big)) -... (/.revised #big_left)) -... (n.+ shift/b)) -... (/.the #big_left) -... (n.= expected/b))) -... (and (|> sample -... (/.revised [#big_right #small_left] (n.+ shift/s)) -... (/.the [#big_right #small_left]) -... (n.= expected/s)) -... (|> sample -... ((/.revised [#big_right #small_left] (n.+ shift/s))) -... (/.the [#big_right #small_left]) -... (n.= expected/s)) -... (|> sample -... ((is (-> (-> Nat Nat) (-> Big Big)) -... (/.revised [#big_right #small_left])) -... (n.+ shift/s)) -... (/.the [#big_right #small_left]) -... (n.= expected/s))))) -... ))) - -... (def for_associative -... Test -... (do random.monad -... [left (random.lower_case 1) -... mid (random.lower_case 1) -... right (random.lower_case 1) -... .let [expected (text.interposed "" (list left mid right))]] -... (_.coverage [/.all /.left] -... (with_expansions [<left_association> (/.left format -... left -... mid -... right) -... <right_association> (/.all format -... left -... mid -... right)] -... (and (text#= <left_association> -... <right_association>) -... (not (code#= (' <left_association>) -... (' <right_association>)))))))) - -... (def for_expansion -... Test -... (do random.monad -... [left random.nat -... right random.nat -... dummy random.nat -... .let [expected (n.+ left right)]] -... (all _.and -... (_.coverage [/.these] -... (`` (and (,, (these true -... true -... true))))) -... (_.coverage [/.with_expansions] -... (/.with_expansions [<operands> (these left right)] -... (n.= expected -... (n.+ <operands>)))) -... (_.coverage [/.comment] -... (/.with_expansions [<dummy> (/.comment dummy) -... <operands> (these left right)] -... (n.= expected -... (all n.+ <operands> <dummy>)))) -... (_.coverage [/.``] -... (n.= expected -... (/.`` (all n.+ -... (,, (these left right)) -... (,, (/.comment dummy)))))) -... (_.coverage [/.for] -... (and (n.= expected -... (/.for "fake host" dummy -... expected)) -... (n.= expected -... (/.for @.old expected -... @.jvm expected -... @.js expected -... @.python expected -... @.lua expected -... @.ruby expected -... @.php expected -... dummy)))) -... ))) - -... (def for_value -... Test -... (do random.monad -... [left random.nat -... right (random.lower_case 1) - -... item/0 random.nat -... item/1 random.nat -... item/2 random.nat] -... (all _.and -... (_.coverage [/.Either] -... (and (exec -... (is (/.Either Nat Text) -... {.#Left left}) -... true) -... (exec -... (is (/.Either Nat Text) -... {.#Right right}) -... true))) -... (_.coverage [/.Any] -... (and (exec -... (is /.Any -... left) -... true) -... (exec -... (is /.Any -... right) -... true))) -... (_.coverage [/.Nothing] -... (and (exec -... (is (-> /.Any /.Nothing) -... (function (_ _) -... (undefined))) -... true) -... (exec -... (is (-> /.Any /.Int) -... (function (_ _) -... (is /.Int (undefined)))) -... true))) -... (_.for [/.__adjusted_quantified_type__] -... (all _.and -... (_.coverage [/.All] -... (let [identity (is (/.All (_ a) (-> a a)) -... (|>>))] -... (and (exec -... (is Nat -... (identity left)) -... true) -... (exec -... (is Text -... (identity right)) -... true)))) -... (_.coverage [/.Ex] -... (let [hide (is (/.Ex (_ a) (-> Nat a)) -... (|>>))] -... (exec -... (is /.Any -... (hide left)) -... true))))) -... (_.coverage [/.same?] -... (let [not_left (atom.atom left) -... left (atom.atom left)] -... (and (/.same? left left) -... (/.same? not_left not_left) -... (not (/.same? left not_left))))) -... (_.coverage [/.Rec] -... (let [list (is (/.Rec NList -... (Maybe [Nat NList])) -... {.#Some [item/0 -... {.#Some [item/1 -... {.#Some [item/2 -... {.#None}]}]}]})] -... (when list -... {.#Some [actual/0 {.#Some [actual/1 {.#Some [actual/2 {.#None}]}]}]} -... (and (same? item/0 actual/0) -... (same? item/1 actual/1) -... (same? item/2 actual/2)) - -... _ -... false))) -... ))) - -... (type (Pair l r) -... (Record -... [#left l -... #right r])) - -... (def !pair -... (template (_ <left> <right>) -... [[..#left <left> -... ..#right <right>]])) - -... (def for_when -... Test -... (do [! random.monad] -... [expected_nat (at ! each (n.% 1) random.nat) -... expected_int (at ! each (i.% +1) random.int) -... expected_rev (random.either (in .5) -... (in .25)) -... expected_frac (random.either (in +0.5) -... (in +1.25)) -... expected_text (random.either (in "+0.5") -... (in "+1.25"))] -... (all _.and -... (_.coverage [/.when] -... (and (/.when expected_nat -... 0 true -... _ false) -... (/.when expected_int -... +0 true -... _ false) -... (/.when expected_rev -... .5 true -... .25 true -... _ false) -... (/.when expected_frac -... +0.5 true -... +1.25 true -... _ false) -... (/.when expected_text -... "+0.5" true -... "+1.25" true -... _ false) -... (/.when [expected_nat expected_int] -... [0 +0] true -... _ false) -... (/.when [..#left expected_nat ..#right expected_int] -... [..#left 0 ..#right +0] true -... _ false) -... (/.when (is (Either Nat Int) {.#Left expected_nat}) -... {.#Left 0} true -... _ false) -... (/.when (is (Either Nat Int) {.#Right expected_int}) -... {.#Right +0} true -... _ false) -... )) -... ... (_.coverage [/.pattern] -... ... (/.when [..#left expected_nat ..#right expected_int] -... ... (!pair 0 +0) -... ... true - -... ... _ -... ... false)) -... (_.coverage [/.let] -... (and (/.let [actual_nat expected_nat] -... (/.same? expected_nat actual_nat)) -... (/.let [[actual_left actual_right] [..#left expected_nat ..#right expected_int]] -... (and (/.same? expected_nat actual_left) -... (/.same? expected_int actual_right))))) -... ))) - -... (def for_control_flow -... Test -... (all _.and -... (do random.monad -... [factor (random#each (|>> (n.% 10) (n.max 1)) random.nat) -... iterations (random#each (n.% 10) random.nat) -... .let [expected (n.* factor iterations)]] -... (_.coverage [/.loop] -... (n.= expected -... (/.loop (again [counter 0 -... value 0]) -... (if (n.< iterations counter) -... (again (++ counter) (n.+ factor value)) -... value))))) -... (do random.monad -... [pre random.nat -... post (random.only (|>> (n.= pre) not) random.nat) -... .let [box (atom.atom pre)]] -... (_.coverage [/.exec] -... (and (same? pre (io.run! (atom.read! box))) -... (/.exec -... (io.run! (atom.write! post box)) -... (same? post (io.run! (atom.read! box))))))) -... )) - -... (def identity/constant -... (All (_ a) (-> a a)) -... (function (_ value) -... value)) - -... (def (identity/function value) -... (All (_ a) (-> a a)) -... value) - -... (def for_def -... Test -... (do random.monad -... [expected random.nat] -... (_.coverage [/.def] -... (and (same? expected (identity/constant expected)) -... (same? expected (identity/function expected)))))) - -... (def possible_targets -... (Set @.Target) -... (<| (set.of_list text.hash) -... (list @.old -... @.js -... @.jvm -... @.lua -... @.python -... @.ruby))) - -... (def for_meta|Info -... (syntax (_ []) -... (function (_ lux) -... (let [info (the .#info lux) - -... conforming_target! -... (set.member? ..possible_targets (the .#target info)) - -... compiling! -... (when (the .#mode info) -... {.#Build} true -... _ false)] -... {.#Right [lux (list (code.bit (and conforming_target! -... compiling!)))]})))) - -... (def for_meta|Module_State -... (syntax (_ []) -... (do meta.monad -... [prelude (meta.module .prelude)] -... (in (list (code.bit (when (the .#module_state prelude) -... {.#Active} false -... _ true))))))) - -... (def for_meta -... Test -... (all _.and -... (_.coverage [/.Mode /.Info] -... (for_meta|Info)) -... (_.coverage [/.Module_State] -... (for_meta|Module_State)) -... )) - -... (def for_export -... Test -... (all _.and -... (_.coverage [/.public /.private] -... (and /.public (not /.private))) -... (_.coverage [/.global /.local] -... (and (bit#= /.public /.global) -... (bit#= /.private /.local))) -... )) - -... (for @.old (these) -... (these (def for_bindings|test -... (syntax (_ lux_state -... [fn/0 <code>.local -... var/0 <code>.local -... let/0 <code>.local - -... fn/1 <code>.local -... var/1 <code>.local -... let/1 <code>.local - -... fn/2 <code>.local -... var/2 <code>.local -... let/2 <code>.local - -... let/3 <code>.local]) -... (in (list (code.bit (when (the .#scopes lux_state) -... (list.partial scope/2 _) -... (let [locals/2 (the .#locals scope/2) -... expected_locals/2 (set.of_list text.hash (list fn/2 var/2 let/2 -... let/3)) -... actual_locals/2 (|> locals/2 -... (the .#mappings) -... (list#each product.left) -... (set.of_list text.hash)) - -... correct_locals! -... (and (n.= 4 (the .#counter locals/2)) -... (set#= expected_locals/2 -... actual_locals/2)) - -... captured/2 (the .#captured scope/2) - -... local? (is (-> Ref Bit) -... (function (_ ref) -... (when ref -... {.#Local _} true -... {.#Captured _} false))) -... captured? (is (-> Ref Bit) -... (|>> local? not)) -... binding? (is (-> (-> Ref Bit) Text Bit) -... (function (_ is? name) -... (|> captured/2 -... (the .#mappings) -... (property.value name) -... (maybe#each (|>> product.right is?)) -... (maybe.else false)))) - -... correct_closure! -... (and (n.= 6 (the .#counter captured/2)) -... (binding? local? fn/1) -... (binding? local? var/1) -... (binding? local? let/1) -... (binding? captured? fn/0) -... (binding? captured? var/0) -... (binding? captured? let/0))] -... (and correct_locals! -... correct_closure!)) - -... _ -... false)))))) - -... (def for_bindings -... Test -... ((<| (template.with_locals [fn/0 var/0 let/0 -... fn/1 var/1 let/1 -... fn/2 var/2 let/2 -... let/3]) -... (function (fn/0 var/0)) (let [let/0 123]) -... (function (fn/1 var/1)) (let [let/1 456]) -... (function (fn/2 var/2)) (let [let/2 789]) -... (let [let/3 [fn/0 var/0 let/0 -... fn/1 var/1 let/1 -... fn/2 var/2 let/2] -... verdict (for_bindings|test fn/0 var/0 let/0 -... fn/1 var/1 let/1 -... fn/2 var/2 let/2 -... let/3)] -... (_.coverage [/.Bindings /.Ref] -... verdict))) -... 0 1 2)))) - -... (def test|lux -... Test -... (`` (`` (all _.and -... ..for_bit -... ..for_try -... ..for_list -... ..for_interface -... ..for_module -... ..for_pipe -... ..for_code -... ..for_macro -... ..for_type -... ..for_i64 -... ..for_function -... ..for_template -... ..for_static -... ..for_slot -... ..for_associative -... ..for_expansion -... ..for_value -... ..for_when -... ..for_control_flow -... ..for_def -... ..for_meta -... ..for_export -... (,, (for @.old (,, (these)) -... (,, (these ..for_bindings)))) -... )))) - -... (def test -... Test -... (<| (_.covering /._) -... (_.in_parallel -... (list ..test|lux - -... ... /abstract.test -... ... /control.test -... ... /data.test -... ... /debug.test - -... ... /documentation.test -... ... /math.test - -... ... /meta.test -... ... /program.test -... ... /test/property.test - -... ... /world.test - -... ... /ffi.test -... )))) +(def for_bit + Test + (do random.monad + [expected random.nat + dummy random.nat] + (_.for [/.Bit /.if] + (all _.and + (_.coverage [/.false] + (n.= expected + (/.if /.false + dummy + expected))) + (_.coverage [/.true] + (n.= expected + (/.if /.true + expected + dummy))) + (_.coverage [/.or] + (and (not (/.or /.false /.false)) + (/.or /.false /.true) + (/.or /.true /.false) + (/.or /.true /.true))) + (_.coverage [/.and] + (and (not (/.and /.false /.false)) + (not (/.and /.false /.true)) + (not (/.and /.true /.false)) + (/.and /.true /.true))) + (_.coverage [/.not] + (and (bit#= /.true (/.not /.false)) + (bit#= /.false (/.not /.true)))) + (_.coverage [/.cond] + (and (n.= expected + (/.cond /.true + expected + + ... else + dummy)) + (n.= expected + (/.cond /.false + dummy + + ... else + expected)) + (n.= expected + (/.cond /.true + expected + + /.false + dummy + + ... else + dummy)) + (n.= expected + (/.cond /.false + dummy + + /.true + expected + + ... else + dummy)))) + )))) + +(def for_try + Test + (do random.monad + [expected_error (random.lower_case 5) + expected random.nat] + (all _.and + (_.coverage [/.try] + (when (/.try expected) + {.#Left _} + false + + {.#Right actual} + (n.= expected actual))) + (_.coverage [/.undefined] + (when (/.try (/.undefined)) + {.#Left _} + true + + {.#Right _} + false)) + (_.coverage [/.panic!] + (when (/.try (/.panic! expected_error)) + {.#Left actual_error} + (text.contains? expected_error actual_error) + + {.#Right _} + false)) + ))) + +(def for_list + Test + (do random.monad + [e/0 random.nat + e/1 random.nat + e/2 random.nat + e/3 random.nat] + (all _.and + (_.coverage [/.list] + (when (/.list e/0 e/1) + (/.list a/0 a/1) + (and (n.= e/0 a/0) + (n.= e/1 a/1)) + + _ + false)) + ))) + +(type (Returner a) + (/.Interface + (is (-> Any a) + return))) + +(def (global_returner value) + (All (_ a) (-> a (Returner a))) + (/.implementation + (def (return _) + value))) + +(def static_return 123) + +(/.use "global#[0]" (..global_returner ..static_return)) + +(def for_interface + Test + (do random.monad + [expected random.nat + .let [local_returner (is (Returner Nat) + (/.implementation + (def (return _) + expected)))]] + (_.for [/.Interface] + (all _.and + (_.coverage [/.implementation] + (n.= expected (at local_returner return []))) + (_.coverage [/.use] + (n.= static_return (global#return []))) + (_.coverage [/.open] + (let [(/.open "local#[0]") local_returner] + (n.= expected (local#return [])))) + (_.coverage [/.at] + (n.= expected (/.at local_returner return []))) + )))) + +(def for_module + Test + (all _.and + (let [[module short] (/.symbol .example)] + (_.coverage [/.symbol /.prelude] + (and (text#= /.prelude module) + (text#= short "example")))) + (let [[module short] (/.symbol ..example)] + (_.coverage [/.module_separator] + (and (text.contains? /.module_separator module) + (not (text.contains? /.module_separator short))))) + )) + +(def for_pipe + Test + (do random.monad + [start random.nat + factor random.nat + .let [expected (n.* factor (++ start))]] + (all _.and + (_.coverage [/.|>] + (n.= expected + (/.|> start ++ (n.* factor)))) + (_.coverage [/.|>>] + (n.= expected + ((/.|>> ++ (n.* factor)) start))) + (_.coverage [/.<|] + (n.= expected + (/.<| (n.* factor) ++ start))) + (_.coverage [/.<<|] + (n.= expected + ((/.<<| (n.* factor) ++) start))) + ))) + +(def example_symbol "YOLO") +(def i8 8) + +(def current_module + Text + (let [[module _] (symbol .._)] + module)) + +(def for_code/' + Test + (do random.monad + [example_nat random.nat] + (_.coverage [/.' /.literal_quote] + (and (code#= (code.nat 0) (/.' 0)) + (code#= (code.int -1) (/.' -1)) + (code#= (code.rev .2) (/.' .2)) + (code#= (code.frac +3.4) (/.' +3.4)) + (code#= (code.text "5") (/.' "5")) + (code#= (code.symbol ["" "example_symbol"]) + (/.' example_symbol)) + (code#= (code.symbol [/.prelude "example_symbol"]) + (/.' .example_symbol)) + (code#= (code.symbol [..current_module "example_symbol"]) + (/.' ..example_symbol)) + (code#= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) + (/.' (6 +7 .8))) + (code#= (code.variant (list (code.frac +9.0) + (code.text "9") + (code.symbol ["" "i8"]))) + (/.' {+9.0 "9" i8})) + (code#= (code.tuple (list (code.frac +9.0) + (code.text "9") + (code.symbol ["" "i8"]))) + (/.' [+9.0 "9" i8])) + )))) + +(def for_code/` + Test + (do random.monad + [example_nat random.nat] + (_.coverage [/.` /.syntax_quote] + (and (code#= (code.nat 0) (/.` 0)) + (code#= (code.int -1) (/.` -1)) + (code#= (code.rev .2) (/.` .2)) + (code#= (code.frac +3.4) (/.` +3.4)) + (code#= (code.text "5") (/.` "5")) + (code#= (code.symbol [..current_module "example_symbol"]) + (/.` example_symbol)) + (code#= (code.symbol [/.prelude "example_symbol"]) + (/.` .example_symbol)) + (code#= (code.symbol [..current_module "example_symbol"]) + (/.` ..example_symbol)) + (code#= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) + (/.` (6 +7 .8))) + (code#= (code.variant (list (code.frac +9.0) + (code.text "9") + (code.symbol [..current_module "i8"]))) + (/.` {+9.0 "9" i8})) + (code#= (code.tuple (list (code.frac +9.0) + (code.text "9") + (code.symbol [..current_module "i8"]))) + (/.` [+9.0 "9" i8])) + )))) + +(def for_code/`' + Test + (do random.monad + [example_nat random.nat] + (_.coverage [/.`' /.partial_quote] + (and (code#= (code.nat 0) (/.`' 0)) + (code#= (code.int -1) (/.`' -1)) + (code#= (code.rev .2) (/.`' .2)) + (code#= (code.frac +3.4) (/.`' +3.4)) + (code#= (code.text "5") (/.`' "5")) + (code#= (code.symbol ["" "example_symbol"]) + (/.`' example_symbol)) + (code#= (code.symbol [/.prelude "example_symbol"]) + (/.`' .example_symbol)) + (code#= (code.symbol [..current_module "example_symbol"]) + (/.`' ..example_symbol)) + (code#= (code.form (list (code.nat 6) (code.int +7) (code.rev .8))) + (/.`' (6 +7 .8))) + (code#= (code.variant (list (code.frac +9.0) + (code.text "9") + (code.symbol ["" "i8"]))) + (/.`' {+9.0 "9" i8})) + (code#= (code.tuple (list (code.frac +9.0) + (code.text "9") + (code.symbol ["" "i8"]))) + (/.`' [+9.0 "9" i8])) + )))) + +(def for_code + Test + (do [! random.monad] + [example (at ! each code.nat random.nat) + example_bit random.bit + example_nat random.nat + example_int random.int] + (all _.and + (_.for [/.Code /.Code'] + (all _.and + ..for_code/' + ..for_code/` + ..for_code/`' + )) + (_.coverage [/.Ann] + (|> example + (the /.#meta) + (location#= location.dummy))) + (_.for [/.UnQuote] + (all _.and + (_.coverage [/.unquote_macro] + (exec + (is /.Macro' + (/.unquote_macro /.,)) + (is /.Macro' + (/.unquote_macro /.,')) + true)) + (_.coverage [/.unquote] + (exec + (is /.UnQuote + (/.unquote ("lux macro" (/.unquote_macro /.,)))) + (is /.UnQuote + (/.unquote ("lux macro" (/.unquote_macro /.,')))) + true)) + (_.coverage [/., /.but] + (with_expansions [<nat> (code.nat example_nat)] + (and (not (code#= <nat> + (/.' (/., <nat>)))) + (code#= <nat> + (/.` (/., <nat>))) + (code#= <nat> + (/.`' (/., <nat>)))))) + (_.coverage [/.,* /.also] + (with_expansions [<bit> (code.bit example_bit) + <nat> (code.nat example_nat) + <int> (code.int example_int) + <expected> (code.tuple (list <bit> <nat> <int>)) + <actual> [(/.,* (list <bit> <nat> <int>))]] + (and (not (code#= <expected> + (/.' <actual>))) + (code#= <expected> + (/.` <actual>)) + (code#= <expected> + (/.`' <actual>))))) + (_.coverage [/.,' /.literally] + (with_expansions [<bit> (code.bit example_bit) + <nat> (code.nat example_nat) + <int> (code.int example_int) + <expected> (/.' [(list <bit> <nat> <int>)]) + <actual> [(/.,' (list <bit> <nat> <int>))]] + (and (not (code#= <expected> + (/.' <actual>))) + (code#= <expected> + (/.` <actual>)) + (code#= <expected> + (/.`' <actual>))))) + )) + ))) + +(def identity_macro + (/.macro (_ tokens) + (at meta.monad in tokens))) + +(def crosshair + "This is an arbitrary text whose only purpose is to be found, somewhere, in the source-code.") + +(def found_crosshair? + (macro (_ tokens lux) + (let [[_ _ source_code] (the .#source lux)] + {.#Right [lux (list (code.bit (text.contains? ..crosshair source_code)))]}))) + +(def for_macro + Test + (let [macro (is /.Macro' + (function (_ tokens lux) + {.#Right [lux (list)]}))] + (do random.monad + [expected random.nat] + (`` (`` (all _.and + (_.coverage [/.Macro'] + (|> macro + (is /.Macro') + (same? macro))) + (_.coverage [/.Macro] + (|> macro + "lux macro" + (is /.Macro) + (is Any) + (same? (is Any macro)))) + (_.coverage [/.macro] + (same? expected (..identity_macro expected))) + (,, (for @.old (,, (these)) + (_.coverage [/.Source] + (..found_crosshair?)))) + ... (_.coverage [/.require] + ... (`` (with_expansions [<referral> ("lux in-module" "library/lux" library/lux.refer) + ... <alias> (static.random code.text (random.lower_case 1)) + ... <definition> (static.random code.local (random.lower_case 1)) + ... <module/0> (static.random code.text (random.lower_case 2)) + ... <module/0>' (template.symbol [<module/0>]) + ... <module/1> (static.random code.text (random.lower_case 3)) + ... <module/1>' (template.symbol [<module/1>]) + ... <module/2> (static.random code.text (random.lower_case 4)) + ... <module/2>' (template.symbol [<module/2>]) + ... <m0/1> (template.text [<module/0> "/" <module/1>]) + ... <//> (template.text [// <module/2>']) + ... <//>' (template.symbol [<//>]) + ... <\\> (template.text [\\ <module/2>']) + ... <\\>' (template.symbol [<\\>]) + ... <m0/2> (template.text [<module/0> "/" <module/2>]) + ... <m2/1> (template.text [<module/2> "/" <module/1>]) + ... <m0/1/2> (template.text [<module/0> "/" <module/1> "/" <module/2>]) + ... <open/0> (template.text [<module/0> "#[0]"])] + ... (and (,, (with_template [<input> <module> <referrals>] + ... [(with_expansions [<input>' (macro.final <input>)] + ... (let [scenario (is (-> Any Bit) + ... (function (_ _) + ... ... TODO: Remove this hack once Jython is no longer being used as the Python interpreter. + ... (`` (for @.python (when (' [<input>']) + ... (^.` [<module> + ... ("lux def" (, [_ {.#Symbol ["" _]}]) [] #0) + ... (,, (template.spliced <referrals>))]) + ... true + + ... _ + ... false) + ... (when (' [<input>']) + ... (^.` [<module> (,, (template.spliced <referrals>))]) + ... true + + ... _ + ... false)))))] + ... (scenario [])))] + + ... [(.require [<module/0>']) + ... ("lux def module" []) + ... []] + + ... [(.require [<alias> <module/0>' (.except)]) + ... ("lux def module" [[<module/0> <alias>]]) + ... [(<referral> <module/0> (.except))]] + + ... [(.require [<alias> <module/0>' (.only <definition>)]) + ... ("lux def module" [[<module/0> <alias>]]) + ... [(<referral> <module/0> (.only <definition>))]] + + ... [(.require [<alias> <module/0>' (.except <definition>)]) + ... ("lux def module" [[<module/0> <alias>]]) + ... [(<referral> <module/0> (.except <definition>))]] + + ... [(.require [<alias> <module/0>']) + ... ("lux def module" []) + ... []] + + ... [(.require [<module/0>' + ... [<alias> <module/1>']]) + ... ("lux def module" [[<m0/1> <alias>]]) + ... [(<referral> <m0/1>)]] + + ... [(.require ["[0]" <module/0>' + ... ["[0]" <module/1>']]) + ... ("lux def module" [[<module/0> <module/0>] + ... [<m0/1> <module/1>]]) + ... [(<referral> <module/0>) + ... (<referral> <m0/1>)]] + + ... [(.require ["[0]" <module/0>' + ... ["[1]" <module/1>']]) + ... ("lux def module" [[<m0/1> <module/0>]]) + ... [(<referral> <m0/1>)]] + + ... [(.require ["[0]" <module/0>' + ... ["[1]" <module/1>' + ... ["[2]" <module/2>']]]) + ... ("lux def module" [[<m0/1/2> <module/0>]]) + ... [(<referral> <m0/1/2>)]] + + ... [(.require [<module/0>' + ... ["[0]" <module/1>' + ... ["[0]" <//>']]]) + ... ("lux def module" [[<m0/1> <module/1>] + ... [<m0/2> <//>]]) + ... [(<referral> <m0/1>) + ... (<referral> <m0/2>)]] + + ... [(.require ["[0]" <module/0>' + ... [<module/1>' + ... ["[0]" <\\>']]]) + ... ("lux def module" [[<module/0> <module/0>] + ... [<m2/1> <\\>]]) + ... [(<referral> <module/0>) + ... (<referral> <m2/1>)]] + + ... [(.require ["[0]" <module/0>' (.use "[1]#[0]" <definition>)]) + ... ("lux def module" [[<module/0> <module/0>]]) + ... [(<referral> <module/0> (<open/0> <definition>))]] + ... )))))) + )))))) + +(/.type for_type/variant + (Variant + {#Case/0} + {#Case/1 Nat} + {#Case/2 Int Text})) + +(/.type for_type/record + (Record + [#slot/0 Bit + #slot/1 Rev])) + +(/.type (for_type/all parameter) + [parameter parameter]) + +(def for_type + Test + (do [! random.monad] + [expected random.nat + + expected_left random.nat + expected_right random.nat + + .let [existential_type (at ! each (|>> {.#Ex}) random.nat)] + expected/0 existential_type + expected/1 existential_type] + (<| (_.for [/.Type]) + (all _.and + (_.coverage [/.is] + (|> expected + (/.is Any) + (same? (/.is Any expected)))) + (_.coverage [/.as] + (|> expected + (/.is Any) + (/.as /.Nat) + (same? expected))) + (_.coverage [/.as_expected] + (|> expected + (/.is Any) + /.as_expected + (/.is /.Nat) + (same? expected))) + (_.coverage [/.type_of] + (same? /.Nat (/.type_of expected))) + (_.coverage [/.Primitive] + (when (/.Primitive "foo" [expected/0 expected/1]) + {.#Primitive "foo" (list actual/0 actual/1)} + (and (same? expected/0 actual/0) + (same? expected/1 actual/1)) + + _ + false)) + (_.coverage [/.type_literal] + (and (when (/.type_literal [expected/0 expected/1]) + {.#Product actual/0 actual/1} + (and (same? expected/0 actual/0) + (same? expected/1 actual/1)) + + _ + false) + (when (/.type_literal (/.Or expected/0 expected/1)) + {.#Sum actual/0 actual/1} + (and (same? expected/0 actual/0) + (same? expected/1 actual/1)) + + _ + false) + (when (/.type_literal (-> expected/0 expected/1)) + {.#Function actual/0 actual/1} + (and (same? expected/0 actual/0) + (same? expected/1 actual/1)) + + _ + false) + (when (/.type_literal (expected/0 expected/1)) + {.#Apply actual/1 actual/0} + (and (same? expected/0 actual/0) + (same? expected/1 actual/1)) + + _ + false))) + (_.coverage [/.type] + (exec + (is /.Type ..for_type/variant) + (is /.Type ..for_type/record) + (is /.Type ..for_type/all) + true)) + (_.coverage [/.Variant] + (exec + (is for_type/variant + {#Case/1 expected_left}) + true)) + (_.coverage [/.Record] + (exec + (is for_type/record + [#slot/0 (n.= expected_left expected_right) + #slot/1 (.rev expected_right)]) + true)) + )))) + +(def for_i64 + Test + (do random.monad + [expected random.i64] + (all _.and + (_.coverage [/.i64] + (same? (is Any expected) + (is Any (/.i64 expected)))) + (_.coverage [/.nat] + (same? (is Any expected) + (is Any (/.nat expected)))) + (_.coverage [/.int] + (same? (is Any expected) + (is Any (/.int expected)))) + (_.coverage [/.rev] + (same? (is Any expected) + (is Any (/.rev expected)))) + (_.coverage [/.++] + (n.= 1 (n.- expected + (/.++ expected)))) + (_.coverage [/.--] + (n.= 1 (n.- (/.-- expected) + expected))) + ))) + +(def for_function + Test + (do random.monad + [expected_left random.nat + expected_right random.nat] + (_.coverage [/.-> /.function] + (and (let [actual (is (/.-> Nat Nat Nat) + (/.function (_ actual_left actual_right) + (n.* (++ actual_left) (-- actual_right))))] + (n.= (n.* (++ expected_left) (-- expected_right)) + (actual expected_left expected_right))) + (let [actual (is (/.-> [Nat Nat] Nat) + (/.function (_ [actual_left actual_right]) + (n.* (++ actual_left) (-- actual_right))))] + (n.= (n.* (++ expected_left) (-- expected_right)) + (actual [expected_left expected_right]))))))) + +(def !n/+ + (/.template (_ <left> <right>) + [(n.+ <left> <right>)])) + +(def for_template + Test + (`` (all _.and + (_.coverage [/.with_template] + (let [bits (list (,, (/.with_template [_] + [true] + + [0] [1] [2] + )))] + (and (n.= 3 (list.size bits)) + (list.every? (bit#= true) bits)))) + (do random.monad + [left random.nat + right random.nat] + (_.coverage [/.template] + (n.= (n.+ left right) + (!n/+ left right)))) + ))) + +(def option/0 "0") +(def option/1 "1") +(def static_char "@") + +(def for_static + Test + (do random.monad + [sample (random.either (in option/0) + (in option/1))] + (all _.and + (_.coverage [/.static] + (when sample + (/.static option/0) true + (/.static option/1) true + _ false)) + (_.coverage [/.char] + (|> (`` (/.char (,, (/.static static_char)))) + text.of_char + (text#= static_char))) + ))) + +(type Small + (Record + [#small_left Nat + #small_right Text])) + +(type Big + (Record + [#big_left Nat + #big_right Small])) + +(def for_slot + Test + (do random.monad + [start/s random.nat + start/b random.nat + shift/s random.nat + shift/b random.nat + text (random.lower_case 1) + .let [expected/s (n.+ shift/s start/s) + expected/b (n.+ shift/b start/b) + + sample [#big_left start/b + #big_right [#small_left start/s + #small_right text]]]] + (all _.and + (_.coverage [/.the] + (and (and (|> sample + (/.the #big_left) + (same? start/b)) + (|> sample + ((/.the #big_left)) + (same? start/b))) + (and (|> sample + (/.the [#big_right #small_left]) + (same? start/s)) + (|> sample + ((/.the [#big_right #small_left])) + (same? start/s))))) + (_.coverage [/.has] + (and (and (|> sample + (/.has #big_left shift/b) + (/.the #big_left) + (same? shift/b)) + (|> sample + ((/.has #big_left shift/b)) + (/.the #big_left) + (same? shift/b)) + (|> sample + ((/.has #big_left) shift/b) + (/.the #big_left) + (same? shift/b))) + (and (|> sample + (/.has [#big_right #small_left] shift/s) + (/.the [#big_right #small_left]) + (same? shift/s)) + (|> sample + ((/.has [#big_right #small_left] shift/s)) + (/.the [#big_right #small_left]) + (same? shift/s)) + (|> sample + ((/.has [#big_right #small_left]) shift/s) + (/.the [#big_right #small_left]) + (same? shift/s))))) + (_.coverage [/.revised] + (and (and (|> sample + (/.revised #big_left (n.+ shift/b)) + (/.the #big_left) + (n.= expected/b)) + (|> sample + ((/.revised #big_left (n.+ shift/b))) + (/.the #big_left) + (n.= expected/b)) + (|> sample + ((is (-> (-> Nat Nat) (-> Big Big)) + (/.revised #big_left)) + (n.+ shift/b)) + (/.the #big_left) + (n.= expected/b))) + (and (|> sample + (/.revised [#big_right #small_left] (n.+ shift/s)) + (/.the [#big_right #small_left]) + (n.= expected/s)) + (|> sample + ((/.revised [#big_right #small_left] (n.+ shift/s))) + (/.the [#big_right #small_left]) + (n.= expected/s)) + (|> sample + ((is (-> (-> Nat Nat) (-> Big Big)) + (/.revised [#big_right #small_left])) + (n.+ shift/s)) + (/.the [#big_right #small_left]) + (n.= expected/s))))) + ))) + +(def for_associative + Test + (do random.monad + [left (random.lower_case 1) + mid (random.lower_case 1) + right (random.lower_case 1) + .let [expected (text.interposed "" (list left mid right))]] + (_.coverage [/.all /.left] + (with_expansions [<left_association> (/.left format + left + mid + right) + <right_association> (/.all format + left + mid + right)] + (and (text#= <left_association> + <right_association>) + (not (code#= (' <left_association>) + (' <right_association>)))))))) + +(def for_expansion + Test + (do random.monad + [left random.nat + right random.nat + dummy random.nat + .let [expected (n.+ left right)]] + (all _.and + (_.coverage [/.these] + (`` (and (,, (these true + true + true))))) + (_.coverage [/.with_expansions] + (/.with_expansions [<operands> (these left right)] + (n.= expected + (n.+ <operands>)))) + (_.coverage [/.comment] + (/.with_expansions [<dummy> (/.comment dummy) + <operands> (these left right)] + (n.= expected + (all n.+ <operands> <dummy>)))) + (_.coverage [/.``] + (n.= expected + (/.`` (all n.+ + (,, (these left right)) + (,, (/.comment dummy)))))) + (_.coverage [/.for] + (and (n.= expected + (/.for "fake host" dummy + expected)) + (n.= expected + (/.for @.old expected + @.jvm expected + @.js expected + @.python expected + @.lua expected + @.ruby expected + @.php expected + dummy)))) + ))) + +(def for_value + Test + (do random.monad + [left random.nat + right (random.lower_case 1) + + item/0 random.nat + item/1 random.nat + item/2 random.nat] + (all _.and + (_.coverage [/.Either] + (and (exec + (is (/.Either Nat Text) + {.#Left left}) + true) + (exec + (is (/.Either Nat Text) + {.#Right right}) + true))) + (_.coverage [/.Any] + (and (exec + (is /.Any + left) + true) + (exec + (is /.Any + right) + true))) + (_.coverage [/.Nothing] + (and (exec + (is (-> /.Any /.Nothing) + (function (_ _) + (undefined))) + true) + (exec + (is (-> /.Any /.Int) + (function (_ _) + (is /.Int (undefined)))) + true))) + (_.for [/.__adjusted_quantified_type__] + (all _.and + (_.coverage [/.All] + (let [identity (is (/.All (_ a) (-> a a)) + (|>>))] + (and (exec + (is Nat + (identity left)) + true) + (exec + (is Text + (identity right)) + true)))) + (_.coverage [/.Ex] + (let [hide (is (/.Ex (_ a) (-> Nat a)) + (|>>))] + (exec + (is /.Any + (hide left)) + true))))) + (_.coverage [/.same?] + (let [not_left (atom.atom left) + left (atom.atom left)] + (and (/.same? left left) + (/.same? not_left not_left) + (not (/.same? left not_left))))) + (_.coverage [/.Rec] + (let [list (is (/.Rec NList + (Maybe [Nat NList])) + {.#Some [item/0 + {.#Some [item/1 + {.#Some [item/2 + {.#None}]}]}]})] + (when list + {.#Some [actual/0 {.#Some [actual/1 {.#Some [actual/2 {.#None}]}]}]} + (and (same? item/0 actual/0) + (same? item/1 actual/1) + (same? item/2 actual/2)) + + _ + false))) + ))) + +(type (Pair l r) + (Record + [#left l + #right r])) + +(def !pair + (template (_ <left> <right>) + [[..#left <left> + ..#right <right>]])) + +(def for_when + Test + (do [! random.monad] + [expected_nat (at ! each (n.% 1) random.nat) + expected_int (at ! each (i.% +1) random.int) + expected_rev (random.either (in .5) + (in .25)) + expected_frac (random.either (in +0.5) + (in +1.25)) + expected_text (random.either (in "+0.5") + (in "+1.25"))] + (all _.and + (_.coverage [/.when] + (and (/.when expected_nat + 0 true + _ false) + (/.when expected_int + +0 true + _ false) + (/.when expected_rev + .5 true + .25 true + _ false) + (/.when expected_frac + +0.5 true + +1.25 true + _ false) + (/.when expected_text + "+0.5" true + "+1.25" true + _ false) + (/.when [expected_nat expected_int] + [0 +0] true + _ false) + (/.when [..#left expected_nat ..#right expected_int] + [..#left 0 ..#right +0] true + _ false) + (/.when (is (Either Nat Int) {.#Left expected_nat}) + {.#Left 0} true + _ false) + (/.when (is (Either Nat Int) {.#Right expected_int}) + {.#Right +0} true + _ false) + )) + ... (_.coverage [/.pattern] + ... (/.when [..#left expected_nat ..#right expected_int] + ... (!pair 0 +0) + ... true + + ... _ + ... false)) + (_.coverage [/.let] + (and (/.let [actual_nat expected_nat] + (/.same? expected_nat actual_nat)) + (/.let [[actual_left actual_right] [..#left expected_nat ..#right expected_int]] + (and (/.same? expected_nat actual_left) + (/.same? expected_int actual_right))))) + ))) + +(def for_control_flow + Test + (all _.and + (do random.monad + [factor (random#each (|>> (n.% 10) (n.max 1)) random.nat) + iterations (random#each (n.% 10) random.nat) + .let [expected (n.* factor iterations)]] + (_.coverage [/.loop] + (n.= expected + (/.loop (again [counter 0 + value 0]) + (if (n.< iterations counter) + (again (++ counter) (n.+ factor value)) + value))))) + (do random.monad + [pre random.nat + post (random.only (|>> (n.= pre) not) random.nat) + .let [box (atom.atom pre)]] + (_.coverage [/.exec] + (and (same? pre (io.run! (atom.read! box))) + (/.exec + (io.run! (atom.write! post box)) + (same? post (io.run! (atom.read! box))))))) + )) + +(def identity/constant + (All (_ a) (-> a a)) + (function (_ value) + value)) + +(def (identity/function value) + (All (_ a) (-> a a)) + value) + +(def for_def + Test + (do random.monad + [expected random.nat] + (_.coverage [/.def] + (and (same? expected (identity/constant expected)) + (same? expected (identity/function expected)))))) + +(def possible_targets + (Set @.Target) + (<| (set.of_list text.hash) + (list @.old + @.js + @.jvm + @.lua + @.python + @.ruby))) + +(def for_meta|Info + (syntax (_ []) + (function (_ lux) + (let [info (the .#info lux) + + conforming_target! + (set.member? ..possible_targets (the .#target info)) + + compiling! + (when (the .#mode info) + {.#Build} true + _ false)] + {.#Right [lux (list (code.bit (and conforming_target! + compiling!)))]})))) + +(def for_meta|Module_State + (syntax (_ []) + (do meta.monad + [prelude (meta.module .prelude)] + (in (list (code.bit (when (the .#module_state prelude) + {.#Active} false + _ true))))))) + +(def for_meta + Test + (all _.and + (_.coverage [/.Mode /.Info] + (for_meta|Info)) + (_.coverage [/.Module_State] + (for_meta|Module_State)) + )) + +(def for_export + Test + (all _.and + (_.coverage [/.public /.private] + (and /.public (not /.private))) + (_.coverage [/.global /.local] + (and (bit#= /.public /.global) + (bit#= /.private /.local))) + )) + +(for @.old (these) + (these (def for_bindings|test + (syntax (_ lux_state + [fn/0 <code>.local + var/0 <code>.local + let/0 <code>.local + + fn/1 <code>.local + var/1 <code>.local + let/1 <code>.local + + fn/2 <code>.local + var/2 <code>.local + let/2 <code>.local + + let/3 <code>.local]) + (in (list (code.bit (when (the .#scopes lux_state) + (list.partial scope/2 _) + (let [locals/2 (the .#locals scope/2) + expected_locals/2 (set.of_list text.hash (list fn/2 var/2 let/2 + let/3)) + actual_locals/2 (|> locals/2 + (the .#mappings) + (list#each product.left) + (set.of_list text.hash)) + + correct_locals! + (and (n.= 4 (the .#counter locals/2)) + (set#= expected_locals/2 + actual_locals/2)) + + captured/2 (the .#captured scope/2) + + local? (is (-> Ref Bit) + (function (_ ref) + (when ref + {.#Local _} true + {.#Captured _} false))) + captured? (is (-> Ref Bit) + (|>> local? not)) + binding? (is (-> (-> Ref Bit) Text Bit) + (function (_ is? name) + (|> captured/2 + (the .#mappings) + (property.value name) + (maybe#each (|>> product.right is?)) + (maybe.else false)))) + + correct_closure! + (and (n.= 6 (the .#counter captured/2)) + (binding? local? fn/1) + (binding? local? var/1) + (binding? local? let/1) + (binding? captured? fn/0) + (binding? captured? var/0) + (binding? captured? let/0))] + (and correct_locals! + correct_closure!)) + + _ + false)))))) + + (def for_bindings + Test + ((<| (template.with_locals [fn/0 var/0 let/0 + fn/1 var/1 let/1 + fn/2 var/2 let/2 + let/3]) + (function (fn/0 var/0)) (let [let/0 123]) + (function (fn/1 var/1)) (let [let/1 456]) + (function (fn/2 var/2)) (let [let/2 789]) + (let [let/3 [fn/0 var/0 let/0 + fn/1 var/1 let/1 + fn/2 var/2 let/2] + verdict (for_bindings|test fn/0 var/0 let/0 + fn/1 var/1 let/1 + fn/2 var/2 let/2 + let/3)] + (_.coverage [/.Bindings /.Ref] + verdict))) + 0 1 2)))) + +(def test|lux + Test + (`` (`` (all _.and + ..for_bit + ..for_try + ..for_list + ..for_interface + ..for_module + ..for_pipe + ..for_code + ..for_macro + ..for_type + ..for_i64 + ..for_function + ..for_template + ..for_static + ..for_slot + ..for_associative + ..for_expansion + ..for_value + ..for_when + ..for_control_flow + ..for_def + ..for_meta + ..for_export + (,, (for @.old (,, (these)) + (,, (these ..for_bindings)))) + )))) + +(def test + Test + (<| (_.covering /._) + (_.in_parallel + (list ..test|lux + + /abstract.test + /control.test + /data.test + /debug.test + + /documentation.test + /math.test + + /meta.test + /program.test + /test/property.test + + /world.test + + /ffi.test + )))) (def _ (program args - (let [_ ("lux io log" "[[[0]]]") - ... times (for @.old 100 - ... @.jvm 100 - ... @.js 10 - ... @.python 1 - ... @.lua 1 - ... @.ruby 1 - ... 100) - ] - (exec - ("lux io log" "[[[1]]]") - (<| io.io - ("lux io log" "Hello, World!") - ... _.run! - ... (_.times times) - ... ..test - ))))) + (let [times (for @.old 100 + @.jvm 100 + @.js 10 + @.python 1 + @.lua 1 + @.ruby 1 + 100)] + (<| io.io + _.run! + (_.times times) + ..test + )))) diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 9daf9ce78..bdef6e1b1 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -13,7 +13,8 @@ ["[1]/[0]" async] ["[1]/[0]" semaphore] ["[1]/[0]" stm] - ["[1]/[0]" event]] + ["[1]/[0]" event] + ["[1]/[0]" cps]] ["[1][0]" continuation] ["[1][0]" exception] ["[1][0]" function] @@ -44,6 +45,7 @@ /concurrency/semaphore.test /concurrency/stm.test /concurrency/event.test + /concurrency/cps.test )) (def security diff --git a/stdlib/source/test/lux/control/concurrency/cps.lux b/stdlib/source/test/lux/control/concurrency/cps.lux new file mode 100644 index 000000000..5bf53cb96 --- /dev/null +++ b/stdlib/source/test/lux/control/concurrency/cps.lux @@ -0,0 +1,92 @@ +(.require + [library + [lux (.except) + [abstract + [monad (.only do)] + [\\specification + ["$[0]" functor (.only Injection Comparison)] + ["$[0]" monad]]] + [control + ["[0]" io] + ["[0]" try] + ["[0]" exception]] + [math + ["[0]" random]] + [test + ["_" property (.only Test)] + ["[0]" unit]]]] + [\\library + ["[0]" / (.only) + [// + ["[0]" async]]]]) + +(def injection + (Injection /.Process) + (at /.monad in)) + +(def comparison + (Comparison /.Process) + (function (_ == left right) + (io.run! + (do io.monad + [?left (async.value left) + ?right (async.value right)] + (in (when [?left ?right] + [{.#Some {try.#Success left}} + {.#Some {try.#Success right}}] + (== left right) + + _ + false)))))) + +(def .public test + Test + (<| (_.covering /._) + (do [! random.monad] + [expected random.nat] + (all _.and + (_.for [/.Process] + (all _.and + (_.for [/.functor] + ($functor.spec ..injection ..comparison /.functor)) + (_.for [/.monad] + ($monad.spec ..injection ..comparison /.monad)) + )) + (_.coverage [/.Channel /.Channel' /.Sink /.channel] + ... This is already been tested for the FRP module. + true) + (in (do async.monad + [it (do /.monad + [.let [[channel sink] (/.channel [])] + _ (/.write expected sink) + [actual channel] (/.read channel)] + (in (same? expected actual)))] + (unit.coverage [/.read /.write] + (try.else false it)))) + (in (do async.monad + [it (do /.monad + [.let [[channel sink] (/.channel [])] + _ (/.close sink) + it (/.try (/.write expected sink))] + (in (when it + {try.#Failure _} + true + + _ + false)))] + (unit.coverage [/.close /.try] + (try.else false it)))) + (in (do async.monad + [it (do /.monad + [.let [[channel sink] (/.channel [])] + _ (/.close sink) + it (/.try (/.read channel))] + (in (when it + {try.#Failure error} + (exception.match? /.channel_has_been_closed error) + + _ + false)))] + (unit.coverage [/.channel_has_been_closed] + (try.else false it)))) + )))) diff --git a/stdlib/source/test/lux/meta/static.lux b/stdlib/source/test/lux/meta/static.lux index a7169d6af..2b69d4cb6 100644 --- a/stdlib/source/test/lux/meta/static.lux +++ b/stdlib/source/test/lux/meta/static.lux @@ -2,6 +2,7 @@ [library [lux (.except) [data + ["[0]" bit (.use "[1]#[0]" equivalence)] ["[0]" text (.use "[1]#[0]" equivalence) ["%" \\format (.only format)]] [collection @@ -39,6 +40,7 @@ _ false)))] + [/.bit /.random_bit bit#= and .#Bit] [/.nat /.random_nat n.= n.+ .#Nat] [/.int /.random_int i.= i.+ .#Int] [/.rev /.random_rev r.= r.+ .#Rev] @@ -91,4 +93,31 @@ l/* (/.literals code.nat (list l/0 l/1 l/2))] (n.= (all n.+ l/0 l/1 l/2) (all n.+ l/*)))) + (_.coverage [/.if] + (with_expansions [<?> (/.random_bit) + <then> (/.random_nat) + <else> (/.random_nat)] + (n.= (if <?> <then> <else>) + (/.if <?> <then> <else>)))) + (_.coverage [/.cond] + (with_expansions [<?> (/.random_bit) + <then> (/.random_nat) + <else> (/.random_nat) + <never> (/.random_frac)] + (n.= (if <?> <then> <else>) + (/.cond <?> <then> + (not <?>) <else> + ... never + <never>)))) + (_.coverage [/.when] + (with_expansions [<0> (/.random_nat) + <1> (/.random_nat) + <2> (/.random_nat)] + (and (n.= (all n.+ <0> <1>) + (`` (all n.+ <0> <1> (,, (/.when false <2>))))) + (n.= (all n.+ <0> <1> <2>) + (`` (all n.+ <0> <1> (,, (/.when true <2>)))))))) + (_.coverage [/.seed] + (not (n.= (/.seed) + (/.seed)))) )))) |