aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/lux/control.lux29
-rw-r--r--stdlib/source/test/lux/control/concurrency/stm.lux14
-rw-r--r--stdlib/source/test/lux/control/continuation.lux122
-rw-r--r--stdlib/source/test/lux/control/function/contract.lux39
-rw-r--r--stdlib/source/test/lux/data/format/tar.lux2
5 files changed, 123 insertions, 83 deletions
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index dbfb5b4a4..5c7f7b9ef 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -5,7 +5,9 @@
["#." concatenative]
["#." continuation]
["#." exception]
- ["#." function]
+ ["#." function
+ ["#/." memo]
+ ["#/." contract]]
["#." try]
["#." io]
["#." parser]
@@ -28,9 +30,7 @@
["#/." text]
["#/." cli]]
[security
- ["#." policy]]
- [function
- ["#." memo]]])
+ ["#." policy]]])
(def: concurrency
Test
@@ -44,9 +44,18 @@
/stm.test
))
+(def: function
+ Test
+ ($_ _.and
+ /function.test
+ /function/memo.test
+ /function/contract.test
+ ))
+
(def: parser
Test
($_ _.and
+ /parser.test
/parser/text.test
/parser/cli.test
))
@@ -57,22 +66,16 @@
/policy.test
))
-(def: function
- Test
- ($_ _.and
- /memo.test
- ))
-
(def: #export test
Test
($_ _.and
/concatenative.test
/continuation.test
/exception.test
- /function.test
+ ..function
/try.test
/io.test
- /parser.test
+ ..parser
/pipe.test
/reader.test
/region.test
@@ -81,7 +84,5 @@
/thread.test
/writer.test
..concurrency
- ..parser
..security
- ..function
))
diff --git a/stdlib/source/test/lux/control/concurrency/stm.lux b/stdlib/source/test/lux/control/concurrency/stm.lux
index ab795ea79..628aedfaf 100644
--- a/stdlib/source/test/lux/control/concurrency/stm.lux
+++ b/stdlib/source/test/lux/control/concurrency/stm.lux
@@ -11,6 +11,7 @@
[control
["." io (#+ IO)]]
[data
+ ["." product]
[number
["n" nat]]
[collection
@@ -31,17 +32,8 @@
(def: comparison
(Comparison /.STM)
(function (_ == left right)
- (io.run
- (do io.monad
- [?left (promise.poll (/.commit left))
- ?right (promise.poll (/.commit right))]
- (wrap (case [?left ?right]
- [(#.Some left)
- (#.Some right)]
- (== left right)
-
- _
- false))))))
+ (== (product.right (left (list)))
+ (product.right (right (list))))))
(def: #export test
Test
diff --git a/stdlib/source/test/lux/control/continuation.lux b/stdlib/source/test/lux/control/continuation.lux
index 1d07460c9..95aa5ec7a 100644
--- a/stdlib/source/test/lux/control/continuation.lux
+++ b/stdlib/source/test/lux/control/continuation.lux
@@ -11,78 +11,86 @@
[data
[number
["n" nat]]
- [text
- ["%" format (#+ format)]]
[collection
["." list]]]
[math
- ["r" random]]]
+ ["." random]]]
{1
- ["." / (#+ Cont)]})
+ ["." /]})
(def: injection
- (All [o] (Injection (All [i] (Cont i o))))
+ (All [o] (Injection (All [i] (/.Cont i o))))
(|>> /.pending))
(def: comparison
- (Comparison Cont)
+ (Comparison /.Cont)
(function (_ == left right)
(== (/.run left) (/.run right))))
(def: #export test
Test
- (<| (_.context (%.name (name-of /.Cont)))
- (do r.monad
- [sample r.nat
+ (<| (_.covering /._)
+ (do random.monad
+ [sample random.nat
#let [(^open "_@.") /.apply
(^open "_@.") /.monad]
- elems (r.list 3 r.nat)]
- ($_ _.and
- ($functor.spec ..injection ..comparison /.functor)
- ($apply.spec ..injection ..comparison /.apply)
- ($monad.spec ..injection ..comparison /.monad)
+ elems (random.list 3 random.nat)])
+ (_.with-cover [/.Cont])
+ ($_ _.and
+ (_.with-cover [/.functor]
+ ($functor.spec ..injection ..comparison /.functor))
+ (_.with-cover [/.apply]
+ ($apply.spec ..injection ..comparison /.apply))
+ (_.with-cover [/.monad]
+ ($monad.spec ..injection ..comparison /.monad))
- (_.test "Can run continuations to compute their values."
- (n.= sample (/.run (_@wrap sample))))
+ (_.cover [/.run]
+ (n.= sample (/.run (_@wrap sample))))
+ (_.cover [/.call/cc]
+ (n.= (n.* 2 sample)
+ (/.run (do {@ /.monad}
+ [value (/.call/cc
+ (function (_ k)
+ (do @
+ [temp (k sample)]
+ ## If this code where to run,
+ ## the output would be
+ ## (n.* 4 sample)
+ (k temp))))]
+ (wrap (n.* 2 value))))))
+ (_.cover [/.portal]
+ (n.= (n.+ 100 sample)
+ (/.run (do /.monad
+ [[restart [output idx]] (/.portal [sample 0])]
+ (if (n.< 10 idx)
+ (restart [(n.+ 10 output) (inc idx)])
+ (wrap output))))))
+ (_.cover [/.shift /.reset]
+ (let [(^open "_@.") /.monad
+ (^open "list@.") (list.equivalence n.equivalence)
+ visit (: (-> (List Nat)
+ (/.Cont (List Nat) (List Nat)))
+ (function (visit xs)
+ (case xs
+ #.Nil
+ (_@wrap #.Nil)
- (_.test "Can use the current-continuation as a escape hatch."
- (n.= (n.* 2 sample)
- (/.run (do {@ /.monad}
- [value (/.call/cc
- (function (_ k)
- (do @
- [temp (k sample)]
- ## If this code where to run,
- ## the output would be
- ## (n.* 4 sample)
- (k temp))))]
- (wrap (n.* 2 value))))))
-
- (_.test "Can use the current-continuation to build a time machine."
- (n.= (n.+ 100 sample)
- (/.run (do /.monad
- [[restart [output idx]] (/.portal [sample 0])]
- (if (n.< 10 idx)
- (restart [(n.+ 10 output) (inc idx)])
- (wrap output))))))
-
- (_.test "Can use delimited continuations with shifting."
- (let [(^open "_@.") /.monad
- (^open "list@.") (list.equivalence n.equivalence)
- visit (: (-> (List Nat)
- (Cont (List Nat) (List Nat)))
- (function (visit xs)
- (case xs
- #.Nil
- (_@wrap #.Nil)
-
- (#.Cons x xs')
- (do {@ /.monad}
- [output (/.shift (function (_ k)
- (do @
- [tail (k xs')]
- (wrap (#.Cons x tail)))))]
- (visit output)))))]
- (list@= elems
- (/.run (/.reset (visit elems))))))
- ))))
+ (#.Cons x xs')
+ (do {@ /.monad}
+ [output (/.shift (function (_ k)
+ (do @
+ [tail (k xs')]
+ (wrap (#.Cons x tail)))))]
+ (visit output)))))]
+ (list@= elems
+ (/.run (/.reset (visit elems))))))
+ (_.cover [/.continue]
+ (/.continue (is? sample)
+ (: (/.Cont Nat Bit)
+ (function (_ next)
+ (next sample)))))
+ (_.cover [/.pending]
+ (/.continue (is? sample)
+ (: (/.Cont Nat Bit)
+ (/.pending sample))))
+ )))
diff --git a/stdlib/source/test/lux/control/function/contract.lux b/stdlib/source/test/lux/control/function/contract.lux
new file mode 100644
index 000000000..0cde16295
--- /dev/null
+++ b/stdlib/source/test/lux/control/function/contract.lux
@@ -0,0 +1,39 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ ["." host]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." try]]
+ [math
+ ["." random]]
+ [data
+ [number
+ ["n" nat]]]]
+ {1
+ ["." /]})
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (do {@ random.monad}
+ [expected random.nat])
+ ($_ _.and
+ (_.cover [/.pre]
+ (case (host.try (/.pre (n.even? expected)
+ true))
+ (#try.Success output)
+ output
+
+ (#try.Failure error)
+ (not (n.even? expected))))
+ (_.cover [/.post]
+ (case (host.try (/.post n.odd?
+ expected))
+ (#try.Success actual)
+ (is? expected actual)
+
+ (#try.Failure error)
+ (not (n.odd? expected))))
+ )))
diff --git a/stdlib/source/test/lux/data/format/tar.lux b/stdlib/source/test/lux/data/format/tar.lux
index b8ba1af51..ebbdd8f1e 100644
--- a/stdlib/source/test/lux/data/format/tar.lux
+++ b/stdlib/source/test/lux/data/format/tar.lux
@@ -152,7 +152,7 @@
Test
(do {@ random.monad}
[expected-path (random.ascii/lower-alpha (dec /.path-size))
- expected-moment (:: @ map (|>> (n.% 1,00,00,00,00,00,000) .int instant.from-millis)
+ expected-moment (:: @ map (|>> (n.% 1,0,00,00,00,00,000) .int instant.from-millis)
random.nat)
chunk (random.ascii/lower-alpha chunk-size)
chunks (:: @ map (n.% 100) random.nat)
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 05:52:24 +0000