diff options
author | Eduardo Julian | 2022-01-20 04:30:57 -0400 |
---|---|---|
committer | Eduardo Julian | 2022-01-20 04:30:57 -0400 |
commit | 14bf4ffe5d7d88692ab895f96a2bb6a829a406de (patch) | |
tree | ef9204bb10c817c6d7feddfa20c7305dbc6a042d /stdlib/source/test | |
parent | c98d05fcb43714dc7e2ce07ab3fa17b78f21b3bf (diff) |
Better text formatting for types.
Diffstat (limited to 'stdlib/source/test')
-rw-r--r-- | stdlib/source/test/lux/control/parser/type.lux | 91 | ||||
-rw-r--r-- | stdlib/source/test/lux/meta/symbol.lux | 56 | ||||
-rw-r--r-- | stdlib/source/test/lux/tool.lux | 4 | ||||
-rw-r--r-- | stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux | 173 |
4 files changed, 268 insertions, 56 deletions
diff --git a/stdlib/source/test/lux/control/parser/type.lux b/stdlib/source/test/lux/control/parser/type.lux index 360826130..39656a32c 100644 --- a/stdlib/source/test/lux/control/parser/type.lux +++ b/stdlib/source/test/lux/control/parser/type.lux @@ -1,25 +1,27 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [control - ["[0]" try] - ["[0]" exception]] - [data - [collection - ["[0]" list]]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]] - [meta - ["[0]" symbol ("[1]#[0]" equivalence)]] - ["[0]" type ("[1]#[0]" equivalence)]]] - [\\library - ["[0]" / - ["/[1]" //]]]) + [library + [lux "*" + ["_" test {"+" Test}] + ["[0]" type ("[1]#[0]" equivalence)] + [abstract + [monad {"+" do}]] + [control + ["[0]" try] + ["[0]" exception]] + [data + [text + ["%" format {"+" format}]] + [collection + ["[0]" list]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]] + [meta + ["[0]" symbol ("[1]#[0]" equivalence)]]]] + [\\library + ["[0]" / + ["/[1]" //]]]) (template: (!expect <pattern> <value>) [(case <value> @@ -35,7 +37,7 @@ (# random.monad each (function (_ name) {.#Primitive name (list)})))) -(def: matches +(def: test|matches Test (<| (_.for [/.types_do_not_match]) (do [! random.monad] @@ -71,7 +73,7 @@ (exception.match? /.types_do_not_match error)))))) ))) -(def: aggregate +(def: test|aggregate Test (do [! random.monad] [expected_left ..primitive @@ -119,7 +121,7 @@ (exception.match? /.not_application error)))))) )))) -(def: parameter +(def: test|parameter Test (do random.monad [quantification ..primitive @@ -163,7 +165,7 @@ (!expect {try.#Success [quantification##binding argument##binding _]}))) ))) -(def: polymorphic +(def: test|polymorphic Test (do [! random.monad] [not_polymorphic ..primitive @@ -186,6 +188,36 @@ (same? not_polymorphic bodyT)))))) ))) +(def: test|recursive + Test + (do random.monad + [expected ..primitive] + ($_ _.and + (_.cover [/.recursive] + (|> (.type (Rec @ expected)) + (/.result (/.recursive /.any)) + (!expect (^multi {try.#Success [@self actual]} + (type#= expected actual))))) + (_.cover [/.recursive_self] + (|> (.type (Rec @ @)) + (/.result (/.recursive /.recursive_self)) + (!expect (^multi {try.#Success [@expected @actual]} + (same? @expected @actual))))) + (_.cover [/.recursive_call] + (|> (.type (All (self input) (self input))) + (/.result (/.polymorphic /.recursive_call)) + (!expect {try.#Success [@self inputs ???]}))) + (_.cover [/.not_recursive] + (and (|> expected + (/.result (/.recursive /.any)) + (!expect (^multi {try.#Failure error} + (exception.match? /.not_recursive error)))) + (|> expected + (/.result /.recursive_self) + (!expect (^multi {try.#Failure error} + (exception.match? /.not_recursive error)))))) + ))) + (def: .public test Test (<| (_.covering /._) @@ -263,8 +295,9 @@ (!expect (^multi {try.#Success [actual_name actual_type]} (and (symbol#= expected_name actual_name) (type#= expected_type actual_type))))))) - ..aggregate - ..matches - ..parameter - ..polymorphic + ..test|aggregate + ..test|matches + ..test|parameter + ..test|polymorphic + ..test|recursive ))) diff --git a/stdlib/source/test/lux/meta/symbol.lux b/stdlib/source/test/lux/meta/symbol.lux index cdd051770..3e4233939 100644 --- a/stdlib/source/test/lux/meta/symbol.lux +++ b/stdlib/source/test/lux/meta/symbol.lux @@ -1,24 +1,24 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence] - ["$[0]" hash] - ["$[0]" order] - ["$[0]" codec]]] - [control - pipe] - [data - ["[0]" text ("[1]#[0]" equivalence)]] - [math - ["[0]" random {"+" Random}] - [number - ["n" nat]]]]] - [\\library - ["[0]" /]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence] + ["$[0]" hash] + ["$[0]" order] + ["$[0]" codec]]] + [control + pipe] + [data + ["[0]" text]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" /]]) (def: .public (random module_size short_size) (-> Nat Nat (Random Symbol)) @@ -49,12 +49,16 @@ ($order.spec /.order (..random sizeM1 sizeS1))) (_.for [/.codec] (_.and ($codec.spec /.equivalence /.codec (..random sizeM1 sizeS1)) - (let [(^open "/#[0]") /.codec] - (_.test "Encoding a symbol without a module component results in text equal to the short of the symbol." - (if (text.empty? module1) - (text#= short1 (/#encoded symbol1)) - #1))))) - + (_.test "Encoding a symbol without a module component results in text equal to the short of the symbol." + (if (text.empty? module1) + (same? short1 (# /.codec encoded symbol1)) + #1)))) + + (_.cover [/.separator] + (let [it (# /.codec encoded symbol1)] + (if (text.empty? module1) + (same? short1 it) + (text.contains? /.separator it)))) (_.cover [/.module /.short] (and (same? module1 (/.module symbol1)) (same? short1 (/.short symbol1)))) diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index 78aaee40e..219151d6c 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -23,7 +23,8 @@ ["[1]/[0]" artifact] ["[1]/[0]" signature] ["[1]/[0]" key] - ["[1]/[0]" document]]] + ["[1]/[0]" document] + ["[1]/[0]" registry]]] ]]) (def: .public test @@ -38,6 +39,7 @@ /meta/archive/signature.test /meta/archive/key.test /meta/archive/document.test + /meta/archive/registry.test /phase/extension.test /phase/analysis/simple.test ... /syntax.test diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux new file mode 100644 index 000000000..feee41b0a --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux @@ -0,0 +1,173 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] + [parser + ["<[0]>" binary]]] + [data + ["[0]" product] + ["[0]" text] + [collection + ["[0]" sequence {"+" Sequence}] + ["[0]" set {"+" Set}] + ["[0]" list ("[1]#[0]" mix)]] + [format + ["[0]" binary]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]]]] + [\\library + ["[0]" / + [// + ["[0]" artifact + ["[0]" category]]]]]) + +(template: (tagged? <tag> <it>) + [(case <it> + {<tag> _} + true + + _ + false)]) + +(def: random_dependency + (Random artifact.Dependency) + ($_ random.and + random.nat + random.nat + )) + +(def: (random_dependencies amount) + (-> Nat (Random (Set artifact.Dependency))) + (random.set artifact.dependency_hash amount ..random_dependency)) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Registry]) + (do [! random.monad] + [expected_name (random.ascii/lower 5) + mandatory? random.bit + expected_dependencies (..random_dependencies 5) + + expected_amount (# ! each (n.% 10) random.nat) + expected_names (|> (random.ascii/lower 1) + (random.set text.hash expected_amount) + (# ! each set.list))] + (`` ($_ _.and + (_.cover [/.empty] + (|> /.empty + /.artifacts + sequence.size + (n.= 0))) + (_.cover [/.resource] + (let [[@it registry] (/.resource mandatory? expected_dependencies /.empty)] + (case (sequence.list (/.artifacts registry)) + (^ (list [artifact actual_dependencies])) + (and (same? @it (value@ artifact.#id artifact)) + (same? mandatory? (value@ artifact.#mandatory? artifact)) + (tagged? category.#Anonymous (value@ artifact.#category artifact)) + (same? expected_dependencies actual_dependencies)) + + _ + false))) + (~~ (template [<new> <query> <tag> <wrong_new>] + [(_.cover [<new> <query>] + (and (let [[@it registry] (<new> expected_name mandatory? expected_dependencies /.empty)] + (and (case (<query> registry) + (^ (list actual_name)) + (same? expected_name actual_name) + + _ + false) + (case (sequence.list (/.artifacts registry)) + (^ (list [artifact actual_dependencies])) + (and (same? @it (value@ artifact.#id artifact)) + (same? mandatory? (value@ artifact.#mandatory? artifact)) + (case (value@ artifact.#category artifact) + {<tag> actual_name} + (same? expected_name actual_name) + + _ + false) + (same? expected_dependencies actual_dependencies)) + + _ + false))) + (let [[@it registry] (<wrong_new> expected_name mandatory? expected_dependencies /.empty)] + (case (<query> registry) + (^ (list)) + true + + _ + false))))] + + [/.definition /.definitions category.#Definition /.analyser] + [/.analyser /.analysers category.#Analyser /.synthesizer] + [/.synthesizer /.synthesizers category.#Synthesizer /.generator] + [/.generator /.generators category.#Generator /.directive] + [/.directive /.directives category.#Directive /.custom] + [/.custom /.customs category.#Custom /.definition] + )) + (_.cover [/.id] + (and (~~ (template [<new>] + [(let [[@expected registry] (<new> expected_name mandatory? expected_dependencies /.empty)] + (|> (/.id expected_name registry) + (maybe#each (same? @expected)) + (maybe.else false)))] + + [/.definition] + [/.analyser] + [/.synthesizer] + [/.generator] + [/.directive] + [/.custom] + )))) + (_.cover [/.artifacts] + (and (~~ (template [<new> <query>] + [(let [[ids registry] (: [(Sequence artifact.ID) /.Registry] + (list#mix (function (_ name [ids registry]) + (let [[@new registry] (<new> name mandatory? expected_dependencies registry)] + [(sequence.suffix @new ids) registry])) + [sequence.empty /.empty] + expected_names)) + it (/.artifacts registry)] + (and (n.= expected_amount (sequence.size it)) + (n.= expected_amount (sequence.size it)) + (list.every? (function (_ [@it [it dependencies]]) + (same? @it (value@ artifact.#id it))) + (list.zipped/2 (sequence.list ids) (sequence.list it))) + (# (list.equivalence text.equivalence) = expected_names (<query> registry))))] + + [/.definition /.definitions] + [/.analyser /.analysers] + [/.synthesizer /.synthesizers] + [/.generator /.generators] + [/.directive /.directives] + [/.custom /.customs] + )))) + (_.cover [/.writer /.parser] + (and (~~ (template [<new>] + [(let [[@expected before] (<new> expected_name mandatory? expected_dependencies /.empty)] + (|> before + (binary.result /.writer) + (<binary>.result /.parser) + (try#each (|>> (/.id expected_name) + (maybe#each (same? @expected)) + (maybe.else false))) + (try.else false)))] + + [/.definition] + [/.analyser] + [/.synthesizer] + [/.generator] + [/.directive] + [/.custom] + )))) + ))))) |