From e53c1a090eb9cfac3cb23d10d981648d02518ed1 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 13 Aug 2021 04:18:57 -0400 Subject: Made program: specify its bindings the same way as syntax:. --- stdlib/source/test/lux.lux | 296 +++++++++++++++++++++++++++------------------ 1 file changed, 178 insertions(+), 118 deletions(-) (limited to 'stdlib/source/test/lux.lux') diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 34d3b4cc1..cf45f0ca5 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -12,18 +12,25 @@ [monad (#+ do)]] [control ["." io] + ["." maybe ("#\." functor)] [concurrency - ["." atom (#+ Atom)]]] + ["." atom (#+ Atom)]] + [parser + ["<.>" code]]] [data + ["." product] ["." bit ("#\." equivalence)] ["." text ("#\." equivalence) ["%" format (#+ format)]] [collection - ["." list] - ["." set (#+ Set)]]] + ["." list ("#\." functor)] + ["." set (#+ Set) ("#\." equivalence)] + [dictionary + ["." plist]]]] ["." macro [syntax (#+ syntax:)] - ["." code ("#\." equivalence)]] + ["." code ("#\." equivalence)] + ["." template]] ["." math ["." random ("#\." functor)] [number @@ -440,15 +447,15 @@ (_.cover [/.Macro'] (|> macro (: /.Macro') - (is? macro))) + (same? macro))) (_.cover [/.Macro] (|> macro "lux macro" (: /.Macro) (: Any) - (is? (: Any macro)))) + (same? (: Any macro)))) (_.cover [/.macro:] - (is? expected (..identity_macro expected))) + (same? expected (..identity_macro expected))) )))))) @@ -480,61 +487,61 @@ (_.cover [/.:] (|> expected (/.: Any) - (is? (/.: Any expected)))) + (same? (/.: Any expected)))) (_.cover [/.:as] (|> expected (/.: Any) (/.:as /.Nat) - (is? expected))) - (_.cover [/.:assume] + (same? expected))) + (_.cover [/.:expected] (|> expected (/.: Any) - /.:assume + /.:expected (/.: /.Nat) - (is? expected))) + (same? expected))) (_.cover [/.:let] (let [[actual_left actual_right] (: (/.:let [side /.Nat] [side side]) [expected_left expected_right])] - (and (is? expected_left actual_left) - (is? expected_right actual_right)))) + (and (same? expected_left actual_left) + (same? expected_right actual_right)))) (_.cover [/.:of] - (is? /.Nat (/.:of expected))) + (same? /.Nat (/.:of expected))) (_.cover [/.primitive] (case (/.primitive "foo" [expected/0 expected/1]) (^ (#.Primitive "foo" (list actual/0 actual/1))) - (and (is? expected/0 actual/0) - (is? expected/1 actual/1)) + (and (same? expected/0 actual/0) + (same? expected/1 actual/1)) _ false)) (_.cover [/.type] (and (case (/.type [expected/0 expected/1]) (#.Product actual/0 actual/1) - (and (is? expected/0 actual/0) - (is? expected/1 actual/1)) + (and (same? expected/0 actual/0) + (same? expected/1 actual/1)) _ false) (case (/.type (/.Or expected/0 expected/1)) (#.Sum actual/0 actual/1) - (and (is? expected/0 actual/0) - (is? expected/1 actual/1)) + (and (same? expected/0 actual/0) + (same? expected/1 actual/1)) _ false) (case (/.type (-> expected/0 expected/1)) (#.Function actual/0 actual/1) - (and (is? expected/0 actual/0) - (is? expected/1 actual/1)) + (and (same? expected/0 actual/0) + (same? expected/1 actual/1)) _ false) (case (/.type (expected/0 expected/1)) (#.Apply actual/1 actual/0) - (and (is? expected/0 actual/0) - (is? expected/1 actual/1)) + (and (same? expected/0 actual/0) + (same? expected/1 actual/1)) _ false))) @@ -552,17 +559,17 @@ [expected random.i64] ($_ _.and (_.cover [/.i64] - (is? (: Any expected) - (: Any (/.i64 expected)))) + (same? (: Any expected) + (: Any (/.i64 expected)))) (_.cover [/.nat] - (is? (: Any expected) - (: Any (/.nat expected)))) + (same? (: Any expected) + (: Any (/.nat expected)))) (_.cover [/.int] - (is? (: Any expected) - (: Any (/.int expected)))) + (same? (: Any expected) + (: Any (/.int expected)))) (_.cover [/.rev] - (is? (: Any expected) - (: Any (/.rev expected)))) + (same? (: Any expected) + (: Any (/.rev expected)))) (_.cover [/.inc] (n.= 1 (n.- expected (/.inc expected)))) @@ -667,41 +674,41 @@ (_.cover [/.get@] (and (and (|> sample (/.get@ #big_left) - (is? start/b)) + (same? start/b)) (|> sample ((/.get@ #big_left)) - (is? start/b))) + (same? start/b))) (and (|> sample (/.get@ [#big_right #small_left]) - (is? start/s)) + (same? start/s)) (|> sample ((/.get@ [#big_right #small_left])) - (is? start/s))))) + (same? start/s))))) (_.cover [/.set@] (and (and (|> sample (/.set@ #big_left shift/b) (/.get@ #big_left) - (is? shift/b)) + (same? shift/b)) (|> sample ((/.set@ #big_left shift/b)) (/.get@ #big_left) - (is? shift/b)) + (same? shift/b)) (|> sample ((/.set@ #big_left) shift/b) (/.get@ #big_left) - (is? shift/b))) + (same? shift/b))) (and (|> sample (/.set@ [#big_right #small_left] shift/s) (/.get@ [#big_right #small_left]) - (is? shift/s)) + (same? shift/s)) (|> sample ((/.set@ [#big_right #small_left] shift/s)) (/.get@ [#big_right #small_left]) - (is? shift/s)) + (same? shift/s)) (|> sample ((/.set@ [#big_right #small_left]) shift/s) (/.get@ [#big_right #small_left]) - (is? shift/s))))) + (same? shift/s))))) (_.cover [/.update@] (and (and (|> sample (/.update@ #big_left (n.+ shift/b)) @@ -852,11 +859,11 @@ (: /.Any (hide left)) true))) - (_.cover [/.is?] + (_.cover [/.same?] (let [not_left (|> left inc dec)] - (and (/.is? left left) + (and (/.same? left left) (and (n.= not_left left) - (not (/.is? not_left left)))))) + (not (/.same? not_left left)))))) (_.cover [/.Rec] (let [list (: (/.Rec NList (Maybe [Nat NList])) @@ -866,9 +873,9 @@ #.None])])]))] (case list (#.Some [actual/0 (#.Some [actual/1 (#.Some [actual/2 #.None])])]) - (and (is? item/0 actual/0) - (is? item/1 actual/1) - (is? item/2 actual/2)) + (and (same? item/0 actual/0) + (same? item/1 actual/1) + (same? item/2 actual/2)) _ false))) @@ -939,8 +946,8 @@ (_.cover [/.^slots] (/.case {#left expected_nat #right expected_int} (/.^slots [#left #right]) - (and (/.is? expected_nat left) - (/.is? expected_int right)))) + (and (/.same? expected_nat left) + (/.same? expected_int right)))) (_.cover [/.^] (/.case {#left expected_nat #right expected_int} (/.^ (!pair 0 +0)) true @@ -950,9 +957,9 @@ {#left expected_nat #right expected_int})] (/.case expected_pair (/.^@ actual_pair (/.^ (!pair actual_left actual_right))) - (and (/.is? expected_pair actual_pair) - (/.is? expected_nat actual_left) - (/.is? expected_int actual_right))))) + (and (/.same? expected_pair actual_pair) + (/.same? expected_nat actual_left) + (/.same? expected_int actual_right))))) (_.cover [/.^multi] (let [expected_pair (: (Pair Nat Int) {#left expected_nat #right expected_int})] @@ -982,10 +989,10 @@ _ false)) (_.cover [/.let] (and (/.let [actual_nat expected_nat] - (/.is? expected_nat actual_nat)) + (/.same? expected_nat actual_nat)) (/.let [[actual_left actual_right] {#left expected_nat #right expected_int}] - (and (/.is? expected_nat actual_left) - (/.is? expected_int actual_right))))) + (and (/.same? expected_nat actual_left) + (/.same? expected_int actual_right))))) ))) (def: for_control_flow @@ -1007,10 +1014,10 @@ post (random.only (|>> (n.= pre) not) random.nat) .let [box (atom.atom pre)]] (_.cover [/.exec] - (and (is? pre (io.run! (atom.read! box))) + (and (same? pre (io.run! (atom.read! box))) (/.exec (io.run! (atom.write! post box)) - (is? post (io.run! (atom.read! box))))))) + (same? post (io.run! (atom.read! box))))))) )) (def: identity/constant @@ -1027,38 +1034,8 @@ (do random.monad [expected random.nat] (_.cover [/.def:] - (and (is? expected (identity/constant expected)) - (is? expected (identity/function expected)))))) - -(.refer "library/lux/target" #*) -(.refer "library/lux/macro" #all) -(.refer "library/lux/math/number/nat" #_) -(.refer "library/lux/math/number/int" #nothing) -(.refer "library/lux/math/number/rev" (#+ /4096)) -(.refer "library/lux/math/number/frac" (#only positive_infinity)) -(.refer "library/lux/math/number/i8" (#- equivalence width i8 i64)) -(.refer "library/lux/math/number/i16" (#exclude equivalence width i16 i64)) - -(def: for_import - Test - (let [can_access? (: (All [a] (-> a a Bit)) - (function (_ global local) - (is? global local)))] - ($_ _.and - (_.cover [/.refer] - (and (can_access? library/lux/target.jvm - jvm) - (can_access? library/lux/macro.single_expansion - single_expansion) - (can_access? library/lux/math/number/rev./4096 - /4096) - (can_access? library/lux/math/number/frac.positive_infinity - positive_infinity) - (can_access? library/lux/math/number/i8.I8 - I8) - (can_access? library/lux/math/number/i16.I16 - I16))) - ))) + (and (same? expected (identity/constant expected)) + (same? expected (identity/function expected)))))) (def: possible_targets (Set @.Target) @@ -1110,36 +1087,119 @@ (bit\= /.private /.local))) )) +(for {@.old (as_is)} + (as_is (syntax: (for_bindings|test [fn/0 .local_identifier + var/0 .local_identifier + let/0 .local_identifier + + fn/1 .local_identifier + var/1 .local_identifier + let/1 .local_identifier + + fn/2 .local_identifier + var/2 .local_identifier + let/2 .local_identifier + + let/3 .local_identifier]) + (in (list (code.bit (case (get@ #.scopes *lux*) + (^ (list& scope/2 _)) + (let [locals/2 (get@ #.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 + (get@ #.mappings) + (list\map product.left) + (set.of_list text.hash)) + + correct_locals! + (and (n.= 4 (get@ #.counter locals/2)) + (set\= expected_locals/2 + actual_locals/2)) + + captured/2 (get@ #.captured scope/2) + + local? (: (-> Ref Bit) + (function (_ ref) + (case ref + (#.Local _) true + (#.Captured _) false))) + captured? (: (-> Ref Bit) + (|>> local? not)) + binding? (: (-> (-> Ref Bit) Text Bit) + (function (_ is? name) + (|> captured/2 + (get@ #.mappings) + (plist.value name) + (maybe\map (|>> product.right is?)) + (maybe.else false)))) + + correct_closure! + (and (n.= 6 (get@ #.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)] + (_.cover [/.Bindings /.Ref] + verdict))) + 0 1 2)))) + (def: test Test (<| (_.covering /._) - ($_ _.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_case - ..for_control_flow - ..for_def: - ..for_import - ..for_meta - ..for_export - - ..sub_tests - ))) + (with_expansions + [ (for {@.old (~~ (as_is))} + (~~ (as_is ..for_bindings)))] + (`` ($_ _.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_case + ..for_control_flow + ..for_def: + ..for_meta + ..for_export + + + ..sub_tests + ))))) (program: args (let [times (for {@.old 100 -- cgit v1.2.3