aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/lux/control/concurrency/frp.lux43
-rw-r--r--stdlib/source/test/lux/control/concurrency/promise.lux16
-rw-r--r--stdlib/source/test/lux/control/function/memo.lux2
-rw-r--r--stdlib/source/test/lux/control/parser/binary.lux43
-rw-r--r--stdlib/source/test/lux/locale.lux77
5 files changed, 133 insertions, 48 deletions
diff --git a/stdlib/source/test/lux/control/concurrency/frp.lux b/stdlib/source/test/lux/control/concurrency/frp.lux
index 70aae523e..fe082cda7 100644
--- a/stdlib/source/test/lux/control/concurrency/frp.lux
+++ b/stdlib/source/test/lux/control/concurrency/frp.lux
@@ -168,27 +168,28 @@
(_.claim [/.distinct]
(list@= (list distint/0 distint/1 distint/2)
actual))))
- (wrap (do promise.monad
- [#let [polling-delay 20
- amount-of-polls 5
- total-delay (n.* amount-of-polls polling-delay)
- [channel sink] (/.poll polling-delay (: (IO Nat) (io.io sample)))]
- _ (promise.schedule total-delay (io.io []))
- _ (promise.future (:: sink close))
- actual (/.consume channel)]
- (_.claim [/.poll]
- (and (list.every? (n.= sample) actual)
- (n.>= amount-of-polls (list.size actual))))))
- (wrap (do promise.monad
- [#let [polling-delay 20
- amount-of-polls 5
- total-delay (n.* amount-of-polls polling-delay)
- [channel sink] (/.periodic polling-delay)]
- _ (promise.schedule total-delay (io.io []))
- _ (promise.future (:: sink close))
- actual (/.consume channel)]
- (_.claim [/.periodic]
- (n.>= amount-of-polls (list.size actual)))))
+ (let [polling-delay 10
+ wiggle-room (n.* 2 polling-delay)
+ amount-of-polls 5
+ total-delay (|> polling-delay
+ (n.* amount-of-polls)
+ (n.+ wiggle-room))]
+ ($_ _.and
+ (wrap (do promise.monad
+ [#let [[channel sink] (/.poll polling-delay (: (IO Nat) (io.io sample)))]
+ _ (promise.schedule total-delay (io.io []))
+ _ (promise.future (:: sink close))
+ actual (/.consume channel)]
+ (_.claim [/.poll]
+ (and (list.every? (n.= sample) actual)
+ (n.>= amount-of-polls (list.size actual))))))
+ (wrap (do promise.monad
+ [#let [[channel sink] (/.periodic polling-delay)]
+ _ (promise.schedule total-delay (io.io []))
+ _ (promise.future (:: sink close))
+ actual (/.consume channel)]
+ (_.claim [/.periodic]
+ (n.>= amount-of-polls (list.size actual)))))))
(wrap (do promise.monad
[#let [max-iterations 10]
actual (|> [0 sample]
diff --git a/stdlib/source/test/lux/control/concurrency/promise.lux b/stdlib/source/test/lux/control/concurrency/promise.lux
index 2495223b5..1c8933499 100644
--- a/stdlib/source/test/lux/control/concurrency/promise.lux
+++ b/stdlib/source/test/lux/control/concurrency/promise.lux
@@ -109,10 +109,10 @@
(i.>= (.int to-wait)
(duration.to-millis (instant.span pre post)))))))
(wrap (do /.monad
- [?left (/.or (/.delay 10 leftE)
- (/.delay 20 dummy))
- ?right (/.or (/.delay 20 dummy)
- (/.delay 10 rightE))]
+ [?left (/.or (/.delay 100 leftE)
+ (/.delay 200 dummy))
+ ?right (/.or (/.delay 200 dummy)
+ (/.delay 100 rightE))]
(_.claim [/.or]
(case [?left ?right]
[(#.Left leftA) (#.Right rightA)]
@@ -122,10 +122,10 @@
_
false))))
(wrap (do /.monad
- [leftA (/.either (/.delay 10 leftE)
- (/.delay 20 dummy))
- rightA (/.either (/.delay 20 dummy)
- (/.delay 10 rightE))]
+ [leftA (/.either (/.delay 100 leftE)
+ (/.delay 200 dummy))
+ rightA (/.either (/.delay 200 dummy)
+ (/.delay 100 rightE))]
(_.claim [/.either]
(n.= (n.+ leftE rightE)
(n.+ leftA rightA)))))
diff --git a/stdlib/source/test/lux/control/function/memo.lux b/stdlib/source/test/lux/control/function/memo.lux
index a00b8bc58..d09625d79 100644
--- a/stdlib/source/test/lux/control/function/memo.lux
+++ b/stdlib/source/test/lux/control/function/memo.lux
@@ -50,7 +50,7 @@
Test
(<| (_.covering /._)
(do {@ random.monad}
- [input (|> random.nat (:: @ map (|>> (n.% 6) (n.+ 20))))])
+ [input (|> random.nat (:: @ map (|>> (n.% 5) (n.+ 21))))])
(_.with-cover [/.Memo])
($_ _.and
(_.cover [/.closed /.none]
diff --git a/stdlib/source/test/lux/control/parser/binary.lux b/stdlib/source/test/lux/control/parser/binary.lux
index d646852f3..8bc24976e 100644
--- a/stdlib/source/test/lux/control/parser/binary.lux
+++ b/stdlib/source/test/lux/control/parser/binary.lux
@@ -3,8 +3,10 @@
["_" test (#+ Test)]
[abstract
[equivalence (#+ Equivalence)]
+ [predicate (#+ Predicate)]
[monad (#+ do)]]
[control
+ [pipe (#+ case>)]
["." try]
["." exception]
["<>" parser]]
@@ -15,7 +17,8 @@
["." bit]
["." name]
["." text ("#@." equivalence)
- ["." encoding]]
+ ["." encoding]
+ ["%" format (#+ format)]]
["." format #_
["#" binary]]
[number
@@ -46,10 +49,25 @@
(def: segment-size 10)
+(def: (utf8-conversion-does-not-alter? value)
+ (Predicate Text)
+ (|> value
+ encoding.to-utf8
+ encoding.from-utf8
+ (case> (#try.Success converted)
+ (text@= value converted)
+
+ (#try.Failure error)
+ false)))
+
+(def: random-text
+ (Random Text)
+ (random.filter ..utf8-conversion-does-not-alter?
+ (random.unicode ..segment-size)))
+
(def: random-name
(Random Name)
- (random.and (random.unicode ..segment-size)
- (random.unicode ..segment-size)))
+ (random.and ..random-text ..random-text))
(structure: cursor-equivalence
(Equivalence Cursor)
@@ -63,7 +81,7 @@
(def: random-cursor
(Random Cursor)
($_ random.and
- (random.unicode ..segment-size)
+ ..random-text
random.nat
random.nat))
@@ -83,7 +101,7 @@
random.int
random.rev
random.frac
- (random.unicode ..segment-size)
+ ..random-text
..random-name
..random-name
random-sequence
@@ -186,7 +204,8 @@
[(do {@ random.monad}
[expected <random>]
(_.cover [<parser>]
- (|> (format.run <format> expected)
+ (|> expected
+ (format.run <format>)
(/.run <parser>)
(!expect (^multi (#try.Success actual)
(:: <equivalence> = expected actual))))))]
@@ -195,8 +214,7 @@
[/.nat format.nat random.nat n.equivalence]
[/.int format.int random.int int.equivalence]
[/.rev format.rev random.rev rev.equivalence]
- [/.frac format.frac random.frac frac.equivalence]
- ))
+ [/.frac format.frac random.frac frac.equivalence]))
(do {@ random.monad}
[expected (:: @ map (|>> (i64.and (i64.mask /.size/8))
(n.max 2))
@@ -216,7 +234,8 @@
[(do {@ random.monad}
[expected <random>]
(_.cover [<parser>]
- (|> (format.run <format> expected)
+ (|> expected
+ (format.run <format>)
(/.run <parser>)
(!expect (^multi (#try.Success actual)
(:: <equivalence> = expected actual))))))]
@@ -229,7 +248,8 @@
[(do {@ random.monad}
[expected <random>]
(_.cover [<cover>]
- (|> (format.run <format> expected)
+ (|> expected
+ (format.run <format>)
(/.run <parser>)
(!expect (^multi (#try.Success actual)
(:: <equivalence> = expected actual))))))]
@@ -237,8 +257,7 @@
[/.maybe (/.maybe /.nat) (format.maybe format.nat) (random.maybe random.nat) (maybe.equivalence n.equivalence)]
[/.list (/.list /.nat) (format.list format.nat) (random.list ..segment-size random.nat) (list.equivalence n.equivalence)]
[/.set (/.set n.hash /.nat) (format.set format.nat) (random.set n.hash ..segment-size random.nat) set.equivalence]
- [/.name /.name format.name ..random-name name.equivalence]
- ))
+ [/.name /.name format.name ..random-name name.equivalence]))
(do {@ random.monad}
[expected (:: @ map (list.repeat ..segment-size) random.nat)]
(_.cover [/.set-elements-are-not-unique]
diff --git a/stdlib/source/test/lux/locale.lux b/stdlib/source/test/lux/locale.lux
index 0e6f0ea01..37a629596 100644
--- a/stdlib/source/test/lux/locale.lux
+++ b/stdlib/source/test/lux/locale.lux
@@ -1,13 +1,78 @@
(.module:
[lux #*
- ["_" test (#+ Test)]]
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]
+ {[0 #spec]
+ [/
+ ["$." equivalence]]}]
+ [math
+ ["." random (#+ Random) ("#@." monad)]]
+ [data
+ ["." text ("#@." equivalence)
+ ["." encoding (#+ Encoding)]]
+ [collection
+ ["." list]]]]
["." / #_
["#." language]
- ["#." territory]])
+ ["#." territory]]
+ {1
+ ["." /
+ ["." language (#+ Language)]
+ ["." territory (#+ Territory)]]})
+
+(def: random-language
+ (Random Language)
+ (random.either (random@wrap language.afar)
+ (random@wrap language.zaza)))
+
+(def: random-territory
+ (Random Territory)
+ (random.either (random@wrap territory.afghanistan)
+ (random@wrap territory.zimbabwe)))
+
+(def: random-encoding
+ (Random Encoding)
+ (random.either (random@wrap encoding.ascii)
+ (random@wrap encoding.koi8-u)))
+
+(def: random-locale
+ (Random /.Locale)
+ (do random.monad
+ [language ..random-language
+ territory ..random-territory
+ encoding ..random-encoding]
+ (wrap (/.locale language (#.Some territory) (#.Some encoding)))))
(def: #export test
Test
- ($_ _.and
- /language.test
- /territory.test
- ))
+ (<| (_.covering /._)
+ (_.with-cover [/.Locale])
+ ($_ _.and
+ (_.with-cover [/.equivalence]
+ ($equivalence.spec /.equivalence ..random-locale))
+
+ (do random.monad
+ [language ..random-language
+ territory ..random-territory
+ encoding ..random-encoding
+ #let [l-locale (/.locale language #.None #.None)
+ lt-locale (/.locale language (#.Some territory) #.None)
+ le-locale (/.locale language #.None (#.Some encoding))
+ lte-locale (/.locale language (#.Some territory) (#.Some encoding))]
+ #let [language-check (and (text@= (language.code language)
+ (/.code l-locale))
+ (list.every? (|>> /.code (text.starts-with? (language.code language)))
+ (list lt-locale le-locale lte-locale)))
+ territory-check (list.every? (|>> /.code (text.contains? (territory.long-code territory)))
+ (list lt-locale lte-locale))
+ encoding-check (list.every? (|>> /.code (text.ends-with? (encoding.name encoding)))
+ (list le-locale lte-locale))]]
+ (_.cover [/.locale /.code]
+ (and language-check
+ territory-check
+ encoding-check)))
+
+ /language.test
+ /territory.test
+ )))
generated by cgit v1.2.3 (git 2.25.1) at 2024-09-19 09:24:42 +0000