From 1ce30d50abaa330ab2125b110e245de6deda27c7 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 8 Jan 2021 19:23:52 -0400 Subject: Moved "log!" function under "lux/debug". --- stdlib/source/test/aedifex/artifact.lux | 3 +- stdlib/source/test/aedifex/artifact/time_stamp.lux | 33 ++ stdlib/source/test/lux/control/pipe.lux | 3 +- stdlib/source/test/lux/data/product.lux | 4 +- stdlib/source/test/lux/data/sum.lux | 6 +- stdlib/source/test/lux/data/text.lux | 4 +- stdlib/source/test/lux/data/text/format.lux | 2 +- stdlib/source/test/lux/extension.lux | 3 +- stdlib/source/test/lux/macro/syntax.lux | 180 ++------- .../source/test/lux/macro/syntax/annotations.lux | 4 +- stdlib/source/test/lux/macro/syntax/check.lux | 6 +- .../source/test/lux/macro/syntax/declaration.lux | 4 +- stdlib/source/test/lux/macro/syntax/definition.lux | 8 +- stdlib/source/test/lux/macro/syntax/export.lux | 4 +- stdlib/source/test/lux/meta.lux | 415 +++++++++++++++++++-- 15 files changed, 470 insertions(+), 209 deletions(-) create mode 100644 stdlib/source/test/aedifex/artifact/time_stamp.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux index 60619f78b..dc2de91f7 100644 --- a/stdlib/source/test/aedifex/artifact.lux +++ b/stdlib/source/test/aedifex/artifact.lux @@ -21,7 +21,7 @@ ["." / #_ ["#." type] ["#." extension] - ["#." time_stamp #_ + ["#." time_stamp ["#/." date] ["#/." time]]] {#program @@ -45,6 +45,7 @@ /type.test /extension.test + /time_stamp.test /time_stamp/date.test /time_stamp/time.test )))) diff --git a/stdlib/source/test/aedifex/artifact/time_stamp.lux b/stdlib/source/test/aedifex/artifact/time_stamp.lux new file mode 100644 index 000000000..7dea57392 --- /dev/null +++ b/stdlib/source/test/aedifex/artifact/time_stamp.lux @@ -0,0 +1,33 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [control + ["." try ("#\." functor)] + [parser + ["<.>" text]]] + [math + ["." random (#+ Random)] + [number + ["n" nat] + ["i" int]]] + [time + ["." instant]]] + {#program + ["." /]}) + +(def: #export test + Test + (<| (_.covering /._) + (_.for [/.Time_Stamp]) + ($_ _.and + (do random.monad + [expected random.instant] + (_.cover [/.format /.parser] + (|> expected + /.format + (.run /.parser) + (try\map (\ instant.equivalence = expected)) + (try.default false)))) + ))) diff --git a/stdlib/source/test/lux/control/pipe.lux b/stdlib/source/test/lux/control/pipe.lux index cd57863b7..a9adcbf2e 100644 --- a/stdlib/source/test/lux/control/pipe.lux +++ b/stdlib/source/test/lux/control/pipe.lux @@ -1,6 +1,7 @@ (.module: [lux #* ["_" test (#+ Test)] + ["." debug] [abstract [monad (#+ do)]] [data @@ -70,7 +71,7 @@ (_.cover [/.exec>] (n.= (n.* 10 sample) (|> sample - (/.exec> [%.nat (format "sample = ") log!]) + (/.exec> [%.nat (format "sample = ") debug.log!]) (n.* 10)))) (_.cover [/.tuple>] (let [[left middle right] (|> sample diff --git a/stdlib/source/test/lux/data/product.lux b/stdlib/source/test/lux/data/product.lux index c33e60dd1..c20e7f5e9 100644 --- a/stdlib/source/test/lux/data/product.lux +++ b/stdlib/source/test/lux/data/product.lux @@ -62,8 +62,8 @@ (<| (_.cover [/.curry]) (n.= (n.+ left right) ((/.curry (/.uncurry n.+)) left right))) - (<| (_.cover [/.both]) - (let [[left' right'] (/.both (n.+ shift) (n.- shift) [left right])] + (<| (_.cover [/.apply]) + (let [[left' right'] (/.apply (n.+ shift) (n.- shift) [left right])] (and (n.= (n.+ shift left) left') (n.= (n.- shift right) right')))))) )))) diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index da108ede8..3b37382ae 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -60,14 +60,14 @@ (: (| Nat Nat)) (/.either (n.+ shift) (n.- shift)) (n.= (n.- shift expected))))) - (_.cover [/.each] + (_.cover [/.apply] (and (|> (/.left expected) (: (| Nat Nat)) - (/.each (n.+ shift) (n.- shift)) + (/.apply (n.+ shift) (n.- shift)) (case> (0 #0 actual) (n.= (n.+ shift expected) actual) _ false)) (|> (/.right expected) (: (| Nat Nat)) - (/.each (n.+ shift) (n.- shift)) + (/.apply (n.+ shift) (n.- shift)) (case> (0 #1 actual) (n.= (n.- shift expected) actual) _ false)))) (do ! [size (\ ! map (n.% 5) random.nat) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index 4308f8e95..a5d11685f 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -69,8 +69,8 @@ (let [value (/.enclose [left right] inner)] (and (/.starts_with? left value) (/.ends_with? right value)))) - (_.cover [/.encode] - (let [sample (/.encode inner)] + (_.cover [/.format] + (let [sample (/.format inner)] (and (/.encloses? /.double_quote sample) (/.contains? inner sample)))) )))) diff --git a/stdlib/source/test/lux/data/text/format.lux b/stdlib/source/test/lux/data/text/format.lux index 2aa33d2d4..0f61caa1f 100644 --- a/stdlib/source/test/lux/data/text/format.lux +++ b/stdlib/source/test/lux/data/text/format.lux @@ -134,7 +134,7 @@ (text\= ( sample) ( sample))))] - [/.text text.encode (random.unicode 5)] + [/.text text.format (random.unicode 5)] [/.code code.format $///code.random] [/.type type.format $///type.random] [/.location location.format diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index 9e8699c55..855c6e8bb 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -1,5 +1,6 @@ (.module: [lux #* + ["." debug] ["@" target ["." jvm] ["." js]] @@ -85,7 +86,7 @@ ## Directive (directive: (..my_directive self phase archive {parameters (<>.some .any)}) (do phase.monad - [#let [_ (log! (format "Successfully installed directive " (%.text self) "!"))]] + [#let [_ (debug.log! (format "Successfully installed directive " (%.text self) "!"))]] (wrap directive.no_requirements))) (`` ((~~ (static ..my_directive)))) diff --git a/stdlib/source/test/lux/macro/syntax.lux b/stdlib/source/test/lux/macro/syntax.lux index c2a1e63a5..f2fbe2010 100644 --- a/stdlib/source/test/lux/macro/syntax.lux +++ b/stdlib/source/test/lux/macro/syntax.lux @@ -1,158 +1,44 @@ (.module: [lux #* - ["%" data/text/format (#+ format)] - [abstract/monad (#+ do)] ["_" test (#+ Test)] [abstract - [equivalence (#+ Equivalence)]] - [control - ["." try (#+ Try)] - ["p" parser - ["s" code (#+ Parser)]]] - [data - ["." bit] - ["." name] - ["." text]] - [macro - ["." code]] + [monad (#+ do)]] [math - [random (#+ Random)] + ["." random] [number - ["." nat] - ["." int] - ["." rev] - ["." frac]]]] + ["n" nat]]]] {1 - ["." / (#+ syntax:)]}) - -(def: (enforced? parser input) - (-> (Parser []) (List Code) Bit) - (case (p.run parser input) - (#.Right [_ []]) - #1 - - _ - #0)) - -(def: (found? parser input) - (-> (Parser Bit) (List Code) Bit) - (case (p.run parser input) - (#.Right [_ #1]) - #1 - - _ - #0)) - -(def: (equals? Equivalence reference parser input) - (All [a] (-> (Equivalence a) a (Parser a) (List Code) Bit)) - (case (p.run parser input) - (#.Right [_ output]) - (\ Equivalence = reference output) - - _ - #0)) - -(def: (fails? input) - (All [a] (-> (Try a) Bit)) - (case input - (#.Left _) - #1 - - _ - #0)) - -(syntax: (match pattern input) - (wrap (list (` (case (~ input) - (^ (#.Right [(~' _) (~ pattern)])) - #1 - - (~' _) - #0))))) - -(def: simple_values - Test - (`` ($_ _.and - (~~ (template [ ] - [(_.test - (and (equals? (list ( ))) - (found? (p.parses? (s.this! ( ))) (list ( ))) - (enforced? (s.this! ( )) (list ( )))))] - - ["Can parse Bit syntax." #1 code.bit bit.equivalence s.bit] - ["Can parse Nat syntax." 123 code.nat nat.equivalence s.nat] - ["Can parse Int syntax." +123 code.int int.equivalence s.int] - ["Can parse Rev syntax." .123 code.rev rev.equivalence s.rev] - ["Can parse Frac syntax." +123.0 code.frac frac.equivalence s.frac] - ["Can parse Text syntax." text.new_line code.text text.equivalence s.text] - ["Can parse Identifier syntax." ["yolo" "lol"] code.identifier name.equivalence s.identifier] - ["Can parse Tag syntax." ["yolo" "lol"] code.tag name.equivalence s.tag] - )) - (_.test "Can parse identifiers belonging to the current namespace." - (and (match "yolo" - (p.run s.local_identifier - (list (code.local_identifier "yolo")))) - (fails? (p.run s.local_identifier - (list (code.identifier ["yolo" "lol"])))))) - (_.test "Can parse tags belonging to the current namespace." - (and (match "yolo" - (p.run s.local_tag - (list (code.local_tag "yolo")))) - (fails? (p.run s.local_tag - (list (code.tag ["yolo" "lol"])))))) - ))) - -(def: complex_values - Test - (`` ($_ _.and - (~~ (template [ ] - [(_.test (format "Can parse " " syntax.") - (and (match [#1 +123] - (p.run ( (p.and s.bit s.int)) - (list ( (list (code.bit #1) (code.int +123)))))) - (match #1 - (p.run ( s.bit) - (list ( (list (code.bit #1)))))) - (fails? (p.run ( s.bit) - (list ( (list (code.bit #1) (code.int +123)))))) - (match (#.Left #1) - (p.run ( (p.or s.bit s.int)) - (list ( (list (code.bit #1)))))) - (match (#.Right +123) - (p.run ( (p.or s.bit s.int)) - (list ( (list (code.int +123)))))) - (fails? (p.run ( (p.or s.bit s.int)) - (list ( (list (code.frac +123.0))))))))] - - ["form" s.form code.form] - ["tuple" s.tuple code.tuple])) - (_.test "Can parse record syntax." - (match [#1 +123] - (p.run (s.record (p.and s.bit s.int)) - (list (code.record (list [(code.bit #1) (code.int +123)])))))) - ))) + ["." /]} + ["." / #_ + ["#." annotations] + ["#." check] + ["#." declaration] + ["#." definition] + ["#." export] + ["#." input] + ["#." type #_ + ["#/." variable]]]) + +(/.syntax: (+/3 a b c) + (wrap (list (` ($_ n.+ (~ a) (~ b) (~ c)))))) (def: #export test Test - (<| (_.context (name.module (name_of /._))) + (<| (_.covering /._) ($_ _.and - ..simple_values - ..complex_values - ($_ _.and - (_.test "Can parse any Code." - (match [_ (#.Bit #1)] - (p.run s.any - (list (code.bit #1) (code.int +123))))) - (_.test "Can check whether the end has been reached." - (and (match #1 - (p.run s.end? - (list))) - (match #0 - (p.run s.end? - (list (code.bit #1)))))) - (_.test "Can ensure the end has been reached." - (and (match [] - (p.run s.end! - (list))) - (fails? (p.run s.end! - (list (code.bit #1)))))) - )))) + (do random.monad + [x random.nat + y random.nat + z random.nat] + (_.cover [/.syntax:] + (n.= ($_ n.+ x y z) + (+/3 x y z)))) + + /annotations.test + /check.test + /declaration.test + /definition.test + /export.test + /input.test + /type/variable.test + ))) diff --git a/stdlib/source/test/lux/macro/syntax/annotations.lux b/stdlib/source/test/lux/macro/syntax/annotations.lux index 564af4ea1..dac3c1e16 100644 --- a/stdlib/source/test/lux/macro/syntax/annotations.lux +++ b/stdlib/source/test/lux/macro/syntax/annotations.lux @@ -42,9 +42,9 @@ (list.empty? /.empty)) (do random.monad [expected ..random] - (_.cover [/.write /.parser] + (_.cover [/.format /.parser] (case (.run /.parser - (list (/.write expected))) + (list (/.format expected))) (#try.Failure _) false diff --git a/stdlib/source/test/lux/macro/syntax/check.lux b/stdlib/source/test/lux/macro/syntax/check.lux index 898ad8abb..d5036d9b2 100644 --- a/stdlib/source/test/lux/macro/syntax/check.lux +++ b/stdlib/source/test/lux/macro/syntax/check.lux @@ -36,10 +36,10 @@ (do random.monad [[type value] ..random] - (_.cover [/.write /.parser] + (_.cover [/.format /.parser] (case (.run /.parser - (list (/.write {#/.type type - #/.value value}))) + (list (/.format {#/.type type + #/.value value}))) (#try.Failure _) false diff --git a/stdlib/source/test/lux/macro/syntax/declaration.lux b/stdlib/source/test/lux/macro/syntax/declaration.lux index a9bc23296..2cb737caf 100644 --- a/stdlib/source/test/lux/macro/syntax/declaration.lux +++ b/stdlib/source/test/lux/macro/syntax/declaration.lux @@ -37,9 +37,9 @@ (do random.monad [expected ..random] - (_.cover [/.write /.parser] + (_.cover [/.format /.parser] (case (.run /.parser - (list (/.write expected))) + (list (/.format expected))) (#try.Failure _) false diff --git a/stdlib/source/test/lux/macro/syntax/definition.lux b/stdlib/source/test/lux/macro/syntax/definition.lux index d6b101894..be6f05449 100644 --- a/stdlib/source/test/lux/macro/syntax/definition.lux +++ b/stdlib/source/test/lux/macro/syntax/definition.lux @@ -67,9 +67,9 @@ type $///code.random untyped_value $///code.random] ($_ _.and - (_.cover [/.write /.parser] + (_.cover [/.format /.parser] (case (.run (/.parser compiler) - (list (/.write expected))) + (list (/.format expected))) (#try.Failure error) false @@ -78,7 +78,7 @@ (_.cover [/.typed] (let [expected (set@ #/.value (#.Left [type untyped_value]) expected)] (case (.run (/.typed compiler) - (list (/.write expected))) + (list (/.format expected))) (#try.Failure error) false @@ -87,7 +87,7 @@ (_.cover [/.lacks_type!] (let [expected (set@ #/.value (#.Right untyped_value) expected)] (case (.run (/.typed compiler) - (list (/.write expected))) + (list (/.format expected))) (#try.Failure error) (exception.match? /.lacks_type! error) diff --git a/stdlib/source/test/lux/macro/syntax/export.lux b/stdlib/source/test/lux/macro/syntax/export.lux index 59b72eb0f..34c19a11f 100644 --- a/stdlib/source/test/lux/macro/syntax/export.lux +++ b/stdlib/source/test/lux/macro/syntax/export.lux @@ -19,9 +19,9 @@ (<| (_.covering /._) (do random.monad [expected random.bit] - (_.cover [/.write /.parser] + (_.cover [/.format /.parser] (case (.run /.parser - (/.write expected)) + (/.format expected)) (#try.Failure _) false diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux index 2315165ef..c1972a991 100644 --- a/stdlib/source/test/lux/meta.lux +++ b/stdlib/source/test/lux/meta.lux @@ -11,8 +11,11 @@ [control ["." try]] [data + ["." bit ("#\." equivalence)] ["." text ("#\." equivalence) - ["%" format (#+ format)]]] + ["%" format (#+ format)]] + [collection + ["." list]]] [meta ["." location]] [math @@ -41,10 +44,6 @@ expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) - expected_error (random.ascii/upper_alpha 1) - expected_short (random.ascii/upper_alpha 1) - dummy_module (random.filter (|>> (text\= expected_current_module) not) - (random.ascii/upper_alpha 1)) expected_gensym (random.ascii/upper_alpha 1) #let [expected_lux {#.info {#.target target #.version version @@ -166,17 +165,26 @@ expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) - expected_error (random.ascii/upper_alpha 1) expected_short (random.ascii/upper_alpha 1) dummy_module (random.filter (|>> (text\= expected_current_module) not) (random.ascii/upper_alpha 1)) - #let [expected_lux {#.info {#.target target + #let [expected_module {#.module_hash 0 + #.module_aliases (list) + #.definitions (list) + #.imports (list) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active} + expected_modules (list [expected_current_module + expected_module]) + expected_lux {#.info {#.target target #.version version #.mode #.Build} #.source [location.dummy 0 source_code] #.location location.dummy #.current_module (#.Some expected_current_module) - #.modules (list) + #.modules expected_modules #.scopes (list) #.type_context {#.ex_counter 0 #.var_counter 0 @@ -192,6 +200,28 @@ (/.run expected_lux) (!expect (^multi (#try.Success actual_current_module) (text\= expected_current_module actual_current_module))))) + (_.cover [/.current_module] + (|> /.current_module + (/.run expected_lux) + (!expect (^multi (#try.Success actual_module) + (is? expected_module actual_module))))) + (_.cover [/.find_module] + (|> (/.find_module expected_current_module) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_module) + (is? expected_module actual_module))))) + (_.cover [/.module_exists?] + (and (|> (/.module_exists? expected_current_module) + (/.run expected_lux) + (!expect (#try.Success #1))) + (|> (/.module_exists? dummy_module) + (/.run expected_lux) + (!expect (#try.Success #0))))) + (_.cover [/.modules] + (|> /.modules + (/.run expected_lux) + (!expect (^multi (#try.Success actual_modules) + (is? expected_modules actual_modules))))) (_.cover [/.normalize] (and (|> (/.normalize ["" expected_short]) (/.run expected_lux) @@ -212,6 +242,342 @@ random.nat random.nat)) +(def: context_related + (do {! random.monad} + [target (random.ascii/upper_alpha 1) + version (random.ascii/upper_alpha 1) + source_code (random.ascii/upper_alpha 1) + expected_current_module (random.ascii/upper_alpha 1) + expected_type (\ ! map (function (_ name) + (#.Primitive name (list))) + (random.ascii/upper_alpha 1)) + expected_seed random.nat + expected random.nat + dummy (random.filter (|>> (n.= expected) not) random.nat) + expected_gensym (random.ascii/upper_alpha 1) + expected_location ..random_location + #let [expected_lux {#.info {#.target target + #.version version + #.mode #.Build} + #.source [location.dummy 0 source_code] + #.location expected_location + #.current_module (#.Some expected_current_module) + #.modules (list) + #.scopes (list) + #.type_context {#.ex_counter 0 + #.var_counter 0 + #.var_bindings (list)} + #.expected (#.Some expected_type) + #.seed expected_seed + #.scope_type_vars (list) + #.extensions [] + #.host []}]] + ($_ _.and + (_.cover [/.count] + (|> (do /.monad + [pre /.count + post /.count] + (wrap [pre post])) + (/.run expected_lux) + (!expect (^multi (#try.Success [actual_pre actual_post]) + (and (n.= expected_seed actual_pre) + (n.= (inc expected_seed) actual_post)))))) + (_.cover [/.gensym] + (|> (/.gensym expected_gensym) + (\ /.monad map %.code) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_gensym) + (and (text.contains? expected_gensym actual_gensym) + (text.contains? (%.nat expected_seed) actual_gensym)))))) + (_.cover [/.location] + (|> /.location + (/.run expected_lux) + (!expect (^multi (#try.Success actual_location) + (is? expected_location actual_location))))) + (_.cover [/.expected_type] + (|> /.expected_type + (/.run expected_lux) + (!expect (^multi (#try.Success actual_type) + (is? expected_type actual_type))))) + ))) + +(def: definition_related + Test + (do {! random.monad} + [expected_current_module (random.ascii/upper_alpha 1) + expected_macro_module (random.filter (|>> (text\= expected_current_module) not) + (random.ascii/upper_alpha 1)) + expected_short (random.ascii/upper_alpha 1) + expected_type (\ ! map (function (_ name) + (#.Primitive name (list))) + (random.ascii/upper_alpha 1)) + expected_value (random.either (wrap .def:) + (wrap .macro:)) + #let [expected_lux + (: (-> Bit (Maybe Type) + [(List [Text .Global]) + (List [Text .Global]) + Lux]) + (function (_ exported? def_type) + (let [current_globals (: (List [Text .Global]) + (list [expected_short + (#.Alias [expected_macro_module expected_short])])) + macro_globals (: (List [Text .Global]) + (case def_type + (#.Some def_type) + (list [expected_short + (#.Definition [exported? def_type (' []) expected_value])]) + + #.None + (list)))] + [current_globals + macro_globals + {#.info {#.target "" + #.version "" + #.mode #.Build} + #.source [location.dummy 0 ""] + #.location location.dummy + #.current_module (#.Some expected_current_module) + #.modules (list [expected_current_module + {#.module_hash 0 + #.module_aliases (list) + #.definitions current_globals + #.imports (list) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active}] + [expected_macro_module + {#.module_hash 0 + #.module_aliases (list) + #.definitions macro_globals + #.imports (list) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active}]) + #.scopes (list) + #.type_context {#.ex_counter 0 + #.var_counter 0 + #.var_bindings (list)} + #.expected #.None + #.seed 0 + #.scope_type_vars (list) + #.extensions [] + #.host []}])))]] + ($_ _.and + (_.cover [/.globals] + (let [[current_globals macro_globals expected_lux] + (expected_lux true (#.Some .Macro)) + + current_globals! + (|> (/.globals expected_current_module) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_globals) + (is? current_globals actual_globals)))) + + macro_globals! + (|> (/.globals expected_macro_module) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_globals) + (is? macro_globals actual_globals))))] + (and current_globals! + macro_globals!))) + (_.cover [/.definitions] + (let [[current_globals macro_globals expected_lux] + (expected_lux true (#.Some .Macro))] + (and (|> (/.definitions expected_current_module) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_definitions) + (n.= 0 (list.size actual_definitions))))) + (|> (/.definitions expected_macro_module) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_definitions) + (n.= 1 (list.size actual_definitions))))) + ))) + (_.cover [/.exports] + (and (let [[current_globals macro_globals expected_lux] + (expected_lux true (#.Some .Macro))] + (and (|> (/.exports expected_current_module) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_definitions) + (n.= 0 (list.size actual_definitions))))) + (|> (/.exports expected_macro_module) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_definitions) + (n.= 1 (list.size actual_definitions))))) + )) + (let [[current_globals macro_globals expected_lux] + (expected_lux false (#.Some .Macro))] + (and (|> (/.exports expected_current_module) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_definitions) + (n.= 0 (list.size actual_definitions))))) + (|> (/.exports expected_macro_module) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_definitions) + (n.= 0 (list.size actual_definitions))))) + )))) + ))) + +(def: search_related + Test + (do {! random.monad} + [expected_exported? random.bit + expected_current_module (random.ascii/upper_alpha 1) + expected_macro_module (random.filter (|>> (text\= expected_current_module) not) + (random.ascii/upper_alpha 1)) + expected_short (random.ascii/upper_alpha 1) + expected_type (\ ! map (function (_ name) + (#.Primitive name (list))) + (random.ascii/upper_alpha 1)) + #let [expected_annotations (' [])] + expected_value (random.either (wrap .def:) + (wrap .macro:)) + #let [expected_lux + (: (-> Bit (Maybe Type) + [(List [Text .Global]) + (List [Text .Global]) + Lux]) + (function (_ exported? def_type) + (let [current_globals (: (List [Text .Global]) + (list [expected_short + (#.Alias [expected_macro_module expected_short])])) + macro_globals (: (List [Text .Global]) + (case def_type + (#.Some def_type) + (list [expected_short + (#.Definition [exported? def_type expected_annotations expected_value])]) + + #.None + (list)))] + [current_globals + macro_globals + {#.info {#.target "" + #.version "" + #.mode #.Build} + #.source [location.dummy 0 ""] + #.location location.dummy + #.current_module (#.Some expected_current_module) + #.modules (list [expected_current_module + {#.module_hash 0 + #.module_aliases (list) + #.definitions current_globals + #.imports (list) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active}] + [expected_macro_module + {#.module_hash 0 + #.module_aliases (list) + #.definitions macro_globals + #.imports (list) + #.tags (list) + #.types (list) + #.module_annotations #.None + #.module_state #.Active}]) + #.scopes (list) + #.type_context {#.ex_counter 0 + #.var_counter 0 + #.var_bindings (list)} + #.expected #.None + #.seed 0 + #.scope_type_vars (list) + #.extensions [] + #.host []}])))]] + ($_ _.and + (_.cover [/.find_macro] + (let [same_module! + (let [[current_globals macro_globals expected_lux] + (expected_lux true (#.Some .Macro))] + (|> (/.find_macro [expected_macro_module expected_short]) + (/.run expected_lux) + (!expect (^multi (#try.Success (#.Some actual_value)) + (is? expected_value actual_value))))) + + not_macro! + (let [[current_globals macro_globals expected_lux] + (expected_lux true (#.Some expected_type))] + (|> (/.find_macro [expected_macro_module expected_short]) + (/.run expected_lux) + (!expect (#try.Success #.None)))) + + not_found! + (let [[current_globals macro_globals expected_lux] + (expected_lux true #.None)] + (|> (/.find_macro [expected_macro_module expected_short]) + (/.run expected_lux) + (!expect (#try.Success #.None)))) + + aliasing! + (let [[current_globals macro_globals expected_lux] + (expected_lux true (#.Some .Macro))] + (|> (/.find_macro [expected_current_module expected_short]) + (/.run expected_lux) + (!expect (^multi (#try.Success (#.Some actual_value)) + (is? expected_value actual_value)))))] + (and same_module! + not_macro! + not_found! + aliasing!))) + (_.cover [/.find_def] + (let [[current_globals macro_globals expected_lux] + (expected_lux expected_exported? (#.Some expected_type)) + + definition! + (|> (/.find_def [expected_macro_module expected_short]) + (/.run expected_lux) + (!expect (^multi (#try.Success (#.Definition [actual_exported? actual_type actual_annotations actual_value])) + (and (bit\= expected_exported? actual_exported?) + (is? expected_type actual_type) + (is? expected_annotations actual_annotations) + (is? (:coerce Any expected_value) actual_value))))) + + alias! + (|> (/.find_def [expected_current_module expected_short]) + (/.run expected_lux) + (!expect (^multi (#try.Success (#.Alias [actual_module actual_short])) + (and (is? expected_macro_module actual_module) + (is? expected_short actual_short)))))] + (and definition! + alias!))) + (_.cover [/.find_def_type] + (let [[current_globals macro_globals expected_lux] + (expected_lux expected_exported? (#.Some expected_type)) + + definition! + (|> (/.find_def_type [expected_macro_module expected_short]) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_type) + (is? expected_type actual_type)))) + + alias! + (|> (/.find_def_type [expected_current_module expected_short]) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_type) + (is? expected_type actual_type))))] + (and definition! + alias!))) + (_.cover [/.find_type_def] + (let [[current_globals macro_globals expected_lux] + (expected_lux expected_exported? (#.Some .Type)) + + definition! + (|> (/.find_type_def [expected_macro_module expected_short]) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_value) + (is? (:coerce .Type expected_value) actual_value)))) + + alias! + (|> (/.find_type_def [expected_current_module expected_short]) + (/.run expected_lux) + (!expect (^multi (#try.Success actual_value) + (is? (:coerce .Type expected_value) actual_value))))] + (and definition! + alias!))) + ))) + (def: injection (Injection Meta) (\ /.monad wrap)) @@ -242,10 +608,6 @@ expected_seed random.nat expected random.nat dummy (random.filter (|>> (n.= expected) not) random.nat) - expected_error (random.ascii/upper_alpha 1) - expected_short (random.ascii/upper_alpha 1) - dummy_module (random.filter (|>> (text\= expected_current_module) not) - (random.ascii/upper_alpha 1)) expected_gensym (random.ascii/upper_alpha 1) expected_location ..random_location #let [expected_lux {#.info {#.target target @@ -275,32 +637,9 @@ ..compiler_related ..error_handling ..module_related - (_.cover [/.count] - (|> (do /.monad - [pre /.count - post /.count] - (wrap [pre post])) - (/.run expected_lux) - (!expect (^multi (#try.Success [actual_pre actual_post]) - (and (n.= expected_seed actual_pre) - (n.= (inc expected_seed) actual_post)))))) - (_.cover [/.gensym] - (|> (/.gensym expected_gensym) - (\ /.monad map %.code) - (/.run expected_lux) - (!expect (^multi (#try.Success actual_gensym) - (and (text.contains? expected_gensym actual_gensym) - (text.contains? (%.nat expected_seed) actual_gensym)))))) - (_.cover [/.location] - (|> /.location - (/.run expected_lux) - (!expect (^multi (#try.Success actual_location) - (is? expected_location actual_location))))) - (_.cover [/.expected_type] - (|> /.expected_type - (/.run expected_lux) - (!expect (^multi (#try.Success actual_type) - (is? expected_type actual_type))))) + ..context_related + ..definition_related + ..search_related )) /annotation.test -- cgit v1.2.3