From 9d20deda529f590c3092ac24546ba31da3c8f643 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Thu, 18 Aug 2022 03:13:52 -0400 Subject: Added support for event-loop concurrency. --- stdlib/source/test/lux.lux | 2482 ++++++++++++++++++++++---------------------- 1 file changed, 1268 insertions(+), 1214 deletions(-) (limited to 'stdlib/source/test/lux.lux') diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 58528f019..08a1f75cd 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -6,1222 +6,1276 @@ [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]]) - -(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 [/.'] - (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])) - (not (code#= (code.nat example_nat) - (/.' (, (code.nat example_nat))))) - )))) - -(def for_code/` - Test - (do random.monad - [example_nat random.nat] - (_.coverage [/.`] - (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])) - (code#= (code.nat example_nat) - (/.` (, (code.nat example_nat)))))))) - -(def for_code/`' - Test - (do random.monad - [example_nat random.nat] - (_.coverage [/.`'] - (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])) - (code#= (code.nat example_nat) - (/.`' (, (code.nat example_nat)))))))) - -(def for_code - Test - (do [! random.monad] - [example (at ! each code.nat random.nat)] - (all _.and - (_.for [/.Code /.Code'] - (all _.and - ..for_code/' - ..for_code/` - ..for_code/`' - )) - (_.coverage [/.Ann] - (|> example - (the /.#meta) - (location#= location.dummy))) - ))) - -(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 [ ("lux in-module" "library/lux" library/lux.refer) - ... (static.random code.text (random.lower_case 1)) - ... (static.random code.local (random.lower_case 1)) - ... (static.random code.text (random.lower_case 2)) - ... ' (template.symbol []) - ... (static.random code.text (random.lower_case 3)) - ... ' (template.symbol []) - ... (static.random code.text (random.lower_case 4)) - ... ' (template.symbol []) - ... (template.text [ "/" ]) - ... (template.text [// ']) - ... ' (template.symbol []) - ... <\\> (template.text [\\ ']) - ... <\\>' (template.symbol [<\\>]) - ... (template.text [ "/" ]) - ... (template.text [ "/" ]) - ... (template.text [ "/" "/" ]) - ... (template.text [ "#[0]"])] - ... (and (,, (with_template [ ] - ... [(with_expansions [' (macro.final )] - ... (let [scenario (is (-> Any Bit) - ... (function (_ _) - ... ... TODO: Remove this hack once Jython is no longer being used as the Python interpreter. - ... (`` (for @.python (when (' [']) - ... (^.` [ - ... ("lux def" (, [_ {.#Symbol ["" _]}]) [] #0) - ... (,, (template.spliced ))]) - ... true - - ... _ - ... false) - ... (when (' [']) - ... (^.` [ (,, (template.spliced ))]) - ... true - - ... _ - ... false)))))] - ... (scenario [])))] - - ... [(.require [']) - ... ("lux def module" []) - ... []] - - ... [(.require [ ' (.except)]) - ... ("lux def module" [[ ]]) - ... [( (.except))]] - - ... [(.require [ ' (.only )]) - ... ("lux def module" [[ ]]) - ... [( (.only ))]] - - ... [(.require [ ' (.except )]) - ... ("lux def module" [[ ]]) - ... [( (.except ))]] - - ... [(.require [ ']) - ... ("lux def module" []) - ... []] - - ... [(.require [' - ... [ ']]) - ... ("lux def module" [[ ]]) - ... [( )]] - - ... [(.require ["[0]" ' - ... ["[0]" ']]) - ... ("lux def module" [[ ] - ... [ ]]) - ... [( ) - ... ( )]] - - ... [(.require ["[0]" ' - ... ["[1]" ']]) - ... ("lux def module" [[ ]]) - ... [( )]] - - ... [(.require ["[0]" ' - ... ["[1]" ' - ... ["[2]" ']]]) - ... ("lux def module" [[ ]]) - ... [( )]] - - ... [(.require [' - ... ["[0]" ' - ... ["[0]" ']]]) - ... ("lux def module" [[ ] - ... [ ]]) - ... [( ) - ... ( )]] - - ... [(.require ["[0]" ' - ... [' - ... ["[0]" <\\>']]]) - ... ("lux def module" [[ ] - ... [ <\\>]]) - ... [( ) - ... ( )]] - - ... [(.require ["[0]" ' (.use "[1]#[0]" )]) - ... ("lux def module" [[ ]]) - ... [( ( ))]] - ... )))))) - )))))) - -(/.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 (_ ) - [(n.+ )])) - -(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 format - left - mid - right) - (/.all format - left - mid - right)] - (and (text#= - ) - (not (code#= (' ) - (' )))))))) - -(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 [ (these left right)] - (n.= expected - (n.+ )))) - (_.coverage [/.comment] - (/.with_expansions [ (/.comment dummy) - (these left right)] - (n.= expected - (all n.+ )))) - (_.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 ]])) - -(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 .local - var/0 .local - let/0 .local - - fn/1 .local - var/1 .local - let/1 .local - - fn/2 .local - var/2 .local - let/2 .local - - let/3 .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 - )))) + ... ["[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 [ (code.nat example_nat)] +... (and (not (code#= +... (/.' (/., )))) +... (code#= +... (/.` (/., ))) +... (code#= +... (/.`' (/., )))))) +... (_.coverage [/.,* /.also] +... (with_expansions [ (code.bit example_bit) +... (code.nat example_nat) +... (code.int example_int) +... (code.tuple (list )) +... [(/.,* (list ))]] +... (and (not (code#= +... (/.' ))) +... (code#= +... (/.` )) +... (code#= +... (/.`' ))))) +... (_.coverage [/.,' /.literally] +... (with_expansions [ (code.bit example_bit) +... (code.nat example_nat) +... (code.int example_int) +... (/.' [(list )]) +... [(/.,' (list ))]] +... (and (not (code#= +... (/.' ))) +... (code#= +... (/.` )) +... (code#= +... (/.`' ))))) +... )) +... ))) + +... (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 [ ("lux in-module" "library/lux" library/lux.refer) +... ... (static.random code.text (random.lower_case 1)) +... ... (static.random code.local (random.lower_case 1)) +... ... (static.random code.text (random.lower_case 2)) +... ... ' (template.symbol []) +... ... (static.random code.text (random.lower_case 3)) +... ... ' (template.symbol []) +... ... (static.random code.text (random.lower_case 4)) +... ... ' (template.symbol []) +... ... (template.text [ "/" ]) +... ... (template.text [// ']) +... ... ' (template.symbol []) +... ... <\\> (template.text [\\ ']) +... ... <\\>' (template.symbol [<\\>]) +... ... (template.text [ "/" ]) +... ... (template.text [ "/" ]) +... ... (template.text [ "/" "/" ]) +... ... (template.text [ "#[0]"])] +... ... (and (,, (with_template [ ] +... ... [(with_expansions [' (macro.final )] +... ... (let [scenario (is (-> Any Bit) +... ... (function (_ _) +... ... ... TODO: Remove this hack once Jython is no longer being used as the Python interpreter. +... ... (`` (for @.python (when (' [']) +... ... (^.` [ +... ... ("lux def" (, [_ {.#Symbol ["" _]}]) [] #0) +... ... (,, (template.spliced ))]) +... ... true + +... ... _ +... ... false) +... ... (when (' [']) +... ... (^.` [ (,, (template.spliced ))]) +... ... true + +... ... _ +... ... false)))))] +... ... (scenario [])))] + +... ... [(.require [']) +... ... ("lux def module" []) +... ... []] + +... ... [(.require [ ' (.except)]) +... ... ("lux def module" [[ ]]) +... ... [( (.except))]] + +... ... [(.require [ ' (.only )]) +... ... ("lux def module" [[ ]]) +... ... [( (.only ))]] + +... ... [(.require [ ' (.except )]) +... ... ("lux def module" [[ ]]) +... ... [( (.except ))]] + +... ... [(.require [ ']) +... ... ("lux def module" []) +... ... []] + +... ... [(.require [' +... ... [ ']]) +... ... ("lux def module" [[ ]]) +... ... [( )]] + +... ... [(.require ["[0]" ' +... ... ["[0]" ']]) +... ... ("lux def module" [[ ] +... ... [ ]]) +... ... [( ) +... ... ( )]] + +... ... [(.require ["[0]" ' +... ... ["[1]" ']]) +... ... ("lux def module" [[ ]]) +... ... [( )]] + +... ... [(.require ["[0]" ' +... ... ["[1]" ' +... ... ["[2]" ']]]) +... ... ("lux def module" [[ ]]) +... ... [( )]] + +... ... [(.require [' +... ... ["[0]" ' +... ... ["[0]" ']]]) +... ... ("lux def module" [[ ] +... ... [ ]]) +... ... [( ) +... ... ( )]] + +... ... [(.require ["[0]" ' +... ... [' +... ... ["[0]" <\\>']]]) +... ... ("lux def module" [[ ] +... ... [ <\\>]]) +... ... [( ) +... ... ( )]] + +... ... [(.require ["[0]" ' (.use "[1]#[0]" )]) +... ... ("lux def module" [[ ]]) +... ... [( ( ))]] +... ... )))))) +... )))))) + +... (/.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 (_ ) +... [(n.+ )])) + +... (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 format +... left +... mid +... right) +... (/.all format +... left +... mid +... right)] +... (and (text#= +... ) +... (not (code#= (' ) +... (' )))))))) + +... (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 [ (these left right)] +... (n.= expected +... (n.+ )))) +... (_.coverage [/.comment] +... (/.with_expansions [ (/.comment dummy) +... (these left right)] +... (n.= expected +... (all n.+ )))) +... (_.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 ]])) + +... (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 .local +... var/0 .local +... let/0 .local + +... fn/1 .local +... var/1 .local +... let/1 .local + +... fn/2 .local +... var/2 .local +... let/2 .local + +... let/3 .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 [times (for @.old 100 - @.jvm 100 - @.js 10 - @.python 1 - @.lua 1 - @.ruby 1 - 100)] + (let [... times (for @.old 100 + ... @.jvm 100 + ... @.js 10 + ... @.python 1 + ... @.lua 1 + ... @.ruby 1 + ... 100) + ] (<| io.io - _.run! - (_.times times) - ..test)))) + ("lux io log" "Hello, World!") + ... _.run! + ... (_.times times) + ... ..test + )))) -- cgit v1.2.3