diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/test/aedifex/command.lux | 30 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/command/build.lux | 9 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/command/deploy.lux | 36 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/command/deps.lux | 43 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/command/test.lux | 4 | ||||
| -rw-r--r-- | stdlib/source/test/aedifex/dependency/resolution.lux | 232 | ||||
| -rw-r--r-- | stdlib/source/test/lux.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/test/lux/macro.lux | 8 | ||||
| -rw-r--r-- | stdlib/source/test/lux/macro/local.lux | 90 | ||||
| -rw-r--r-- | stdlib/source/test/lux/macro/template.lux | 5 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world.lux | 3 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world/input/keyboard.lux | 144 | ||||
| -rw-r--r-- | stdlib/source/test/lux/world/output/video/resolution.lux | 16 |
13 files changed, 451 insertions, 172 deletions
diff --git a/stdlib/source/test/aedifex/command.lux b/stdlib/source/test/aedifex/command.lux index 0ef18f044..e0cb2da79 100644 --- a/stdlib/source/test/aedifex/command.lux +++ b/stdlib/source/test/aedifex/command.lux @@ -2,16 +2,19 @@ [lux #* ["_" test (#+ Test)]] ["." / #_ + ["#." version] + ["#." pom] + ["#." clean] ["#." install] - ["#." pom] - ["#." version]] + + ["#." deps] + ["#." deploy] + + ["#." build] + ["#." test]] {#program ["." / - ## ["#." deploy] - ## ["#." deps] - ## ["#." build] - ## ["#." test] ## ["#." auto] ]}) @@ -20,13 +23,16 @@ (<| (_.covering /._) (_.for [/.Command]) ($_ _.and + /version.test + /pom.test + /clean.test /install.test - /pom.test - /version.test - ## /deploy.test - ## /deps.test - ## /build.test - ## /test.test + + /deps.test + /deploy.test + + /build.test + /test.test ## /auto.test ))) diff --git a/stdlib/source/test/aedifex/command/build.lux b/stdlib/source/test/aedifex/command/build.lux index 8a4df9a7e..85231ae33 100644 --- a/stdlib/source/test/aedifex/command/build.lux +++ b/stdlib/source/test/aedifex/command/build.lux @@ -4,6 +4,7 @@ [abstract [monad (#+ do)]] [control + [io (#+ IO)] ["." try] ["." exception] [concurrency @@ -37,7 +38,7 @@ ["#/." resolution]]]]}) (def: #export good_shell - (-> Any (Shell Promise)) + (-> Any (Shell IO)) (shell.mock (function (_ [actual_environment actual_working_directory actual_command actual_arguments]) (#try.Success @@ -55,7 +56,7 @@ (#try.Success [state shell.normal])))))))) (def: #export bad_shell - (-> Any (Shell Promise)) + (-> Any (Shell IO)) (shell.mock (function (_ [actual_environment actual_working_directory actual_command actual_arguments]) (#try.Success @@ -98,7 +99,7 @@ (<| (_.covering /._) (do {! random.monad} [#let [fs (file.mock (\ file.default separator)) - shell (..good_shell [])] + shell (shell.async (..good_shell []))] program (random.ascii/alpha 5) target (random.ascii/alpha 5) home (random.ascii/alpha 5) @@ -162,7 +163,7 @@ resolution ..resolution] (wrap (do promise.monad [verdict (do ///action.monad - [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (..bad_shell []) resolution profile) + [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async (..bad_shell [])) resolution profile) start (!.use (\ console read_line) []) end (!.use (\ console read_line) [])] (wrap (and (text\= /.start start) diff --git a/stdlib/source/test/aedifex/command/deploy.lux b/stdlib/source/test/aedifex/command/deploy.lux index 617b3386a..cc99f2e48 100644 --- a/stdlib/source/test/aedifex/command/deploy.lux +++ b/stdlib/source/test/aedifex/command/deploy.lux @@ -17,7 +17,8 @@ ["." binary] ["." text ("#\." equivalence) ["%" format (#+ format)] - ["." encoding]] + [encoding + ["." utf8]]] ["." format #_ ["#" binary] ["." tar] @@ -108,31 +109,42 @@ (export.library fs) (\ ! map (format.run tar.writer))) - actual_pom (\ repository download (///repository/remote.uri artifact ///artifact/extension.pom)) - actual_library (\ repository download (///repository/remote.uri artifact ///artifact/extension.lux_library)) - actual_sha-1 (\ repository download (///repository/remote.uri artifact (format ///artifact/extension.lux_library ///artifact/extension.sha-1))) - actual_md5 (\ repository download (///repository/remote.uri artifact (format ///artifact/extension.lux_library ///artifact/extension.md5))) + actual_pom (\ repository download (///repository/remote.uri (get@ #///artifact.version artifact) artifact ///artifact/extension.pom)) + actual_library (\ repository download (///repository/remote.uri (get@ #///artifact.version artifact) artifact ///artifact/extension.lux_library)) + actual_sha-1 (\ repository download (///repository/remote.uri (get@ #///artifact.version artifact) artifact (format ///artifact/extension.lux_library ///artifact/extension.sha-1))) + actual_sha-1 (\ promise.monad wrap + (do try.monad + [actual_sha-1 (\ utf8.codec decode actual_sha-1)] + (\ ///hash.sha-1_codec decode actual_sha-1))) + actual_md5 (\ repository download (///repository/remote.uri (get@ #///artifact.version artifact) artifact (format ///artifact/extension.lux_library ///artifact/extension.md5))) + actual_md5 (\ promise.monad wrap + (do try.monad + [actual_md5 (\ utf8.codec decode actual_md5)] + (\ ///hash.md5_codec decode actual_md5))) - #let [deployed_library! + #let [succeeded! + (text\= //clean.success logging) + + deployed_library! (\ binary.equivalence = expected_library actual_library) deployed_pom! (\ binary.equivalence = - (|> expected_pom (\ xml.codec encode) (\ encoding.utf8 encode)) + (|> expected_pom (\ xml.codec encode) (\ utf8.codec encode)) actual_pom) deployed_sha-1! - (\ binary.equivalence = - (///hash.data (///hash.sha-1 expected_library)) + (\ ///hash.equivalence = + (///hash.sha-1 expected_library) actual_sha-1) deployed_md5! - (\ binary.equivalence = - (///hash.data (///hash.md5 expected_library)) + (\ ///hash.equivalence = + (///hash.md5 expected_library) actual_md5)]] - (wrap (and (text\= //clean.success logging) + (wrap (and succeeded! deployed_library! deployed_pom! deployed_sha-1! diff --git a/stdlib/source/test/aedifex/command/deps.lux b/stdlib/source/test/aedifex/command/deps.lux index 99856c83c..8b5e3820e 100644 --- a/stdlib/source/test/aedifex/command/deps.lux +++ b/stdlib/source/test/aedifex/command/deps.lux @@ -14,10 +14,14 @@ ["." environment]]] [data ["." text ("#\." equivalence) - ["%" format (#+ format)]] + ["%" format (#+ format)] + [encoding + ["." utf8]]] [collection ["." dictionary] - ["." set]]] + ["." set]] + [format + ["." xml]]] [math ["." random (#+ Random)]] [world @@ -81,10 +85,14 @@ dependee_package (|> dependee_package (set@ #///package.origin (#///repository/origin.Remote "")) - (set@ #///package.pom [dependee_pom #///dependency/status.Unverified])) + (set@ #///package.pom [dependee_pom + (|> dependee_pom (\ xml.codec encode) (\ utf8.codec encode)) + #///dependency/status.Unverified])) depender_package (|> depender_package (set@ #///package.origin (#///repository/origin.Remote "")) - (set@ #///package.pom [depender_pom #///dependency/status.Unverified])) + (set@ #///package.pom [depender_pom + (|> depender_pom (\ xml.codec encode) (\ utf8.codec encode)) + #///dependency/status.Unverified])) fs (file.mock (\ file.default separator)) program (program.async (program.mock environment.empty home working_directory))]] @@ -97,14 +105,29 @@ (///dependency/deployment.all local)) post (|> (\ ///.monoid identity) (set@ #///.dependencies (set.from_list ///dependency.hash (list dependee depender))) - (/.do! console local (list (///repository.mock ($///dependency/resolution.single depender_artifact depender_package) [])))) + (/.do! console local (list (///repository.mock ($///dependency/resolution.single depender_artifact depender_package) + [])))) logging! (\ ///action.monad map (text\= //clean.success) - (!.use (\ console read_line) []))] + (!.use (\ console read_line) [])) + + #let [had_dependee_before! + (set.member? pre dependee_artifact) + + lacked_depender_before! + (not (set.member? pre depender_artifact)) + + had_dependee_after! + (dictionary.key? post dependee) + + had_depender_after! + (dictionary.key? post depender)]] (wrap (and logging! - (and (set.member? pre dependee_artifact) - (not (set.member? pre depender_artifact))) - (and (dictionary.key? post dependee) - (dictionary.key? post depender)))))] + + had_dependee_before! + lacked_depender_before! + + had_dependee_after! + had_depender_after!)))] (_.cover' [/.do!] (try.default false verdict))))))) diff --git a/stdlib/source/test/aedifex/command/test.lux b/stdlib/source/test/aedifex/command/test.lux index 2d077ab87..9dd76ca08 100644 --- a/stdlib/source/test/aedifex/command/test.lux +++ b/stdlib/source/test/aedifex/command/test.lux @@ -62,7 +62,7 @@ console (@version.echo "")] (wrap (do promise.monad [verdict (do ///action.monad - [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (@build.good_shell []) resolution profile) + [_ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async (@build.good_shell [])) resolution profile) build_start (!.use (\ console read_line) []) build_end (!.use (\ console read_line) []) test_start (!.use (\ console read_line) []) @@ -96,7 +96,7 @@ shell.normal shell.error)])))))) [])] - _ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs bad_shell resolution profile) + _ (/.do! console (program.async (program.mock environment.empty home working_directory)) fs (shell.async bad_shell) resolution profile) build_start (!.use (\ console read_line) []) build_end (!.use (\ console read_line) []) test_start (!.use (\ console read_line) []) diff --git a/stdlib/source/test/aedifex/dependency/resolution.lux b/stdlib/source/test/aedifex/dependency/resolution.lux index 4404cb32f..e9cd26a82 100644 --- a/stdlib/source/test/aedifex/dependency/resolution.lux +++ b/stdlib/source/test/aedifex/dependency/resolution.lux @@ -16,7 +16,8 @@ ["." product] ["." binary] ["." text - ["." encoding]] + [encoding + ["." utf8]]] [format ["." xml]] [collection @@ -59,38 +60,39 @@ (def: #export (single artifact package) (-> Artifact Package (Simulation Any)) - (structure - (def: (on_download uri state) - (if (text.contains? (///artifact.uri artifact) uri) - (cond (text.ends_with? ///artifact/extension.lux_library uri) - (#try.Success [state (|> package - (get@ #///package.library) - product.left)]) - - (text.ends_with? ///artifact/extension.pom uri) - (#try.Success [state (|> package - (get@ #///package.pom) - product.left - (\ xml.codec encode) - (\ encoding.utf8 encode))]) + (let [expected (///artifact.uri (get@ #///artifact.version artifact) artifact)] + (structure + (def: (on_download uri state) + (if (text.contains? expected uri) + (cond (text.ends_with? ///artifact/extension.lux_library uri) + (#try.Success [state (|> package + (get@ #///package.library) + product.left)]) + + (text.ends_with? ///artifact/extension.pom uri) + (#try.Success [state (|> package + (get@ #///package.pom) + product.left + (\ xml.codec encode) + (\ utf8.codec encode))]) - ## (text.ends_with? ///artifact/extension.sha-1 uri) - ## (#try.Success [state (|> package - ## (get@ #///package.sha-1) - ## (\ ///hash.sha-1_codec encode) - ## (\ encoding.utf8 encode))]) - - ## (text.ends_with? ///artifact/extension.md5 uri) - ## (#try.Success [state (|> package - ## (get@ #///package.md5) - ## (\ ///hash.md5_codec encode) - ## (\ encoding.utf8 encode))]) + ## (text.ends_with? ///artifact/extension.sha-1 uri) + ## (#try.Success [state (|> package + ## (get@ #///package.sha-1) + ## (\ ///hash.sha-1_codec encode) + ## (\ utf8.codec encode))]) + + ## (text.ends_with? ///artifact/extension.md5 uri) + ## (#try.Success [state (|> package + ## (get@ #///package.md5) + ## (\ ///hash.md5_codec encode) + ## (\ utf8.codec encode))]) - ## else - (#try.Failure "NOPE")) - (#try.Failure "NOPE"))) - (def: (on_upload uri binary state) - (#try.Failure "NOPE")))) + ## else + (#try.Failure "NOPE")) + (#try.Failure "NOPE"))) + (def: (on_upload uri binary state) + (#try.Failure "NOPE"))))) (def: one Test @@ -106,7 +108,7 @@ bad_sha-1 (: (Simulation Any) (structure (def: (on_download uri state) - (if (text.contains? (///artifact.uri expected_artifact) uri) + (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) (cond (text.ends_with? ///artifact/extension.lux_library uri) (#try.Success [state (|> expected_package (get@ #///package.library) @@ -117,19 +119,19 @@ (get@ #///package.pom) product.left (\ xml.codec encode) - (\ encoding.utf8 encode))]) + (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.sha-1) ## (#try.Success [state (|> dummy_package ## (get@ #///package.sha-1) ## (\ ///hash.sha-1_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.md5) ## (#try.Success [state (|> expected_package ## (get@ #///package.md5) ## (\ ///hash.md5_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## else (#try.Failure "NOPE")) @@ -139,7 +141,7 @@ bad_md5 (: (Simulation Any) (structure (def: (on_download uri state) - (if (text.contains? (///artifact.uri expected_artifact) uri) + (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) (cond (text.ends_with? ///artifact/extension.lux_library uri) (#try.Success [state (|> expected_package (get@ #///package.library) @@ -150,19 +152,19 @@ (get@ #///package.pom) product.left (\ xml.codec encode) - (\ encoding.utf8 encode))]) + (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.sha-1) ## (#try.Success [state (|> expected_package ## (get@ #///package.sha-1) ## (\ ///hash.sha-1_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.md5) ## (#try.Success [state (|> dummy_package ## (get@ #///package.md5) ## (\ ///hash.md5_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## else (#try.Failure "NOPE")) @@ -217,7 +219,7 @@ bad_sha-1 (: (Simulation Any) (structure (def: (on_download uri state) - (if (text.contains? (///artifact.uri expected_artifact) uri) + (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) (cond (text.ends_with? ///artifact/extension.lux_library uri) (#try.Success [state (|> expected_package (get@ #///package.library) @@ -228,19 +230,19 @@ (get@ #///package.pom) product.left (\ xml.codec encode) - (\ encoding.utf8 encode))]) + (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.sha-1) ## (#try.Success [state (|> dummy_package ## (get@ #///package.sha-1) ## (\ ///hash.sha-1_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.md5) ## (#try.Success [state (|> expected_package ## (get@ #///package.md5) ## (\ ///hash.md5_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## else (#try.Failure "NOPE")) @@ -250,7 +252,7 @@ bad_md5 (: (Simulation Any) (structure (def: (on_download uri state) - (if (text.contains? (///artifact.uri expected_artifact) uri) + (if (text.contains? (///artifact.uri (get@ #///artifact.version expected_artifact) expected_artifact) uri) (cond (text.ends_with? ///artifact/extension.lux_library uri) (#try.Success [state (|> expected_package (get@ #///package.library) @@ -261,19 +263,19 @@ (get@ #///package.pom) product.left (\ xml.codec encode) - (\ encoding.utf8 encode))]) + (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.sha-1) ## (#try.Success [state (|> expected_package ## (get@ #///package.sha-1) ## (\ ///hash.sha-1_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## (text\= extension ///artifact/extension.md5) ## (#try.Success [state (|> dummy_package ## (get@ #///package.md5) ## (\ ///hash.md5_codec encode) - ## (\ encoding.utf8 encode))]) + ## (\ utf8.codec encode))]) ## else (#try.Failure "NOPE")) @@ -312,77 +314,77 @@ false)))) ))) -(def: all - Test - (do {! random.monad} - [dependee_artifact $///artifact.random - depender_artifact (random.filter (predicate.complement - (\ ///artifact.equivalence = dependee_artifact)) - $///artifact.random) - ignored_artifact (random.filter (predicate.complement - (predicate.unite (\ ///artifact.equivalence = dependee_artifact) - (\ ///artifact.equivalence = depender_artifact))) - $///artifact.random) +## (def: all +## Test +## (do {! random.monad} +## [dependee_artifact $///artifact.random +## depender_artifact (random.filter (predicate.complement +## (\ ///artifact.equivalence = dependee_artifact)) +## $///artifact.random) +## ignored_artifact (random.filter (predicate.complement +## (predicate.unite (\ ///artifact.equivalence = dependee_artifact) +## (\ ///artifact.equivalence = depender_artifact))) +## $///artifact.random) - [_ dependee_package] $///package.random - [_ depender_package] $///package.random - [_ ignored_package] $///package.random +## [_ dependee_package] $///package.random +## [_ depender_package] $///package.random +## [_ ignored_package] $///package.random - #let [dependee {#///dependency.artifact dependee_artifact - #///dependency.type ///artifact/type.lux_library} - depender {#///dependency.artifact depender_artifact - #///dependency.type ///artifact/type.lux_library} - ignored {#///dependency.artifact ignored_artifact - #///dependency.type ///artifact/type.lux_library} +## #let [dependee {#///dependency.artifact dependee_artifact +## #///dependency.type ///artifact/type.lux_library} +## depender {#///dependency.artifact depender_artifact +## #///dependency.type ///artifact/type.lux_library} +## ignored {#///dependency.artifact ignored_artifact +## #///dependency.type ///artifact/type.lux_library} - dependee_pom (|> (\ ///.monoid identity) - (set@ #///.identity (#.Some dependee_artifact)) - ///pom.write - try.assume) - depender_pom (|> (\ ///.monoid identity) - (set@ #///.identity (#.Some depender_artifact)) - (set@ #///.dependencies (set.from_list ///dependency.hash (list dependee))) - ///pom.write - try.assume) - ignored_pom (|> (\ ///.monoid identity) - (set@ #///.identity (#.Some ignored_artifact)) - ///pom.write - try.assume) - - dependee_package (set@ #///package.pom [dependee_pom #///dependency/status.Unverified] dependee_package) - depender_package (set@ #///package.pom [depender_pom #///dependency/status.Unverified] depender_package) - ignored_package (set@ #///package.pom [ignored_pom #///dependency/status.Unverified] ignored_package)]] - ($_ _.and - (wrap - (do promise.monad - [resolution (/.all (list (///repository.mock (..single dependee_artifact dependee_package) []) - (///repository.mock (..single depender_artifact depender_package) []) - (///repository.mock (..single ignored_artifact ignored_package) [])) - (list depender) - /.empty)] - (_.cover' [/.all] - (case resolution - (#try.Success resolution) - (and (dictionary.key? resolution depender) - (dictionary.key? resolution dependee) - (not (dictionary.key? resolution ignored))) +## dependee_pom (|> (\ ///.monoid identity) +## (set@ #///.identity (#.Some dependee_artifact)) +## ///pom.write +## try.assume) +## depender_pom (|> (\ ///.monoid identity) +## (set@ #///.identity (#.Some depender_artifact)) +## (set@ #///.dependencies (set.from_list ///dependency.hash (list dependee))) +## ///pom.write +## try.assume) +## ignored_pom (|> (\ ///.monoid identity) +## (set@ #///.identity (#.Some ignored_artifact)) +## ///pom.write +## try.assume) - (#try.Failure error) - false)))) - ))) +## dependee_package (set@ #///package.pom [dependee_pom #///dependency/status.Unverified] dependee_package) +## depender_package (set@ #///package.pom [depender_pom #///dependency/status.Unverified] depender_package) +## ignored_package (set@ #///package.pom [ignored_pom #///dependency/status.Unverified] ignored_package)]] +## ($_ _.and +## (wrap +## (do promise.monad +## [resolution (/.all (list (///repository.mock (..single dependee_artifact dependee_package) []) +## (///repository.mock (..single depender_artifact depender_package) []) +## (///repository.mock (..single ignored_artifact ignored_package) [])) +## (list depender) +## /.empty)] +## (_.cover' [/.all] +## (case resolution +## (#try.Success resolution) +## (and (dictionary.key? resolution depender) +## (dictionary.key? resolution dependee) +## (not (dictionary.key? resolution ignored))) -(def: #export test - Test - (<| (_.covering /._) - (_.for [/.Resolution]) - ($_ _.and - (_.for [/.equivalence] - ($equivalence.spec /.equivalence ..random)) +## (#try.Failure error) +## false)))) +## ))) + +## (def: #export test +## Test +## (<| (_.covering /._) +## (_.for [/.Resolution]) +## ($_ _.and +## (_.for [/.equivalence] +## ($equivalence.spec /.equivalence ..random)) + +## (_.cover [/.empty] +## (dictionary.empty? /.empty)) - (_.cover [/.empty] - (dictionary.empty? /.empty)) - - ..one - ..any - ..all - ))) +## ..one +## ..any +## ..all +## ))) diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index ad63d30cb..69ce89d45 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -7,7 +7,6 @@ [program (#+ program:)] ["_" test (#+ Test)] ["@" target] - ["." debug] [abstract [monad (#+ do)] [predicate (#+ Predicate)]] @@ -256,5 +255,5 @@ (program: args (<| io _.run! - ((debug.private _.times') (#.Some 2,000) 100) + (_.times' (#.Some 2,000) 100) ..test)) diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux index d4e3e9ae4..5892f842e 100644 --- a/stdlib/source/test/lux/macro.lux +++ b/stdlib/source/test/lux/macro.lux @@ -27,9 +27,10 @@ ["." template]]} ["." / #_ ["#." code] - ["#." template] + ["#." local] ["#." poly] - ["#." syntax]]) + ["#." syntax] + ["#." template]]) (template: (!expect <pattern> <value>) (case <value> @@ -179,7 +180,8 @@ ..expander /code.test - /template.test + /local.test /syntax.test /poly.test + /template.test ))) diff --git a/stdlib/source/test/lux/macro/local.lux b/stdlib/source/test/lux/macro/local.lux new file mode 100644 index 000000000..b499beb68 --- /dev/null +++ b/stdlib/source/test/lux/macro/local.lux @@ -0,0 +1,90 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + ["." meta] + [abstract + [monad (#+ do)]] + [control + ["." try] + ["." exception] + ["<>" parser + ["<.>" code]]] + [data + [text + ["%" format]] + [collection + ["." list] + [dictionary + ["." plist]]]] + ["." macro + [syntax (#+ syntax:)] + ["." code]] + [math + ["." random (#+ Random)] + [number + ["n" nat]]]] + {1 + ["." /]}) + +(syntax: (macro_error macro) + (function (_ compiler) + (case ((macro.expand macro) compiler) + (#try.Failure error) + (#try.Success [compiler (list (code.text error))]) + + (#try.Success _) + (#try.Failure "OOPS!")))) + +(def: (constant output) + (-> Code Macro) + ("lux macro" + (function (_ inputs lux) + (#try.Success [lux (list output)])))) + +(syntax: (with {name (<code>.tuple (<>.and <code>.text <code>.text))} + constant + {pre_remove <code>.bit} + body) + (macro.with_gensyms [g!output] + (do meta.monad + [pop! (/.push (list [name (..constant constant)])) + [module short] (meta.normalize name) + _ (if pre_remove + (let [remove_macro! (: (-> .Module .Module) + (update@ #.definitions (plist.remove short)))] + (function (_ lux) + (#try.Success [(update@ #.modules (plist.update module remove_macro!) lux) + []]))) + (wrap []))] + (let [pre_expansion (` (let [(~ g!output) (~ body)] + (exec (~ pop!) + (~ g!output))))] + (if pre_remove + (macro.expand_all pre_expansion) + (wrap (list pre_expansion))))))) + +(def: #export test + Test + (<| (_.covering /._) + (do {! random.monad} + [expected random.nat] + ($_ _.and + (_.cover [/.push] + (..with ["" "actual"] expected #0 + (n.= expected (..actual)))) + (_.cover [/.unknown_module] + (exception.match? /.unknown_module + (..macro_error + (..with ["123yolo456" "actual"] expected #0 + (n.= expected (..actual)))))) + (_.cover [/.cannot_shadow_definition] + (exception.match? /.cannot_shadow_definition + (..macro_error + (..with ["" "with"] expected #0 + (n.= expected (..actual)))))) + (_.cover [/.unknown_definition] + (exception.match? /.unknown_definition + (<| ..macro_error + (..with ["" "actual"] expected #1) + (n.= expected (..actual))))) + )))) diff --git a/stdlib/source/test/lux/macro/template.lux b/stdlib/source/test/lux/macro/template.lux index 8f85ff3ea..9f8b5af6c 100644 --- a/stdlib/source/test/lux/macro/template.lux +++ b/stdlib/source/test/lux/macro/template.lux @@ -117,10 +117,5 @@ [""]] (exception.match? /.irregular_arguments (macro_error (arity/3 "a" "b"))))) - (_.cover [/.cannot_shadow_definition] - (exception.match? /.cannot_shadow_definition - (macro_error (/.with [(macro_error <0> <1> <2>) - [""]] - "")))) ))) )) diff --git a/stdlib/source/test/lux/world.lux b/stdlib/source/test/lux/world.lux index 8b560ca40..62e0fc397 100644 --- a/stdlib/source/test/lux/world.lux +++ b/stdlib/source/test/lux/world.lux @@ -6,6 +6,8 @@ ["#." shell] ["#." console] ["#." program] + ["#." input #_ + ["#/." keyboard]] ["#." output #_ ["#/." video #_ ["#/." resolution]]]]) @@ -17,5 +19,6 @@ /shell.test /console.test /program.test + /input/keyboard.test /output/video/resolution.test )) diff --git a/stdlib/source/test/lux/world/input/keyboard.lux b/stdlib/source/test/lux/world/input/keyboard.lux new file mode 100644 index 000000000..e38ce6271 --- /dev/null +++ b/stdlib/source/test/lux/world/input/keyboard.lux @@ -0,0 +1,144 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [data + ["." bit ("#\." equivalence)] + ["." maybe] + [collection + ["." list] + ["." set (#+ Set)]]] + [math + ["." random (#+ Random)] + [number + ["n" nat]]]] + {1 + ["." /]}) + +(with_expansions [<keys> (as_is /.back_space + /.enter + /.shift + /.control + /.alt + /.caps_lock + /.escape + /.space + /.page_up + /.page_down + /.end + /.home + + /.left + /.up + /.right + /.down + + /.a + /.b + /.c + /.d + /.e + /.f + /.g + /.h + /.i + /.j + /.k + /.l + /.m + /.n + /.o + /.p + /.q + /.r + /.s + /.t + /.u + /.v + /.w + /.x + /.y + /.z + + /.num_pad_0 + /.num_pad_1 + /.num_pad_2 + /.num_pad_3 + /.num_pad_4 + /.num_pad_5 + /.num_pad_6 + /.num_pad_7 + /.num_pad_8 + /.num_pad_9 + + /.delete + /.num_lock + /.scroll_lock + /.print_screen + /.insert + /.windows + + /.f1 + /.f2 + /.f3 + /.f4 + /.f5 + /.f6 + /.f7 + /.f8 + /.f9 + /.f10 + /.f11 + /.f12 + /.f13 + /.f14 + /.f15 + /.f16 + /.f17 + /.f18 + /.f19 + /.f20 + /.f21 + /.f22 + /.f23 + /.f24)] + (def: listing + (List /.Key) + (list <keys>)) + + (def: catalogue + (Set /.Key) + (set.from_list n.hash ..listing)) + + (def: #export random + (Random /.Key) + (let [count (list.size ..listing)] + (do {! random.monad} + [choice (\ ! map (n.% count) random.nat)] + (wrap (maybe.assume (list.nth choice ..listing)))))) + + (def: #export test + Test + (<| (_.covering /._) + (_.for [/.Key]) + ($_ _.and + (_.cover [<keys>] + (n.= (list.size ..listing) + (set.size ..catalogue))) + + (_.for [/.Press] + (`` ($_ _.and + (~~ (template [<pressed?> <function>] + [(do random.monad + [key ..random + #let [sample (<function> key)]] + (_.cover [<function>] + (and (bit\= <pressed?> (get@ #/.pressed? sample)) + (n.= key (get@ #/.input sample)))))] + + [#0 /.release] + [#1 /.press] + )) + ))) + )))) diff --git a/stdlib/source/test/lux/world/output/video/resolution.lux b/stdlib/source/test/lux/world/output/video/resolution.lux index f5dcf5380..b7684ed2f 100644 --- a/stdlib/source/test/lux/world/output/video/resolution.lux +++ b/stdlib/source/test/lux/world/output/video/resolution.lux @@ -34,17 +34,20 @@ /.wuxga /.wqhd /.uhd-4k)] + (def: listing + (List /.Resolution) + (list <resolutions>)) + (def: catalogue (Set /.Resolution) - (set.from_list /.hash (list <resolutions>))) + (set.from_list /.hash ..listing)) (def: #export random (Random /.Resolution) - (let [listing (set.to_list catalogue) - count (list.size listing)] + (let [count (list.size ..listing)] (do {! random.monad} [choice (\ ! map (n.% count) random.nat)] - (wrap (maybe.assume (list.nth choice listing)))))) + (wrap (maybe.assume (list.nth choice ..listing)))))) (def: #export test Test @@ -57,7 +60,6 @@ ($hash.spec /.hash ..random)) (_.cover [<resolutions>] - (let [listing (set.to_list catalogue)] - (n.= (list.size listing) - (set.size catalogue)))) + (n.= (list.size ..listing) + (set.size ..catalogue))) )))) |