aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/lux/control/parser/type.lux91
-rw-r--r--stdlib/source/test/lux/meta/symbol.lux56
-rw-r--r--stdlib/source/test/lux/tool.lux4
-rw-r--r--stdlib/source/test/lux/tool/compiler/meta/archive/registry.lux173
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]
+ ))))
+ )))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-21 08:41:58 +0000