aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/aedifex/command.lux30
-rw-r--r--stdlib/source/test/aedifex/command/build.lux9
-rw-r--r--stdlib/source/test/aedifex/command/deploy.lux36
-rw-r--r--stdlib/source/test/aedifex/command/deps.lux43
-rw-r--r--stdlib/source/test/aedifex/command/test.lux4
-rw-r--r--stdlib/source/test/aedifex/dependency/resolution.lux232
-rw-r--r--stdlib/source/test/lux.lux3
-rw-r--r--stdlib/source/test/lux/macro.lux8
-rw-r--r--stdlib/source/test/lux/macro/local.lux90
-rw-r--r--stdlib/source/test/lux/macro/template.lux5
-rw-r--r--stdlib/source/test/lux/world.lux3
-rw-r--r--stdlib/source/test/lux/world/input/keyboard.lux144
-rw-r--r--stdlib/source/test/lux/world/output/video/resolution.lux16
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)))
))))