From 105ab334201646be6b594d3d1215297e3b629a10 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 11 Feb 2022 19:57:00 -0400 Subject: Fixed directive extensions for Lux/Python. --- stdlib/source/test/lux/control/concatenative.lux | 15 +- stdlib/source/test/lux/control/concurrency/frp.lux | 58 ++++---- stdlib/source/test/lux/control/maybe.lux | 3 +- stdlib/source/test/lux/extension.lux | 4 +- stdlib/source/test/lux/tool.lux | 4 +- .../compiler/language/lux/analysis/inference.lux | 40 ++++-- .../tool/compiler/language/lux/analysis/type.lux | 28 +++- .../language/lux/phase/analysis/function.lux | 113 ++++++++------- .../language/lux/phase/analysis/reference.lux | 4 + .../language/lux/phase/analysis/simple.lux | 24 +++- .../source/test/lux/tool/compiler/meta/export.lux | 10 +- .../source/test/lux/tool/compiler/meta/import.lux | 158 +++++++++++++++++++++ stdlib/source/test/lux/type/check.lux | 4 +- 13 files changed, 347 insertions(+), 118 deletions(-) create mode 100644 stdlib/source/test/lux/tool/compiler/meta/import.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/control/concatenative.lux b/stdlib/source/test/lux/control/concatenative.lux index 00b421f97..85a1f4ac8 100644 --- a/stdlib/source/test/lux/control/concatenative.lux +++ b/stdlib/source/test/lux/control/concatenative.lux @@ -141,8 +141,10 @@ sample random.nat start random.nat .let [distance 10 - |++| (/.apply/1 ++) - |test| (/.apply/1 (|>> (n.- start) (n.< distance)))]] + |++| (: (/.=> [Nat] [Nat]) + (/.apply/1 ++)) + |test| (: (/.=> [Nat] [Bit]) + (/.apply/1 (|>> (n.- start) (n.< distance))))]] ($_ _.and (_.cover [/.call /.apply/1] (n.= (++ sample) @@ -244,18 +246,21 @@ (_.cover [/.loop] (n.= (n.+ distance start) (||> (/.push start) - (/.push (|>> |++| /.dup |test|)) + (/.push (: (/.=> [Nat] [Nat Bit]) + (|>> |++| /.dup |test|))) /.loop))) (_.cover [/.while] (n.= (n.+ distance start) (||> (/.push start) - (/.push (|>> /.dup |test|)) + (/.push (: (/.=> [Nat] [Nat Bit]) + (|>> /.dup |test|))) (/.push |++|) /.while))) (_.cover [/.do] (n.= (++ sample) (||> (/.push sample) - (/.push (|>> (/.push false))) + (/.push (: (/.=> [] [Bit]) + (|>> (/.push false)))) (/.push |++|) /.do /.while))) (_.cover [/.compose] diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux index 466f1c61f..7b564d904 100644 --- a/stdlib/source/test/lux/control/concurrency/frp.lux +++ b/stdlib/source/test/lux/control/concurrency/frp.lux @@ -1,30 +1,30 @@ (.using - [library - [lux "*" - ["_" test {"+" Test}] - [abstract - [monad {"+" do}] - [\\specification - ["$[0]" functor {"+" Injection Comparison}] - ["$[0]" apply] - ["$[0]" monad]]] - [control - ["[0]" try] - ["[0]" exception] - ["[0]" io {"+" IO io}]] - [data - [collection - ["[0]" list ("[1]#[0]" mix monoid)] - ["[0]" sequence {"+" Sequence}]]] - [math - ["[0]" random] - [number - ["n" nat]]]]] - [\\library - ["[0]" / - [// - ["[0]" async {"+" Async} ("[1]#[0]" monad)] - ["[0]" atom {"+" Atom atom}]]]]) + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}] + [\\specification + ["$[0]" functor {"+" Injection Comparison}] + ["$[0]" apply] + ["$[0]" monad]]] + [control + ["[0]" try] + ["[0]" exception] + ["[0]" io {"+" IO io}]] + [data + [collection + ["[0]" list ("[1]#[0]" mix monoid)] + ["[0]" sequence {"+" Sequence}]]] + [math + ["[0]" random] + [number + ["n" nat]]]]] + [\\library + ["[0]" / + [// + ["[0]" async {"+" Async} ("[1]#[0]" monad)] + ["[0]" atom {"+" Atom atom}]]]]) (def: injection (Injection /.Channel) @@ -86,7 +86,8 @@ (_.cover [/.Channel /.Sink /.channel] (case (io.run! (do (try.with io.monad) - [.let [[channel sink] (/.channel [])] + [.let [[channel sink] (: [(/.Channel Nat) (/.Sink Nat)] + (/.channel []))] _ (# sink feed sample) _ (# sink close)] (in channel))) @@ -106,7 +107,8 @@ (_.cover [/.channel_is_already_closed] (case (io.run! (do (try.with io.monad) - [.let [[channel sink] (/.channel [])] + [.let [[channel sink] (: [(/.Channel Nat) (/.Sink Nat)] + (/.channel []))] _ (# sink close)] (# sink feed sample))) {try.#Success _} diff --git a/stdlib/source/test/lux/control/maybe.lux b/stdlib/source/test/lux/control/maybe.lux index a798c19aa..fe8528548 100644 --- a/stdlib/source/test/lux/control/maybe.lux +++ b/stdlib/source/test/lux/control/maybe.lux @@ -65,7 +65,8 @@ value random.nat] (_.cover [/.else] (and (same? default (/.else default - {.#None})) + (: (Maybe Nat) + {.#None}))) (same? value (/.else default {.#Some value}))))) diff --git a/stdlib/source/test/lux/extension.lux b/stdlib/source/test/lux/extension.lux index 4c923924b..85b98df02 100644 --- a/stdlib/source/test/lux/extension.lux +++ b/stdlib/source/test/lux/extension.lux @@ -185,9 +185,7 @@ (in directive.no_requirements))) (for [... TODO: No longer skip testing Lua after Rembulan isn't being used anymore. - @.lua (as_is) - ... TODO: No longer skip testing Python. - @.python (as_is)] + @.lua (as_is)] (`` ((~~ (static ..directive)) (n.* 2 3)))) )) diff --git a/stdlib/source/test/lux/tool.lux b/stdlib/source/test/lux/tool.lux index c9a5cfb7c..8c154b3a0 100644 --- a/stdlib/source/test/lux/tool.lux +++ b/stdlib/source/test/lux/tool.lux @@ -24,7 +24,8 @@ ["[1][0]" meta "_" ["[1]/[0]" archive] ["[1]/[0]" cli] - ["[1]/[0]" export]] + ["[1]/[0]" export] + ["[1]/[0]" import]] ]]) (def: .public test @@ -38,6 +39,7 @@ /meta/archive.test /meta/cli.test /meta/export.test + /meta/import.test /phase/extension.test /phase/analysis/simple.test /phase/analysis/complex.test diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux index 97bdb7a54..3eec3a5b4 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/inference.lux @@ -108,6 +108,8 @@ (_.cover [/.general] (and (|> (/.general archive.empty ..analysis expected (list)) (//type.expecting expected) + (//module.with 0 (product.left name)) + (/phase#each product.right) (/phase.result state) (try#each (|>> product.left (type#= expected))) (try.else false)) @@ -115,6 +117,8 @@ (type.function (list.repeated arity .Nat) expected) (list#each code.nat nats)) (//type.expecting expected) + (//module.with 0 (product.left name)) + (/phase#each product.right) (/phase.result state) (try#each (function (_ [actual analysis/*]) (and (type#= expected actual) @@ -126,6 +130,8 @@ (type (-> type/0 expected)) (list term/0)) (//type.expecting expected) + (//module.with 0 (product.left name)) + (/phase#each product.right) (/phase.result state) (try#each (|>> product.left (type#= expected))) (try.else false)) @@ -133,6 +139,8 @@ (type {.#Named name (-> type/0 expected)}) (list term/0)) (//type.expecting expected) + (//module.with 0 (product.left name)) + (/phase#each product.right) (/phase.result state) (try#each (|>> product.left (type#= expected))) (try.else false)) @@ -140,7 +148,9 @@ (type (All (_ a) (-> a a))) (list term/0)) (//type.expecting type/0) - (/phase#each (|>> product.left check.clean //type.check)) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase#each (|>> product.left (check.clean (list)) //type.check)) /phase#conjoint (/phase.result state) (try#each (type#= type/0)) @@ -149,6 +159,8 @@ (type ((All (_ a) (-> a a)) type/0)) (list term/0)) (//type.expecting type/0) + (//module.with 0 (product.left name)) + (/phase#each product.right) (/phase.result state) (try#each (|>> product.left (type#= type/0))) (try.else false)) @@ -157,11 +169,23 @@ _ (//type.check (check.check varT (type (-> type/0 expected))))] (/.general archive.empty ..analysis varT (list term/0))) (//type.expecting expected) - (/phase#each (|>> product.left check.clean //type.check)) + (//module.with 0 (product.left name)) + (/phase#each product.right) + (/phase#each (|>> product.left (check.clean (list)) //type.check)) /phase#conjoint (/phase.result state) (try#each (type#= expected)) (try.else false)) + (|> (/.general archive.empty ..analysis + (type (Ex (_ a) (-> a a))) + (list (` ("lux io error" "")))) + //type.inferring + (//module.with 0 (product.left name)) + (/phase#each (|>> product.right product.left (check.clean (list)) //type.check)) + /phase#conjoint + (/phase.result state) + (try#each //type.existential?) + (try.else false)) )) (_.cover [/.cannot_infer] (and (|> (/.general archive.empty ..analysis expected (list term/0)) @@ -179,19 +203,9 @@ (type (-> expected expected)) (list term/0)) (//type.expecting expected) - (/phase.result state) - (..fails? /.cannot_infer_argument))) - (_.cover [/.existential?] - (|> (/.general archive.empty ..analysis - (type (Ex (_ a) (-> a a))) - (list (` ("lux io error" "")))) - //type.inferring (//module.with 0 (product.left name)) - (/phase#each (|>> product.right product.left check.clean //type.check)) - /phase#conjoint (/phase.result state) - (try#each /.existential?) - (try.else false))) + (..fails? /.cannot_infer_argument))) ))) (def: test|variant diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux index 2e63f1bc8..867ef7e5a 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/analysis/type.lux @@ -16,11 +16,12 @@ [\\library ["[0]" / ["/[1]" // + ["[2][0]" module] [// [phase ["[2][0]" extension]] [/// - ["[2][0]" phase]]]]]]) + ["[2][0]" phase ("[1]#[0]" functor)]]]]]]) (def: .public random_state (Random Lux) @@ -44,27 +45,36 @@ /extension.#state lux]] expected ..primitive dummy (random.only (|>> (type#= expected) not) - ..primitive)] + ..primitive) + module (random.ascii/lower 1)] ($_ _.and (_.cover [/.expecting /.inference] (and (|> (/.inference expected) (/.expecting expected) + (/module.with 0 module) + (/phase#each product.right) (/phase.result state) (case> {try.#Success _} true {try.#Failure _} false)) (|> (/.inference dummy) (/.expecting expected) + (/module.with 0 module) + (/phase#each product.right) (/phase.result state) (case> {try.#Success _} false {try.#Failure _} true)) (|> (/.inference expected) (/.expecting dummy) + (/module.with 0 module) + (/phase#each product.right) (/phase.result state) (case> {try.#Success _} false {try.#Failure _} true)))) (_.cover [/.inferring] (|> (/.inference expected) /.inferring + (/module.with 0 module) + (/phase#each product.right) (/phase.result state) (try#each (|>> product.left (type#= expected))) (try.else false))) @@ -75,9 +85,19 @@ (in type)))] (|> (/.inference exT) (/.expecting exT))) + (/module.with 0 module) + (/phase#each product.right) (/phase.result state) (case> {try.#Success _} true {try.#Failure _} false))) + (_.cover [/.existential /.existential?] + (|> (do /phase.monad + [:it: /.existential] + (in (/.existential? :it:))) + (/module.with 0 module) + (/phase#each product.right) + (/phase.result state) + (try.else false))) (_.cover [/.fresh] (and (|> (do /phase.monad [varT (/.check (do check.monad @@ -85,6 +105,8 @@ (in type)))] (|> (/.inference expected) (/.expecting varT))) + (/module.with 0 module) + (/phase#each product.right) (/phase.result state) (case> {try.#Success _} true {try.#Failure _} false)) @@ -95,6 +117,8 @@ (|> (/.inference expected) (/.expecting varT) /.fresh)) + (/module.with 0 module) + (/phase#each product.right) (/phase.result state) (case> {try.#Success _} false {try.#Failure _} true)))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux index 50fbc1c50..b5f2e4fc4 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/function.lux @@ -195,59 +195,66 @@ (exception.otherwise (text.contains? (value@ exception.#label /.cannot_analyse))))) ))) +(def: test|apply + Test + (do [! random.monad] + [lux $//type.random_state + .let [state [//extension.#bundle (//extension/analysis.bundle ..eval) + //extension.#state lux]] + [input/0 term/0] $//inference.simple_parameter + [input/1 term/1] (random.only (|>> product.left (same? input/0) not) + $//inference.simple_parameter) + output/0 ($type.random 0) + module/0 (random.ascii/lower 1)] + ($_ _.and + (_.cover [/.apply] + (let [reification? (: (-> Type (List Code) Type Bit) + (function (_ :abstraction: terms :expected:) + (|> (do //phase.monad + [[:actual: analysis] (|> (/.apply ..analysis terms + :abstraction: + (//analysis.unit) + archive.empty + (' [])) + //type.inferring)] + (in (and (check.subsumes? :expected: :actual:) + (case analysis + {//analysis.#Apply _} + true + + _ + false)))) + (//module.with 0 module/0) + (//phase#each product.right) + (//phase.result state) + (try.else false))))] + (and (reification? (-> input/0 input/1 output/0) (list term/0 term/1) output/0) + (reification? (-> input/0 input/1 output/0) (list term/0) (-> input/1 output/0)) + (reification? (All (_ a) (-> a a)) (list term/0) input/0) + (reification? (All (_ a) (-> a a a)) (list term/0) (-> input/0 input/0)) + (reification? (All (_ a) (-> input/0 a)) (list term/0) .Nothing) + (reification? (All (_ a b) (-> a b a)) (list term/0) (All (_ b) (-> b input/0))) + (reification? (Ex (_ a) (-> a input/0)) (list (` ("lux io error" ""))) input/0) + (reification? (Ex (_ a) (-> input/0 a)) (list term/0) .Any)))) + (_.cover [/.cannot_apply] + (|> (do //phase.monad + [_ (|> (/.apply ..analysis (list term/1 term/0) + (-> input/0 input/1 output/0) + (//analysis.unit) + archive.empty + (' [])) + (//type.expecting output/0))] + (in false)) + (//module.with 0 module/0) + (//phase#each product.right) + (//phase.result state) + (exception.otherwise (text.contains? (value@ exception.#label /.cannot_apply))))) + ))) + (def: .public test Test (<| (_.covering /._) - (do [! random.monad] - [lux $//type.random_state - .let [state [//extension.#bundle (//extension/analysis.bundle ..eval) - //extension.#state lux]] - [input/0 term/0] $//inference.simple_parameter - [input/1 term/1] $//inference.simple_parameter - output/0 ($type.random 0) - module/0 (random.ascii/lower 1)] - ($_ _.and - ..test|function - (_.cover [/.apply] - (let [reification? (: (-> Type (List Code) Type Bit) - (function (_ :abstraction: terms :expected:) - (|> (do //phase.monad - [[:actual: analysis] (|> (/.apply ..analysis terms - :abstraction: - (//analysis.unit) - archive.empty - (' [])) - //type.inferring)] - (in (and (check.subsumes? :expected: :actual:) - (case analysis - {//analysis.#Apply _} - true - - _ - false)))) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (try.else false))))] - (and (reification? (-> input/0 input/1 output/0) (list term/0 term/1) output/0) - (reification? (-> input/0 input/1 output/0) (list term/0) (-> input/1 output/0)) - (reification? (All (_ a) (-> a a)) (list term/0) input/0) - (reification? (All (_ a) (-> a a a)) (list term/0) (-> input/0 input/0)) - (reification? (All (_ a) (-> input/0 a)) (list term/0) .Nothing) - (reification? (All (_ a b) (-> a b a)) (list term/0) (All (_ b) (-> b input/0))) - (reification? (Ex (_ a) (-> a input/0)) (list (` ("lux io error" ""))) input/0) - (reification? (Ex (_ a) (-> input/0 a)) (list term/0) .Any)))) - (_.cover [/.cannot_apply] - (|> (do //phase.monad - [_ (|> (/.apply ..analysis (list term/1 term/0) - (-> input/0 input/1 output/0) - (//analysis.unit) - archive.empty - (' [])) - (//type.expecting output/0))] - (in false)) - (//module.with 0 module/0) - (//phase#each product.right) - (//phase.result state) - (exception.otherwise (text.contains? (value@ exception.#label /.cannot_apply))))) - )))) + ($_ _.and + ..test|function + ..test|apply + ))) diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux index c16cbf491..af84eb488 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/reference.lux @@ -49,6 +49,8 @@ (//scope.with_local [expected_name expected_type]) //type.inferring //scope.with + (//module.with 0 expected_module) + (//phase#each product.right) (//phase.result state) (try#each (|>> product.right (case> (^ [actual_type (//analysis.local 0)]) @@ -64,6 +66,8 @@ //scope.with (//scope.with_local [expected_name expected_type]) //scope.with + (//module.with 0 expected_module) + (//phase#each product.right) (//phase.result state) (try#each (|>> product.right product.right diff --git a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux index a93b4c3e1..45c22f1ec 100644 --- a/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux +++ b/stdlib/source/test/lux/tool/compiler/language/lux/phase/analysis/simple.lux @@ -8,6 +8,8 @@ [control [pipe {"+" case>}] ["[0]" try]] + [data + ["[0]" product]] [math ["[0]" random]]]] [\\library @@ -16,14 +18,17 @@ ["[1][0]" extension] [// ["[1][0]" analysis {"+" Analysis Operation} - ["[2][0]" type]] + ["[2][0]" type] + ["[2][0]" module]] [/// - ["[1][0]" phase]]]]]]) + ["[1][0]" phase ("[1]#[0]" functor)]]]]]]) -(def: (analysis state type it ?) - (-> Lux Type (Operation Analysis) (-> Analysis Bit) Bit) +(def: (analysis state module type it ?) + (-> Lux Text Type (Operation Analysis) (-> Analysis Bit) Bit) (and (|> it (/type.expecting type) + (/module.with 0 module) + (/phase#each product.right) (/phase.result [/extension.#bundle /extension.empty /extension.#state state]) (case> (^ {try.#Success analysis}) @@ -33,6 +38,8 @@ false)) (|> it (/type.expecting .Nothing) + (/module.with 0 module) + (/phase#each product.right) (/phase.result [/extension.#bundle /extension.empty /extension.#state state]) (case> (^ {try.#Failure error}) @@ -42,6 +49,8 @@ false)) (|> it /type.inferring + (/module.with 0 module) + (/phase#each product.right) (/phase.result [/extension.#bundle /extension.empty /extension.#state state]) (case> (^ {try.#Success [inferred analysis]}) @@ -64,17 +73,18 @@ (<| (_.covering /._) (do [! random.monad] [version random.nat - host (random.ascii/lower 5) + host (random.ascii/lower 1) + module (random.ascii/lower 2) .let [state (/analysis.state (/analysis.info version host))]] (`` ($_ _.and (_.cover [/.unit] - (..analysis state .Any /.unit + (..analysis state module .Any /.unit (|>> (case> (^ (/analysis.unit)) true _ false)))) (~~ (template [ ] [(do ! [sample ] (_.cover [] - (..analysis state ( sample) + (..analysis state module ( sample) ((..analysis? ) sample))))] [/.bit .Bit random.bit /analysis.bit] diff --git a/stdlib/source/test/lux/tool/compiler/meta/export.lux b/stdlib/source/test/lux/tool/compiler/meta/export.lux index 11a6ea9ce..2864dabfd 100644 --- a/stdlib/source/test/lux/tool/compiler/meta/export.lux +++ b/stdlib/source/test/lux/tool/compiler/meta/export.lux @@ -75,15 +75,19 @@ export_tar (# ! in (.result tar.parser export_tar))] (in [library_tar export_tar]))] ($_ _.and' - (_.cover' [/.library] + (_.cover' [/.library /.mode /.ownership] (|> it (try#each (|>> product.left sequence.list - (case> (^ (list {tar.#Normal [actual_path/0 _ _ _ actual_content/0]} - {tar.#Normal [actual_path/1 _ _ _ actual_content/1]})) + (case> (^ (list {tar.#Normal [actual_path/0 when/0 mode/0 ownership/0 actual_content/0]} + {tar.#Normal [actual_path/1 when/1 mode/1 ownership/1 actual_content/1]})) (with_expansions [ (and (and (text#= file/0' (tar.from_path actual_path/0)) + (same? /.mode mode/0) + (same? /.ownership ownership/0) (binary#= content/0 (tar.data actual_content/0))) (and (text#= file/1' (tar.from_path actual_path/1)) + (same? /.mode mode/1) + (same? /.ownership ownership/1) (binary#= content/1 (tar.data actual_content/1))))] (or (let [[[actual_path/0 actual_content/0] [actual_path/1 actual_content/1]] diff --git a/stdlib/source/test/lux/tool/compiler/meta/import.lux b/stdlib/source/test/lux/tool/compiler/meta/import.lux new file mode 100644 index 000000000..7a24f9a82 --- /dev/null +++ b/stdlib/source/test/lux/tool/compiler/meta/import.lux @@ -0,0 +1,158 @@ +(.using + [library + [lux "*" + ["_" test {"+" Test}] + [abstract + [monad {"+" do}]] + [control + [pipe {"+" case>}] + ["[0]" maybe ("[1]#[0]" functor)] + ["[0]" try ("[1]#[0]" functor)] + ["[0]" exception] + [concurrency + ["[0]" async]] + [parser + ["<[0]>" binary]]] + [data + ["[0]" product] + ["[0]" binary {"+" Binary} ("[1]#[0]" equivalence)] + ["[0]" bit ("[1]#[0]" equivalence)] + ["[0]" format "_" + ["[0]" tar {"+" Tar}] + ["[1]" binary]] + ["[0]" text ("[1]#[0]" equivalence) + ["%" format {"+" format}] + [encoding + ["[0]" utf8]]] + [collection + ["[0]" sequence] + ["[0]" dictionary]]] + [math + ["[0]" random {"+" Random}] + [number + ["n" nat]]] + [world + ["[0]" file]]]] + [\\library + ["[0]" / + [// + ["[0]" export] + ["[0]" io "_" + ["[1]" context]]]]]) + +(def: .public test + Test + (<| (_.covering /._) + (_.for [/.Import]) + (do [! random.monad] + [library/0 (random.ascii/lower 1) + library/1 (random.ascii/lower 2) + + .let [/ .module_separator + random_file (: (Random file.Path) + (# ! each (text.suffix io.lux_extension) (random.ascii/lower 3)))] + file/0 random_file + + dir/0 (random.ascii/lower 4) + file/1 (# ! each (|>> (format dir/0 /)) random_file) + + .let [random_content (: (Random Binary) + (# ! each (|>> %.nat (# utf8.codec encoded)) random.nat))] + now random.instant + content/0 random_content + content/1 random_content + .let [library_content (|> (do try.monad + [file/0 (tar.path file/0) + file/1 (tar.path file/1) + content/0 (tar.content content/0) + content/1 (tar.content content/1)] + (in (|> (sequence.sequence {tar.#Normal [file/0 now export.mode export.ownership content/0]} + {tar.#Normal [file/1 now export.mode export.ownership content/1]}) + (format.result tar.writer)))) + (try.else (binary.empty 0))) + library_content/0 (|> (do try.monad + [file/0 (tar.path file/0) + content/0 (tar.content content/0)] + (in (|> (sequence.sequence {tar.#Normal [file/0 now export.mode export.ownership content/0]}) + (format.result tar.writer)))) + (try.else (binary.empty 0))) + library_content/1 (|> (do try.monad + [file/1 (tar.path file/1) + content/1 (tar.content content/1)] + (in (|> (sequence.sequence {tar.#Normal [file/1 now export.mode export.ownership content/1]}) + (format.result tar.writer)))) + (try.else (binary.empty 0))) + library_content/-0 (|> (do try.monad + [file/0 (tar.path file/0) + content/0 (tar.content content/0)] + (in (|> (sequence.sequence {tar.#Contiguous [file/0 now export.mode export.ownership content/0]}) + (format.result tar.writer)))) + (try.else (binary.empty 0))) + library_content/-1 (|> (do try.monad + [file/0 (tar.path file/0)] + (in (|> (sequence.sequence {tar.#Symbolic_Link file/0}) + (format.result tar.writer)))) + (try.else (binary.empty 0))) + library_content/-2 (|> (do try.monad + [file/0 (tar.path file/0)] + (in (|> (sequence.sequence {tar.#Directory file/0}) + (format.result tar.writer)))) + (try.else (binary.empty 0))) + imported? (: (-> /.Import Bit) + (function (_ it) + (and (n.= 2 (dictionary.size it)) + (|> it + (dictionary.value file/0) + (maybe#each (binary#= content/0)) + (maybe.else false)) + (|> it + (dictionary.value file/1) + (maybe#each (binary#= content/1)) + (maybe.else false)))))]] + ($_ _.and + (in (do [! async.monad] + [it/0 (do (try.with !) + [.let [fs (file.mock /)] + _ (# fs write library_content library/0)] + (/.import fs (list library/0))) + it/1 (do (try.with !) + [.let [fs (file.mock /)] + _ (# fs write library_content/0 library/0) + _ (# fs write library_content/1 library/1)] + (/.import fs (list library/0 library/1)))] + (_.cover' [/.import] + (and (|> it/0 + (try#each imported?) + (try.else false)) + (|> it/1 + (try#each imported?) + (try.else false)))))) + (in (do [! async.monad] + [it (do (try.with !) + [.let [fs (file.mock /)] + _ (# fs write library_content library/0) + _ (/.import fs (list library/0 library/0))] + (in false))] + (_.cover' [/.duplicate] + (exception.otherwise (exception.match? /.duplicate) it)))) + (in (do [! async.monad] + [it/0 (do (try.with !) + [.let [fs (file.mock /)] + _ (# fs write library_content/-0 library/0) + _ (/.import fs (list library/0))] + (in false)) + it/1 (do (try.with !) + [.let [fs (file.mock /)] + _ (# fs write library_content/-1 library/0) + _ (/.import fs (list library/0))] + (in false)) + it/2 (do (try.with !) + [.let [fs (file.mock /)] + _ (# fs write library_content/-2 library/0) + _ (/.import fs (list library/0))] + (in false))] + (_.cover' [/.useless_tar_entry] + (and (exception.otherwise (exception.match? /.useless_tar_entry) it/0) + (exception.otherwise (exception.match? /.useless_tar_entry) it/1) + (exception.otherwise (exception.match? /.useless_tar_entry) it/2))))) + )))) diff --git a/stdlib/source/test/lux/type/check.lux b/stdlib/source/test/lux/type/check.lux index 9d38c6f6d..818441adf 100644 --- a/stdlib/source/test/lux/type/check.lux +++ b/stdlib/source/test/lux/type/check.lux @@ -731,7 +731,7 @@ (_.cover [/.clean] (and (|> (do /.monad [[var_id varT] /.var - cleanedT (/.clean (type_shape varT))] + cleanedT (/.clean (list) (type_shape varT))] (in (type#= (type_shape varT) cleanedT))) (/.result /.fresh_context) @@ -740,7 +740,7 @@ [[var_id varT] /.var [_ replacementT] /.existential _ (/.check varT replacementT) - cleanedT (/.clean (type_shape varT))] + cleanedT (/.clean (list) (type_shape varT))] (in (type#= (type_shape replacementT) cleanedT))) (/.result /.fresh_context) -- cgit v1.2.3