From d432d4fc3990a073e8df091962ac1f39c9745803 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 31 Jan 2022 05:42:01 -0400 Subject: A few JVM-related fixes & improvements. --- stdlib/source/test/lux/tool.lux | 19 +- .../source/test/lux/tool/compiler/meta/archive.lux | 258 +++++++++++++++++++++ .../lux/tool/compiler/meta/archive/descriptor.lux | 56 ----- .../lux/tool/compiler/meta/archive/document.lux | 93 -------- .../test/lux/tool/compiler/meta/archive/module.lux | 8 +- .../compiler/meta/archive/module/descriptor.lux | 59 +++++ .../tool/compiler/meta/archive/module/document.lux | 93 ++++++++ .../lux/tool/compiler/meta/archive/signature.lux | 4 +- 8 files changed, 421 insertions(+), 169 deletions(-) create mode 100644 stdlib/source/test/lux/tool/compiler/meta/archive.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/archive/descriptor.lux delete mode 100644 stdlib/source/test/lux/tool/compiler/meta/archive/document.lux create mode 100644 stdlib/source/test/lux/tool/compiler/meta/archive/module/descriptor.lux create mode 100644 stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux (limited to 'stdlib/source/test') 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/descriptor.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/descriptor.lux deleted file mode 100644 index d9d0e09a2..000000000 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/descriptor.lux +++ /dev/null @@ -1,56 +0,0 @@ -(.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" equivalence]]] - [control - ["[0]" try ("[1]#[0]" functor)] - [parser - ["<[0]>" binary]]] - [data - ["[0]" text] - [format - ["[0]" binary]]] - [math - ["[0]" random {"+" Random} ("[1]#[0]" monad)]]]] - [\\library - ["[0]" /]]) - -(def: random_module_state - (Random Module_State) - ($_ random.or - (random#in []) - (random#in []) - (random#in []) - )) - -(def: .public (random imports) - (-> Nat (Random /.Descriptor)) - ($_ random.and - (random.ascii/lower 1) - (random.ascii/lower 1) - random.nat - ..random_module_state - (random.set text.hash imports (random.ascii/lower 2)) - )) - -(def: .public test - Test - (<| (_.covering /._) - (_.for [/.Descriptor /.Module]) - (do random.monad - [expected (..random 5)]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence (..random 1))) - - (_.cover [/.writer /.parser] - (|> expected - (binary.result /.writer) - (.result /.parser) - (try#each (|>> (# /.equivalence = (with@ /.#state {.#Cached} expected)))) - (try.else false))) - ))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/document.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/document.lux deleted file mode 100644 index 749dcdd09..000000000 --- a/stdlib/source/test/lux/tool/compiler/meta/archive/document.lux +++ /dev/null @@ -1,93 +0,0 @@ -(.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}]] - [control - [pipe {"+" case>}] - ["[0]" try ("[1]#[0]" functor)] - ["[0]" exception] - [parser - ["<[0]>" binary]]] - [data - [format - ["[0]F" binary]]] - [math - ["[0]" random] - [number - ["[0]" nat]]]]] - [\\library - ["[0]" / - [// - ["[1][0]" signature ("[1]#[0]" equivalence)] - ["[1][0]" key]]]] - ["[0]" // "_" - ["[1][0]" signature]]) - -(def: .public test - Test - (<| (_.covering /._) - (_.for [/.Document]) - (do random.monad - [signature/0 //signature.random - signature/1 (random.only (|>> (/signature#= signature/0) not) - //signature.random) - .let [key/0 (/key.key signature/0 0) - key/1 (/key.key signature/1 0)] - expected random.nat] - ($_ _.and - (_.cover [/.document /.content] - (|> expected - (/.document key/0) - (/.content key/0) - (try#each (same? expected)) - (try.else false))) - (_.cover [/.signature] - (|> expected - (/.document key/0) - /.signature - (same? signature/0))) - (_.cover [/.marked?] - (and (|> expected - (/.document key/0) - (/.marked? key/0) - (case> {try.#Success it} true - {try.#Failure error} false)) - (|> expected - (/.document key/0) - (/.marked? key/1) - (case> {try.#Success it} false - {try.#Failure error} true)))) - (_.cover [/.invalid_signature] - (and (|> expected - (/.document key/0) - (/.content key/1) - (case> {try.#Success it} - false - - {try.#Failure error} - (exception.match? /.invalid_signature error))) - (|> expected - (/.document key/0) - (/.marked? key/1) - (case> {try.#Success it} - false - - {try.#Failure error} - (exception.match? /.invalid_signature error))))) - (_.cover [/.writer /.parser] - (|> expected - (/.document key/0) - (binaryF.result (/.writer binaryF.nat)) - (.result (/.parser .nat)) - (case> {try.#Success it} - (and (/signature#= signature/0 (/.signature it)) - (|> it - (/.content key/0) - (try#each (nat.= expected)) - (try.else false))) - - {try.#Failure error} - false))) - )))) 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/module/descriptor.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/module/descriptor.lux new file mode 100644 index 000000000..95a290b11 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/module/descriptor.lux @@ -0,0 +1,59 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" equivalence]]] + [control + ["[0]" try ("[1]#[0]" functor)] + [parser + ["<[0]>" binary]]] + [data + ["[0]" text ("[1]#[0]" equivalence)] + [format + ["[0]" binary]]] + [math + ["[0]" random {"+" Random} ("[1]#[0]" monad)]]]] + [\\library + ["[0]" /]]) + +(def: random_module_state + (Random Module_State) + ($_ random.or + (random#in []) + (random#in []) + (random#in []) + )) + +(def: .public (random imports) + (-> Nat (Random /.Descriptor)) + ($_ random.and + (random.ascii/lower 1) + (random.ascii/lower 1) + random.nat + ..random_module_state + (random.set text.hash imports (random.ascii/lower 2)) + )) + +(def: .public test + Test + (<| (_.covering /._) + (_.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) + (.result /.parser) + (try#each (|>> (# /.equivalence = (with@ /.#state {.#Cached} expected)))) + (try.else false))) + ))) diff --git a/stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux b/stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux new file mode 100644 index 000000000..a73bf751d --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/meta/archive/module/document.lux @@ -0,0 +1,93 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + [pipe {"+" case>}] + ["[0]" try ("[1]#[0]" functor)] + ["[0]" exception] + [parser + ["<[0]>" binary]]] + [data + [format + ["[0]F" binary]]] + [math + ["[0]" random] + [number + ["[0]" nat]]]]] + [\\library + ["[0]" / + [/// + ["[1][0]" signature ("[1]#[0]" equivalence)] + ["[1][0]" key]]]] + ["[0]" /// "_" + ["[1][0]" signature]]) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Document]) + (do random.monad + [signature/0 ///signature.random + signature/1 (random.only (|>> (/signature#= signature/0) not) + ///signature.random) + .let [key/0 (/key.key signature/0 0) + key/1 (/key.key signature/1 0)] + expected random.nat] + ($_ _.and + (_.cover [/.document /.content] + (|> expected + (/.document key/0) + (/.content key/0) + (try#each (same? expected)) + (try.else false))) + (_.cover [/.signature] + (|> expected + (/.document key/0) + /.signature + (same? signature/0))) + (_.cover [/.marked?] + (and (|> expected + (/.document key/0) + (/.marked? key/0) + (case> {try.#Success it} true + {try.#Failure error} false)) + (|> expected + (/.document key/0) + (/.marked? key/1) + (case> {try.#Success it} false + {try.#Failure error} true)))) + (_.cover [/.invalid_signature] + (and (|> expected + (/.document key/0) + (/.content key/1) + (case> {try.#Success it} + false + + {try.#Failure error} + (exception.match? /.invalid_signature error))) + (|> expected + (/.document key/0) + (/.marked? key/1) + (case> {try.#Success it} + false + + {try.#Failure error} + (exception.match? /.invalid_signature error))))) + (_.cover [/.writer /.parser] + (|> expected + (/.document key/0) + (binaryF.result (/.writer binaryF.nat)) + (.result (/.parser .nat)) + (case> {try.#Success it} + (and (/signature#= signature/0 (/.signature it)) + (|> it + (/.content key/0) + (try#each (nat.= expected)) + (try.else false))) + + {try.#Failure error} + false))) + )))) 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 )) -- cgit v1.2.3