aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/aedifex/artifact.lux2
-rw-r--r--stdlib/source/test/aedifex/artifact/versioning.lux43
-rw-r--r--stdlib/source/test/lux/control/remember.lux12
-rw-r--r--stdlib/source/test/lux/data/format/json.lux4
-rw-r--r--stdlib/source/test/lux/data/text/regex.lux5
-rw-r--r--stdlib/source/test/lux/macro.lux182
-rw-r--r--stdlib/source/test/lux/meta.lux10
-rw-r--r--stdlib/source/test/lux/time/instant.lux114
8 files changed, 311 insertions, 61 deletions
diff --git a/stdlib/source/test/aedifex/artifact.lux b/stdlib/source/test/aedifex/artifact.lux
index 7409a65e2..7d91ebed7 100644
--- a/stdlib/source/test/aedifex/artifact.lux
+++ b/stdlib/source/test/aedifex/artifact.lux
@@ -22,6 +22,7 @@
["#." type]
["#." extension]
["#." value]
+ ["#." versioning]
["#." time_stamp
["#/." date]
["#/." time]]]
@@ -47,6 +48,7 @@
/type.test
/extension.test
/value.test
+ /versioning.test
/time_stamp.test
/time_stamp/date.test
/time_stamp/time.test
diff --git a/stdlib/source/test/aedifex/artifact/versioning.lux b/stdlib/source/test/aedifex/artifact/versioning.lux
new file mode 100644
index 000000000..c0704440e
--- /dev/null
+++ b/stdlib/source/test/aedifex/artifact/versioning.lux
@@ -0,0 +1,43 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]
+ {[0 #spec]
+ [/
+ ["$." equivalence]]}]
+ [control
+ ["." try ("#\." functor)]
+ [parser
+ ["<.>" xml]]]
+ [math
+ ["." random (#+ Random)]]]
+ {#program
+ ["." /]})
+
+(def: #export random
+ (Random /.Versioning)
+ ($_ random.and
+ random.instant
+ random.nat
+ (random.list 5 (random.ascii/lower_alpha 3))
+ ))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.for [/.Versioning])
+ ($_ _.and
+ (_.for [/.equivalence]
+ ($equivalence.spec /.equivalence ..random))
+
+ (do random.monad
+ [expected ..random
+ version (random.ascii/upper_alpha 3)]
+ (_.cover [/.format /.parser]
+ (|> expected
+ (/.format version)
+ (<xml>.run (/.parser version))
+ (try\map (\ /.equivalence = expected))
+ (try.default false))))
+ )))
diff --git a/stdlib/source/test/lux/control/remember.lux b/stdlib/source/test/lux/control/remember.lux
index fb7517237..753130ea2 100644
--- a/stdlib/source/test/lux/control/remember.lux
+++ b/stdlib/source/test/lux/control/remember.lux
@@ -1,6 +1,7 @@
(.module:
[lux #*
["_" test (#+ Test)]
+ ["." meta]
[abstract
["." monad (#+ do)]]
[control
@@ -20,8 +21,7 @@
["." date (#+ Date)]
["." instant]
["." duration]]
- ["." meta]
- [macro
+ ["." macro
["." code]
["." syntax (#+ syntax:)]]]
{1
@@ -71,10 +71,10 @@
message (product.right (random.run prng ..message))
expected (product.right (random.run prng ..focus))]
(do meta.monad
- [should_fail0 (..try (meta.expand (to_remember macro yesterday message #.None)))
- should_fail1 (..try (meta.expand (to_remember macro yesterday message (#.Some expected))))
- should_succeed0 (..try (meta.expand (to_remember macro tomorrow message #.None)))
- should_succeed1 (..try (meta.expand (to_remember macro tomorrow message (#.Some expected))))]
+ [should_fail0 (..try (macro.expand (to_remember macro yesterday message #.None)))
+ should_fail1 (..try (macro.expand (to_remember macro yesterday message (#.Some expected))))
+ should_succeed0 (..try (macro.expand (to_remember macro tomorrow message #.None)))
+ should_succeed1 (..try (macro.expand (to_remember macro tomorrow message (#.Some expected))))]
(wrap (list (code.bit (and (case should_fail0
(#try.Failure error)
(and (test_failure yesterday message #.None error)
diff --git a/stdlib/source/test/lux/data/format/json.lux b/stdlib/source/test/lux/data/format/json.lux
index 4f14375d9..091f64b67 100644
--- a/stdlib/source/test/lux/data/format/json.lux
+++ b/stdlib/source/test/lux/data/format/json.lux
@@ -25,7 +25,7 @@
[number
["n" nat]
["." frac]]]
- [macro
+ ["." macro
["." syntax (#+ syntax:)]
["." code]]]
{1
@@ -58,7 +58,7 @@
(syntax: (string)
(do meta.monad
- [value (meta.gensym "string")]
+ [value (macro.gensym "string")]
(wrap (list (code.text (%.code value))))))
(def: #export test
diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux
index 2cdead181..fd82fdee5 100644
--- a/stdlib/source/test/lux/data/text/regex.lux
+++ b/stdlib/source/test/lux/data/text/regex.lux
@@ -15,8 +15,7 @@
[math
[number (#+ hex)]
["." random]]
- ["." meta]
- [macro
+ ["." macro
[syntax (#+ syntax:)]]]
{1
["." /]})
@@ -52,7 +51,7 @@
false)))
(syntax: (should_check pattern regex input)
- (meta.with_gensyms [g!message g!_]
+ (macro.with_gensyms [g!message g!_]
(wrap (list (` (|> (~ input)
(<text>.run (~ regex))
(case> (^ (#try.Success (~ pattern)))
diff --git a/stdlib/source/test/lux/macro.lux b/stdlib/source/test/lux/macro.lux
index 54370efb9..0b1077526 100644
--- a/stdlib/source/test/lux/macro.lux
+++ b/stdlib/source/test/lux/macro.lux
@@ -1,17 +1,185 @@
(.module:
[lux #*
- ["_" test (#+ Test)]]
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." try ("#\." functor)]
+ [parser
+ ["<.>" code]]]
+ [data
+ ["." bit ("#\." equivalence)]
+ ["." name]
+ ["." text
+ ["%" format (#+ format)]]
+ [collection
+ ["." list]]]
+ [math
+ ["." random (#+ Random)]
+ [number
+ ["." nat]]]
+ ["." meta
+ ["." location]]]
+ {1
+ ["." /
+ [syntax (#+ syntax:)]
+ ["." code ("#\." equivalence)]
+ ["." template]]}
["." / #_
["#." code]
["#." template]
["#." poly]
["#." syntax]])
+(template: (!expect <pattern> <value>)
+ (case <value>
+ <pattern> true
+ _ false))
+
+(template: (!global <definition>)
+ (: [Text .Global]
+ [(template.text [<definition>]) (#.Definition [true .Macro (' []) <definition>])]))
+
+(syntax: (pow/2 number)
+ (wrap (list (` (nat.* (~ number) (~ number))))))
+
+(syntax: (pow/4 number)
+ (wrap (list (` (..pow/2 (..pow/2 (~ number)))))))
+
+(syntax: (repeat {times <code>.nat} token)
+ (wrap (list.repeat times token)))
+
+(syntax: (fresh_identifier)
+ (do meta.monad
+ [g!fresh (/.gensym "fresh")]
+ (wrap (list g!fresh))))
+
+(def: random_lux
+ (Random [Nat Text .Lux])
+ (do {! random.monad}
+ [seed random.nat
+ gensym_prefix (random.ascii/upper_alpha 1)
+ #let [macro_module (name.module (name_of /._))
+ current_module (name.module (name_of .._))]]
+ (wrap [seed
+ gensym_prefix
+ {#.info {#.target ""
+ #.version ""
+ #.mode #.Build}
+ #.source [location.dummy 0 ""]
+ #.location location.dummy
+ #.current_module (#.Some current_module)
+ #.modules (list [macro_module
+ {#.module_hash 0
+ #.module_aliases (list)
+ #.definitions (: (List [Text .Global])
+ (list (!global /.log_expand_once!)
+ (!global /.log_expand!)
+ (!global /.log_expand_all!)))
+ #.imports (list)
+ #.tags (list)
+ #.types (list)
+ #.module_annotations #.None
+ #.module_state #.Active}]
+ [current_module
+ {#.module_hash 0
+ #.module_aliases (list)
+ #.definitions (: (List [Text .Global])
+ (list (!global ..pow/2)
+ (!global ..pow/4)
+ (!global ..repeat)))
+ #.imports (list)
+ #.tags (list)
+ #.types (list)
+ #.module_annotations #.None
+ #.module_state #.Active}])
+ #.scopes (list)
+ #.type_context {#.ex_counter 0
+ #.var_counter 0
+ #.var_bindings (list)}
+ #.expected #.None
+ #.seed seed
+ #.scope_type_vars (list)
+ #.extensions []
+ #.host []}])))
+
+(def: expander
+ Test
+ (do {! random.monad}
+ [[seed gensym_prefix lux] ..random_lux
+
+ pow/1 (\ ! map code.nat random.nat)
+
+ repetitions (\ ! map (nat.% 10) random.nat)
+ #let [expand_once (` (..pow/2 (..pow/2 (~ pow/1))))
+ expand (` (nat.* (..pow/2 (~ pow/1))
+ (..pow/2 (~ pow/1))))
+ expand_all (` (nat.* (nat.* (~ pow/1) (~ pow/1))
+ (nat.* (~ pow/1) (~ pow/1))))]]
+ (`` ($_ _.and
+ (~~ (template [<expander> <logger> <expansion>]
+ [(_.cover [<expander>]
+ (|> (<expander> (` (..pow/4 (~ pow/1))))
+ (meta.run lux)
+ (try\map (\ (list.equivalence code.equivalence) =
+ (list <expansion>)))
+ (try.default false)))
+
+ (_.cover [<logger>]
+ (and (|> (/.expand_once (` (<logger> (~' #omit) (..pow/4 (~ pow/1)))))
+ (meta.run lux)
+ (try\map (\ (list.equivalence code.equivalence) = (list)))
+ (try.default false))
+ (|> (/.expand_once (` (<logger> (..pow/4 (~ pow/1)))))
+ (meta.run lux)
+ (try\map (\ (list.equivalence code.equivalence) = (list <expansion>)))
+ (try.default false))))]
+
+ [/.expand_once /.log_expand_once! expand_once]
+ [/.expand /.log_expand! expand]
+ [/.expand_all /.log_expand_all! expand_all]
+ ))
+ (_.cover [/.expand_1]
+ (bit\= (not (nat.= 1 repetitions))
+ (|> (/.expand_1 (` (..repeat (~ (code.nat repetitions)) (~ pow/1))))
+ (meta.run lux)
+ (!expect (#try.Failure _)))))
+ ))))
+
(def: #export test
Test
- ($_ _.and
- /code.test
- /template.test
- /syntax.test
- /poly.test
- ))
+ (<| (_.covering /._)
+ ($_ _.and
+ (do {! random.monad}
+ [[seed gensym_prefix lux] ..random_lux]
+ ($_ _.and
+ (_.cover [/.gensym]
+ (|> (/.gensym gensym_prefix)
+ (\ meta.monad map %.code)
+ (meta.run lux)
+ (!expect (^multi (#try.Success actual_gensym)
+ (and (text.contains? gensym_prefix actual_gensym)
+ (text.contains? (%.nat seed) actual_gensym))))))
+ (_.cover [/.wrong_syntax_error]
+ (|> (/.expand_once (` (/.log_expand_once!)))
+ (meta.run lux)
+ (!expect (^multi (#try.Failure error)
+ (text.contains? (/.wrong_syntax_error (name_of /.log_expand_once!))
+ error)))))
+ (_.cover [/.with_gensyms]
+ (with_expansions [<expected> (fresh_identifier)]
+ (|> (/.with_gensyms [<expected>]
+ (\ meta.monad wrap <expected>))
+ (meta.run lux)
+ (!expect (^multi (#try.Success [_ (#.Identifier ["" actual])])
+ (text.contains? (template.text [<expected>])
+ actual))))))
+ ))
+
+ ..expander
+
+ /code.test
+ /template.test
+ /syntax.test
+ /poly.test
+ )))
diff --git a/stdlib/source/test/lux/meta.lux b/stdlib/source/test/lux/meta.lux
index e740c1237..c1e0e8e03 100644
--- a/stdlib/source/test/lux/meta.lux
+++ b/stdlib/source/test/lux/meta.lux
@@ -49,7 +49,6 @@
expected_seed random.nat
expected random.nat
dummy (random.filter (|>> (n.= expected) not) random.nat)
- expected_gensym (random.ascii/upper_alpha 1)
#let [expected_lux {#.info {#.target target
#.version version
#.mode #.Build}
@@ -292,7 +291,6 @@
expected_seed random.nat
expected random.nat
dummy (random.filter (|>> (n.= expected) not) random.nat)
- expected_gensym (random.ascii/upper_alpha 1)
expected_location ..random_location
#let [type_context {#.ex_counter 0
#.var_counter 0
@@ -321,13 +319,6 @@
(!expect (^multi (#try.Success [actual_pre actual_post])
(and (n.= expected_seed actual_pre)
(n.= (inc expected_seed) actual_post))))))
- (_.cover [/.gensym]
- (|> (/.gensym expected_gensym)
- (\ /.monad map %.code)
- (/.run expected_lux)
- (!expect (^multi (#try.Success actual_gensym)
- (and (text.contains? expected_gensym actual_gensym)
- (text.contains? (%.nat expected_seed) actual_gensym))))))
(_.cover [/.location]
(|> /.location
(/.run expected_lux)
@@ -781,7 +772,6 @@
expected_seed random.nat
expected random.nat
dummy (random.filter (|>> (n.= expected) not) random.nat)
- expected_gensym (random.ascii/upper_alpha 1)
expected_location ..random_location
#let [expected_lux {#.info {#.target target
#.version version
diff --git a/stdlib/source/test/lux/time/instant.lux b/stdlib/source/test/lux/time/instant.lux
index 9ed1df446..4f6080b48 100644
--- a/stdlib/source/test/lux/time/instant.lux
+++ b/stdlib/source/test/lux/time/instant.lux
@@ -1,9 +1,9 @@
(.module:
[lux #*
- ["%" data/text/format (#+ format)]
["_" test (#+ Test)]
+ ["." host]
[abstract
- [monad (#+ do Monad)]
+ [monad (#+ do)]
{[0 #spec]
[/
["$." equivalence]
@@ -11,48 +11,96 @@
["$." enum]
["$." codec]]}]
[control
+ ["." function]
["." try]]
[data
- ["." text]]
+ [collection
+ ["." list ("#\." fold)]]]
[math
- ["." random (#+ Random)]
- [number
- ["i" int]]]
+ ["." random]]
[time
- ["@d" duration]
- ["@." date]]]
+ ["." duration (#+ Duration)]
+ ["." day (#+ Day) ("#\." enum)]]]
{1
- ["." / (#+ Instant)]})
-
-(def: #export instant
- (Random Instant)
- (\ random.monad map /.from_millis random.int))
+ ["." /]})
(def: #export test
Test
- (<| (_.context (%.name (name_of /._)))
+ (<| (_.covering /._)
+ (_.for [/.Instant])
($_ _.and
- ($equivalence.spec /.equivalence ..instant)
- ($order.spec /.order ..instant)
- ($enum.spec /.enum ..instant)
- ($codec.spec /.equivalence /.codec ..instant)
+ (_.for [/.equivalence]
+ ($equivalence.spec /.equivalence random.instant))
+ (_.for [/.order]
+ ($order.spec /.order random.instant))
+ (_.for [/.enum]
+ ($enum.spec /.enum random.instant))
+ (_.for [/.codec]
+ ($codec.spec /.equivalence /.codec random.instant))
(do random.monad
- [millis random.int]
- (_.test "Can convert from/to milliseconds."
- (|> millis /.from_millis /.to_millis (i.= millis))))
+ [#let [(^open "\.") /.equivalence]
+ expected random.instant]
+ ($_ _.and
+ (_.cover [/.to_millis /.from_millis]
+ (|> expected /.to_millis /.from_millis (\= expected)))
+ (_.cover [/.relative /.absolute]
+ (|> expected /.relative /.absolute (\= expected)))
+ (_.cover [/.date /.time /.from_date_time]
+ (\= expected
+ (/.from_date_time (/.date expected)
+ (/.time expected))))
+ ))
(do random.monad
- [sample instant
- span random.duration
- #let [(^open "@/.") /.equivalence
- (^open "@d/.") @d.equivalence]]
+ [#let [(^open "\.") /.equivalence
+ (^open "duration\.") duration.equivalence]
+ from random.instant
+ to random.instant]
($_ _.and
- (_.test "The span of a instant and itself has an empty duration."
- (|> sample (/.span sample) (@d/= @d.empty)))
- (_.test "Can shift a instant by a duration."
- (|> sample (/.shift span) (/.span sample) (@d/= span)))
- (_.test "Can obtain the time-span between the epoch and an instant."
- (|> sample /.relative /.absolute (@/= sample)))
- (_.test "All instants are relative to the epoch."
- (|> /.epoch (/.shift (/.relative sample)) (@/= sample)))))
+ (_.cover [/.span]
+ (|> from (/.span from) (duration\= duration.empty)))
+ (_.cover [/.shift]
+ (|> from (/.shift (/.span from to)) (\= to)))
+ (_.cover [/.epoch]
+ (duration\= (/.relative to)
+ (/.span /.epoch to)))
+ ))
+ (do random.monad
+ [instant random.instant
+ #let [d0 (/.day_of_week instant)]]
+ (_.cover [/.day_of_week]
+ (let [apply (: (-> (-> Duration Duration) (-> Day Day) Nat Bit)
+ (function (_ polarity move steps)
+ (let [day_shift (list\fold (function.constant move)
+ d0
+ (list.repeat steps []))
+ instant_shift (|> instant
+ (/.shift (polarity (duration.up steps duration.day)))
+ /.day_of_week)]
+ (day\= day_shift
+ instant_shift))))]
+ (and (apply function.identity day\succ 0)
+ (apply function.identity day\succ 1)
+ (apply function.identity day\succ 2)
+ (apply function.identity day\succ 3)
+ (apply function.identity day\succ 4)
+ (apply function.identity day\succ 5)
+ (apply function.identity day\succ 6)
+ (apply function.identity day\succ 7)
+
+ (apply duration.inverse day\pred 0)
+ (apply duration.inverse day\pred 1)
+ (apply duration.inverse day\pred 2)
+ (apply duration.inverse day\pred 3)
+ (apply duration.inverse day\pred 4)
+ (apply duration.inverse day\pred 5)
+ (apply duration.inverse day\pred 6)
+ (apply duration.inverse day\pred 7)))))
+ (_.cover [/.now]
+ (case (host.try /.now)
+ (#try.Success _)
+ true
+
+ (#try.Failure _)
+ false))
)))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-23 08:38:22 +0000