diff options
Diffstat (limited to '')
-rw-r--r-- | stdlib/source/test/lux/tool.lux | 19 | ||||
-rw-r--r-- | stdlib/source/test/lux/tool/compiler/meta/archive.lux | 258 | ||||
-rw-r--r-- | stdlib/source/test/lux/tool/compiler/meta/archive/module.lux | 8 | ||||
-rw-r--r-- | stdlib/source/test/lux/tool/compiler/meta/archive/module/descriptor.lux (renamed from stdlib/source/test/lux/tool/compiler/meta/archive/descriptor.lux) | 7 | ||||
-rw-r--r-- | stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux (renamed from stdlib/source/test/lux/tool/compiler/meta/archive/document.lux) | 8 | ||||
-rw-r--r-- | stdlib/source/test/lux/tool/compiler/meta/archive/signature.lux | 4 |
6 files changed, 278 insertions, 26 deletions
diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index c05f16b50..82e92e097 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -19,15 +19,7 @@ ... ["[1]/[0]" synthesis] ]]] ["[1][0]" meta "_" - ["[1]/[0]" archive "_" - ["[1]/[0]" signature] - ["[1]/[0]" key] - ["[1]/[0]" artifact] - ["[1]/[0]" registry] - ["[1]/[0]" module] - ["[1]/[0]" document] - ["[1]/[0]" descriptor] - ["[1]/[0]" unit]]] + ["[1]/[0]" archive]] ]]) (def: .public test @@ -38,14 +30,7 @@ /reference.test /phase.test /analysis.test - /meta/archive/signature.test - /meta/archive/key.test - /meta/archive/artifact.test - /meta/archive/registry.test - /meta/archive/module.test - /meta/archive/document.test - /meta/archive/descriptor.test - /meta/archive/unit.test + /meta/archive.test /phase/extension.test /phase/analysis/simple.test ... /syntax.test diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive.lux b/stdlib/source/test/lux/tool/compiler/meta/archive.lux new file mode 100644 index 000000000..62dbff389 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/meta/archive.lux @@ -0,0 +1,258 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + [pipe {"+" case>}] + ["[0]" try] + ["[0]" exception]] + [data + ["[0]" product] + ["[0]" text + ["%" format {"+" format}]] + [collection + ["[0]" list] + ["[0]" set ("[1]#[0]" equivalence)] + ["[0]" sequence]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]] + [meta + ["[0]" symbol "_" + ["$[1]" \\test]]]]] + [\\library + ["[0]" / + ["[1][0]" key] + ["[1][0]" registry] + ["[1][0]" signature] + ["[1][0]" module + ["[2][0]" document] + ["[2][0]" descriptor]]]] + ["$[0]" / "_" + ["[1][0]" signature] + ["[1][0]" key] + ["[1][0]" artifact] + ["[1][0]" registry] + ["[1][0]" module] + ["[1][0]" unit]]) + +(def: (descriptor module hash) + (-> /descriptor.Module Nat /descriptor.Descriptor) + [/descriptor.#name module + /descriptor.#file (format module ".lux") + /descriptor.#hash hash + /descriptor.#state {.#Active} + /descriptor.#references (set.empty text.hash)]) + +(def: test|entry + Test + (do random.monad + [module/0 (random.ascii/lower 1) + module/1 (random.ascii/lower 2) + signature $/signature.random + .let [version (value@ /signature.#version signature)] + fake_version (random.only (|>> (n.= version) not) random.nat) + content/0 random.nat + content/1 (random.only (|>> (n.= content/0) not) random.nat) + hash random.nat + .let [key (/key.key signature content/0)]] + ($_ _.and + (_.cover [/.has /.find] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + .let [entry [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry archive) + entry' (/.find module/0 archive)] + (in (same? entry entry'))) + (try.else false))) + (_.cover [/.module_is_only_reserved] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + entry' (/.find module/0 archive)] + (in false)) + (exception.otherwise (exception.match? /.module_is_only_reserved)))) + (_.cover [/.cannot_replace_document] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + .let [entry/0 [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty] + entry/1 [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/1)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry/0 archive) + archive (/.has module/0 entry/1 archive)] + (in false)) + (exception.otherwise (exception.match? /.cannot_replace_document)))) + (_.cover [/.module_must_be_reserved_before_it_can_be_added] + (|> (do try.monad + [.let [entry [/.#module [/module.#id 0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry /.empty)] + (in false)) + (exception.otherwise (exception.match? /.module_must_be_reserved_before_it_can_be_added)))) + (_.cover [/.archived?] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + .let [pre (/.archived? archive module/0) + entry [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry archive) + .let [post (/.archived? archive module/0)]] + (in (and (not pre) post))) + (try.else false))) + (_.cover [/.unknown_document] + (and (|> (do try.monad + [_ (/.id module/0 /.empty)] + (in false)) + (exception.otherwise (exception.match? /.unknown_document))) + (|> (do try.monad + [_ (/.find module/0 /.empty)] + (in false)) + (exception.otherwise (exception.match? /.unknown_document))))) + (_.cover [/.archived] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + .let [pre (/.archived archive) + entry [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry archive) + .let [post (/.archived archive) + (^open "list#[0]") (list.equivalence text.equivalence)]] + (in (and (list#= (list) pre) + (list#= (list module/0) post)))) + (try.else false))) + (_.cover [/.entries] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + .let [pre (/.entries archive) + entry [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry archive)] + (in (and (list.empty? pre) + (case (/.entries archive) + (^ (list [module/0' @module/0' entry'])) + (and (same? module/0 module/0') + (same? @module/0 @module/0') + (same? entry entry')) + + _ + false)))) + (try.else false))) + (_.cover [/.export /.import] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + [@module/1 archive] (/.reserve module/1 archive) + .let [entry/0 [/.#module [/module.#id @module/0 + /module.#descriptor (..descriptor module/0 hash) + /module.#document (/document.document key content/0)] + /.#output sequence.empty + /.#registry /registry.empty] + entry/1 [/.#module [/module.#id @module/1 + /module.#descriptor (..descriptor module/1 hash) + /module.#document (/document.document key content/1)] + /.#output sequence.empty + /.#registry /registry.empty]] + archive (/.has module/0 entry/0 archive) + archive (/.has module/1 entry/1 archive) + .let [pre (/.reserved archive)] + archive (|> archive + (/.export version) + (/.import version)) + .let [post (/.reserved archive)]] + (in (set#= (set.of_list text.hash pre) + (set.of_list text.hash post)))) + (try.else false))) + (_.cover [/.version_mismatch] + (|> (do try.monad + [archive (|> /.empty + (/.export version) + (/.import fake_version))] + (in false)) + (exception.otherwise (exception.match? /.version_mismatch)))) + ))) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Archive]) + (do random.monad + [module/0 (random.ascii/lower 1) + module/1 (random.ascii/lower 2) + signature $/signature.random + content/0 random.nat + content/1 (random.only (|>> (n.= content/0) not) random.nat) + hash random.nat + .let [key (/key.key signature content/0)]]) + ($_ _.and + (_.cover [/.empty] + (list.empty? (/.entries /.empty))) + (_.cover [/.reserve /.id] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + [@module/1 archive] (/.reserve module/1 archive) + @module/0' (/.id module/0 archive) + @module/1' (/.id module/1 archive)] + (in (and (same? @module/0 @module/0') + (same? @module/1 @module/1')))) + (try.else false))) + (_.cover [/.reserved] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + [@module/1 archive] (/.reserve module/1 archive)] + (in (set#= (set.of_list text.hash (list module/0 module/1)) + (set.of_list text.hash (/.reserved archive))))) + (try.else false))) + (_.cover [/.reservations] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + [@module/1 archive] (/.reserve module/1 archive) + .let [hash (product.hash text.hash n.hash)]] + (in (set#= (set.of_list hash (list [module/0 @module/0] [module/1 @module/1])) + (set.of_list hash (/.reservations archive))))) + (try.else false))) + (_.cover [/.module_has_already_been_reserved] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty) + _ (/.reserve module/0 archive)] + (in false)) + (exception.otherwise (exception.match? /.module_has_already_been_reserved)))) + (_.cover [/.reserved?] + (|> (do try.monad + [[@module/0 archive] (/.reserve module/0 /.empty)] + (in (and (/.reserved? archive module/0) + (not (/.reserved? archive module/1))))) + (try.else false))) + (_.for [/.Entry] + ..test|entry) + + $/signature.test + $/key.test + $/artifact.test + $/registry.test + $/module.test + $/unit.test + ))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux index 3d0bc262e..311f1f80d 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/module.lux @@ -9,7 +9,10 @@ [number ["n" nat]]]]] [\\library - ["[0]" /]]) + ["[0]" /]] + ["[0]" / "_" + ["[1][0]" document] + ["[1][0]" descriptor]]) (def: .public test Test @@ -18,4 +21,7 @@ ($_ _.and (_.cover [/.ID /.runtime] (n.= 0 /.runtime)) + + /document.test + /descriptor.test ))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/descriptor.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/module/descriptor.lux index d9d0e09a2..95a290b11 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/descriptor.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/module/descriptor.lux @@ -11,7 +11,7 @@ [parser ["<[0]>" binary]]] [data - ["[0]" text] + ["[0]" text ("[1]#[0]" equivalence)] [format ["[0]" binary]]] [math @@ -40,13 +40,16 @@ (def: .public test Test (<| (_.covering /._) - (_.for [/.Descriptor /.Module]) + (_.for [/.Descriptor]) (do random.monad [expected (..random 5)]) ($_ _.and (_.for [/.equivalence] ($equivalence.spec /.equivalence (..random 1))) + (_.for [/.Module] + (_.cover [/.runtime] + (text#= "" /.runtime))) (_.cover [/.writer /.parser] (|> expected (binary.result /.writer) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/document.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux index 749dcdd09..a73bf751d 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/document.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux @@ -19,10 +19,10 @@ ["[0]" nat]]]]] [\\library ["[0]" / - [// + [/// ["[1][0]" signature ("[1]#[0]" equivalence)] ["[1][0]" key]]]] - ["[0]" // "_" + ["[0]" /// "_" ["[1][0]" signature]]) (def: .public test @@ -30,9 +30,9 @@ (<| (_.covering /._) (_.for [/.Document]) (do random.monad - [signature/0 //signature.random + [signature/0 ///signature.random signature/1 (random.only (|>> (/signature#= signature/0) not) - //signature.random) + ///signature.random) .let [key/0 (/key.key signature/0 0) key/1 (/key.key signature/1 0)] expected random.nat] diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/signature.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/signature.lux index 948329ada..85c19714c 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/signature.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/signature.lux @@ -26,8 +26,8 @@ (Random /.Signature) ($_ random.and ($_ random.and - (random.ascii/upper 5) - (random.ascii/lower 5)) + (random.ascii/upper 1) + (random.ascii/lower 1)) ////version.random )) |