aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEduardo Julian2017-10-20 19:09:34 -0400
committerEduardo Julian2017-10-20 19:09:34 -0400
commite9368bc5f75345c81bd7ded21e07a4436641821a (patch)
tree41b2dded0775543d28b433b8a5bd39eb08b5787e
parenteb770f4473a904285ea559279331a93cdb5b7ded (diff)
- Replaced the "#seed" and "#times" options for "seed" and "times" test combinators.
-rw-r--r--stdlib/source/lux/data/number/complex.lux3
-rw-r--r--stdlib/source/lux/test.lux309
-rw-r--r--stdlib/test/test/lux.lux186
-rw-r--r--stdlib/test/test/lux/cli.lux82
-rw-r--r--stdlib/test/test/lux/concurrency/actor.lux30
-rw-r--r--stdlib/test/test/lux/concurrency/atom.lux36
-rw-r--r--stdlib/test/test/lux/concurrency/frp.lux202
-rw-r--r--stdlib/test/test/lux/concurrency/promise.lux80
-rw-r--r--stdlib/test/test/lux/concurrency/stm.lux75
-rw-r--r--stdlib/test/test/lux/control/cont.lux110
-rw-r--r--stdlib/test/test/lux/control/exception.lux58
-rw-r--r--stdlib/test/test/lux/control/interval.lux320
-rw-r--r--stdlib/test/test/lux/control/state.lux168
-rw-r--r--stdlib/test/test/lux/data/bit.lux118
-rw-r--r--stdlib/test/test/lux/data/bool.lux42
-rw-r--r--stdlib/test/test/lux/data/coll/array.lux218
-rw-r--r--stdlib/test/test/lux/data/coll/dict.lux210
-rw-r--r--stdlib/test/test/lux/data/coll/list.lux368
-rw-r--r--stdlib/test/test/lux/data/coll/ordered/dict.lux122
-rw-r--r--stdlib/test/test/lux/data/coll/ordered/set.lux150
-rw-r--r--stdlib/test/test/lux/data/coll/priority-queue.lux54
-rw-r--r--stdlib/test/test/lux/data/coll/queue.lux72
-rw-r--r--stdlib/test/test/lux/data/coll/sequence.lux102
-rw-r--r--stdlib/test/test/lux/data/coll/set.lux94
-rw-r--r--stdlib/test/test/lux/data/coll/stack.lux46
-rw-r--r--stdlib/test/test/lux/data/coll/stream.lux156
-rw-r--r--stdlib/test/test/lux/data/coll/tree/rose.lux30
-rw-r--r--stdlib/test/test/lux/data/coll/tree/zipper.lux170
-rw-r--r--stdlib/test/test/lux/data/color.lux102
-rw-r--r--stdlib/test/test/lux/data/format/json.lux54
-rw-r--r--stdlib/test/test/lux/data/format/xml.lux108
-rw-r--r--stdlib/test/test/lux/data/ident.lux72
-rw-r--r--stdlib/test/test/lux/data/lazy.lux86
-rw-r--r--stdlib/test/test/lux/data/number.lux132
-rw-r--r--stdlib/test/test/lux/data/number/complex.lux297
-rw-r--r--stdlib/test/test/lux/data/number/ratio.lux136
-rw-r--r--stdlib/test/test/lux/data/text.lux181
-rw-r--r--stdlib/test/test/lux/data/text/lexer.lux28
-rw-r--r--stdlib/test/test/lux/data/text/regex.lux31
-rw-r--r--stdlib/test/test/lux/host.jvm.lux62
-rw-r--r--stdlib/test/test/lux/math.lux210
-rw-r--r--stdlib/test/test/lux/math/logic/continuous.lux40
-rw-r--r--stdlib/test/test/lux/math/logic/fuzzy.lux274
-rw-r--r--stdlib/test/test/lux/math/random.lux76
-rw-r--r--stdlib/test/test/lux/meta/poly/eq.lux10
-rw-r--r--stdlib/test/test/lux/meta/type.lux166
-rw-r--r--stdlib/test/test/lux/meta/type/auto.lux42
-rw-r--r--stdlib/test/test/lux/meta/type/check.lux68
-rw-r--r--stdlib/test/test/lux/time/date.lux149
-rw-r--r--stdlib/test/test/lux/time/duration.lux106
-rw-r--r--stdlib/test/test/lux/time/instant.lux108
-rw-r--r--stdlib/test/test/lux/world/blob.lux144
-rw-r--r--stdlib/test/test/lux/world/file.lux278
-rw-r--r--stdlib/test/test/lux/world/net/tcp.lux60
-rw-r--r--stdlib/test/test/lux/world/net/udp.lux60
55 files changed, 3446 insertions, 3245 deletions
diff --git a/stdlib/source/lux/data/number/complex.lux b/stdlib/source/lux/data/number/complex.lux
index ffe40e20e..778b4a1db 100644
--- a/stdlib/source/lux/data/number/complex.lux
+++ b/stdlib/source/lux/data/number/complex.lux
@@ -16,9 +16,6 @@
(meta [code]
["s" syntax #+ syntax: Syntax])))
-## Based on org.apache.commons.math4.complex.Complex
-## https://github.com/apache/commons-math/blob/master/src/main/java/org/apache/commons/math4/complex/Complex.java
-
(type: #export Complex
{#real Frac
#imaginary Frac})
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux
index f4c55d69b..5568478a0 100644
--- a/stdlib/source/lux/test.lux
+++ b/stdlib/source/lux/test.lux
@@ -3,15 +3,15 @@
(lux [meta #+ Monad<Meta> with-gensyms]
(meta ["s" syntax #+ syntax: Syntax]
[code])
- (control ["M" monad #+ do Monad]
+ (control [monad #+ do Monad]
["p" parser])
(concurrency [promise #+ Promise Monad<Promise>])
- (data (coll [list "L/" Monad<List> Fold<List>])
+ (data (coll [list "list/" Monad<List> Fold<List>])
[product]
[maybe]
[text]
text/format
- ["E" error])
+ ["e" error])
[io #- run]
(time [instant]
[duration])
@@ -27,13 +27,20 @@
)
## [Types]
-(type: Counters [Nat Nat])
+(type: #export Counters [Nat Nat])
+
+(type: #export Seed
+ {#;doc "The seed value used for random testing (if that feature is used)."}
+ Nat)
(type: #export Test
- {#;doc "Tests are asynchronous process which may fail."}
- (Promise [Counters Text]))
+ (r;Random (Promise [Counters Text])))
+
+(def: pcg-32-magic-inc Nat +12345)
## [Values]
+(def: #hidden Monad<Random> (Monad r;Random) r;Monad<Random>)
+
(def: success Counters [+1 +0])
(def: failure Counters [+0 +1])
(def: start Counters [+0 +0])
@@ -44,131 +51,94 @@
(def: (fail message)
(All [a] (-> Text Test))
- (:: Monad<Promise> wrap [failure (format " [Error] " (%t message))]))
+ (|> [failure (format " [Error] " message)]
+ (:: Monad<Promise> wrap)
+ (:: r;Monad<Random> wrap)))
-(def: #export (test message condition)
+(def: #export (assert message condition)
{#;doc "Check that a condition is true, and fail with the given message otherwise."}
- (-> Text Bool Test)
+ (-> Text Bool (Promise [Counters Text]))
(if condition
(:: Monad<Promise> wrap [success (format "[Success] " message)])
(:: Monad<Promise> wrap [failure (format " [Error] " message)])))
+(def: #export (test message condition)
+ {#;doc "Check that a condition is true, and fail with the given message otherwise."}
+ (-> Text Bool Test)
+ (:: r;Monad<Random> wrap (assert message condition)))
+
(def: #hidden (run' tests)
(-> (List [Text (IO Test) Text]) (Promise Counters))
(do Monad<Promise>
[test-runs (|> tests
- (L/map (: (-> [Text (IO Test) Text] (Promise Counters))
- (function [[module test description]]
- (do @
- [#let [pre (io;run instant;now)]
- [counters documentation] (io;run test)
- #let [post (io;run instant;now)
- _ (log! (format "@ " module " "
- "(" (%i (duration;to-millis (instant;span pre post))) "ms" ")"
- "\n"
- description "\n"
- "\n" documentation "\n"))]]
- (wrap counters)))))
- (M;seq @))]
- (wrap (L/fold add-counters start test-runs))))
-
-(def: pcg-32-magic-inc Nat +12345)
-
-(type: #export Seed
- {#;doc "The seed value used for random testing (if that feature is used)."}
- Nat)
+ (list/map (: (-> [Text (IO Test) Text] (Promise Counters))
+ (function [[module test description]]
+ (do @
+ [#let [pre (io;run instant;now)
+ seed (int-to-nat (instant;to-millis pre))]
+ [counters documentation] (|> (io;run test)
+ (r;run (r;pcg-32 [pcg-32-magic-inc seed]))
+ product;right)
+ #let [post (io;run instant;now)
+ _ (log! (format "@ " module " "
+ "(" (%i (duration;to-millis (instant;span pre post))) "ms" ")"
+ "\n"
+ description "\n"
+ "\n" documentation "\n"))]]
+ (wrap counters)))))
+ (monad;seq @))]
+ (wrap (list/fold add-counters start test-runs))))
(def: failed?
(-> Counters Bool)
(|>. product;right (n.> +0)))
-(def: (try seed random-test)
- (-> Seed (r;Random Test) (Promise [Seed [Counters Text]]))
- (let [[prng [new-seed test]] (r;run (r;pcg-32 [pcg-32-magic-inc seed])
- (do r;Monad<Random>
- [test random-test
- next-seed r;nat]
- (wrap [next-seed test])))]
- (do Monad<Promise>
- [result test]
- (wrap [new-seed result]))))
-
-(def: (repeat' seed times random-test)
- (-> Seed Nat (r;Random Test) Test)
- (if (n.= +0 times)
- (fail "Cannot try a test 0 times.")
- (do Monad<Promise>
- [[seed' [counters documentation]] (try seed random-test)]
- (cond (failed? counters)
- (wrap [counters
- (format "Context failed with this seed: " (%n seed) "\n" documentation)])
-
- (n.= +1 times)
- (wrap [counters documentation])
-
- ## else
- (repeat' seed' (n.dec times) random-test)))))
-
-(def: #hidden (repeat ?seed times random-test)
- (-> (Maybe Nat) Nat (r;Random Test) Test)
- (repeat' (maybe;default (|> (io;run instant;now) instant;to-millis int-to-nat)
- ?seed)
- (case ?seed
- #;None times
- (#;Some _) +1)
- random-test))
+(def: #export (seed value test)
+ (-> Seed Test Test)
+ (function [prng]
+ (let [[_ result] (r;run (r;pcg-32 [pcg-32-magic-inc value])
+ test)]
+ [prng result])))
+
+(def: #export (times amount test)
+ (-> Nat Test Test)
+ (cond (n.= +0 amount)
+ (fail "Cannot try a test 0 times.")
+
+ (n.= +1 amount)
+ test
+
+ ## else
+ (function [prng]
+ (let [[prng' instance] (r;run prng test)]
+ [prng' (do Monad<Promise>
+ [[counters documentation] instance]
+ (if (failed? counters)
+ (wrap [counters documentation])
+ (product;right (r;run prng' (times (n.dec amount) test)))))]))))
## [Syntax]
-(type: Test-Config
- (#Seed Nat)
- (#Times Nat))
-
-(type: Property-Test
- {#seed (Maybe Test-Config)
- #bindings (List [Code Code])
- #body Code})
-
-(type: Test-Kind
- (#Property Property-Test)
- (#Simple Code))
-
-(def: config^
- (Syntax Test-Config)
- (p;alt (do p;Monad<Parser>
- [_ (s;this (' #seed))]
- s;nat)
- (do p;Monad<Parser>
- [_ (s;this (' #times))]
- s;nat)))
-
-(def: property-test^
- (Syntax Property-Test)
- ($_ p;seq
- (p;maybe config^)
- (s;tuple (p;some (p;seq s;any s;any)))
- s;any))
-
-(def: test^
- (Syntax Test-Kind)
- (p;alt property-test^
- s;any))
-
-(def: (pair-to-list [x y])
- (All [a] (-> [a a] (List a)))
- (list x y))
-
-(def: #hidden (try-body lazy-body)
- (-> (IO Test) Test)
- (case (_lux_proc ["lux" "try"] [lazy-body])
- (#E;Success output)
- output
-
- (#E;Error error)
- (test error false)))
+(def: #hidden (try-test test)
+ (-> (IO Test) (IO Test))
+ (do Monad<IO>
+ [now instant;now
+ #let [seed (|> now instant;to-millis int-to-nat)]]
+ (io (do r;Monad<Random>
+ [instance (case (_lux_proc ["lux" "try"] [test])
+ (#e;Success test)
+ test
+
+ (#e;Error error)
+ (fail error))]
+ (wrap (do Monad<Promise>
+ [[counter documentation] instance]
+ (if (failed? counter)
+ (wrap [counter (format "Context failed with this seed: " (%n seed) "\n" documentation)])
+ (wrap [counter documentation]))))))))
(def: #hidden _code/text_ code;text)
-(syntax: #export (context: description [body test^])
+(syntax: #export (context: description test)
{#;doc (doc "Macro for definint tests."
(context: "Simple macros and constructs"
($_ seq
@@ -202,70 +172,56 @@
(is "lol" (maybe;default "yolo"
(#;Some "lol")))))
))
+
"Also works with random generation of values for property-based testing."
(context: "Addition & Substraction"
- [x (:: @ map <prep> rand-gen)
- y (:: @ map <prep> rand-gen)]
- (test ""
- (and (|> x (- y) (+ y) (= x))
- (|> x (+ y) (- y) (= x)))))
+ (do @
+ [x (:: @ map <prep> rand-gen)
+ y (:: @ map <prep> rand-gen)]
+ (test ""
+ (and (|> x (- y) (+ y) (= x))
+ (|> x (+ y) (- y) (= x))))))
+
"By default, random tests will be tried 100 times, you can specify the amount you want:"
(context: "Addition & Substraction"
- #times +1234
- [x (:: @ map <prep> rand-gen)
- y (:: @ map <prep> rand-gen)]
- (test ""
- (and (|> x (- y) (+ y) (= x))
- (|> x (+ y) (- y) (= x)))))
+ (<| (times +1234)
+ (do @
+ [x (:: @ map <prep> rand-gen)
+ y (:: @ map <prep> rand-gen)]
+ (test ""
+ (and (|> x (- y) (+ y) (= x))
+ (|> x (+ y) (- y) (= x)))))))
+
"If a test fails, you'll be shown a seed that you can then use to reproduce a failing scenario."
(context: "Addition & Substraction"
- #seed +987654321
- [x (:: @ map <prep> rand-gen)
- y (:: @ map <prep> rand-gen)]
- (test ""
- (and (|> x (- y) (+ y) (= x))
- (|> x (+ y) (- y) (= x)))))
+ (<| (seed +987654321)
+ (do @
+ [x (:: @ map <prep> rand-gen)
+ y (:: @ map <prep> rand-gen)]
+ (test ""
+ (and (|> x (- y) (+ y) (= x))
+ (|> x (+ y) (- y) (= x)))))))
)}
- (let [body (case body
- (#Property config bindings body)
- (let [[=seed =times] (case config
- #;None
- [(` #;None) +100]
-
- (#;Some (#Seed value))
- [(` (#;Some (~ (code;nat value)))) +100]
-
- (#;Some (#Times value))
- [(` #;None) value])
- bindings' (|> bindings (L/map pair-to-list) L/join)]
- (` (repeat (~ =seed)
- (~ (code;nat =times))
- (do r;Monad<Random>
- [(~@ bindings')]
- ((~' wrap) (;;try-body (io;io (~ body))))))))
-
- (#Simple body)
- body)]
- (with-gensyms [g!test]
- (wrap (list (` (def: #export (~ g!test)
- {#;;test (;;_code/text_ (~ description))}
- (IO Test)
- (io (~ body)))))))))
+ (with-gensyms [g!test]
+ (wrap (list (` (def: #export (~ g!test)
+ {#;;test (;;_code/text_ (~ description))}
+ (IO Test)
+ (;;try-test (io (do ;;Monad<Random> [] (~ test))))))))))
(def: (exported-tests module-name)
(-> Text (Meta (List [Text Text Text])))
(do Monad<Meta>
[defs (meta;exports module-name)]
(wrap (|> defs
- (L/map (function [[def-name [_ def-anns _]]]
- (case (meta;get-text-ann (ident-for #;;test) def-anns)
- (#;Some description)
- [true module-name def-name description]
+ (list/map (function [[def-name [_ def-anns _]]]
+ (case (meta;get-text-ann (ident-for #;;test) def-anns)
+ (#;Some description)
+ [true module-name def-name description]
- _
- [false module-name def-name ""])))
+ _
+ [false module-name def-name ""])))
(list;filter product;left)
- (L/map product;right)))))
+ (list/map product;right)))))
(def: #hidden _composeT_ (-> Text Text Text) (:: text;Monoid<Text> compose))
(def: #hidden _%i_ (-> Int Text) %i)
@@ -280,22 +236,22 @@
tests (: (Meta (List [Text Text Text]))
(|> (#;Cons current-module modules)
list;reverse
- (M;map @ exported-tests)
- (:: @ map L/join)))
- #let [tests+ (L/map (function [[module-name test desc]]
- (` [(~ (code;text module-name)) (~ (code;symbol [module-name test])) (~ (code;text desc))]))
- tests)
+ (monad;map @ exported-tests)
+ (:: @ map list/join)))
+ #let [tests+ (list/map (function [[module-name test desc]]
+ (` [(~ (code;text module-name)) (~ (code;symbol [module-name test])) (~ (code;text desc))]))
+ tests)
num-tests (list;size tests+)
groups (list;split-all promise;concurrency-level tests+)]]
(wrap (list (` (: (IO Unit)
(io (exec (do Monad<Promise>
[(~' #let) [(~ g!total-successes) +0
(~ g!total-failures) +0]
- (~@ (L/join (L/map (function [group]
- (list (` [(~ g!successes) (~ g!failures)]) (` (run' (list (~@ group))))
- (' #let) (` [(~ g!total-successes) (n.+ (~ g!successes) (~ g!total-successes))
- (~ g!total-failures) (n.+ (~ g!failures) (~ g!total-failures))])))
- groups)))]
+ (~@ (list/join (list/map (function [group]
+ (list (` [(~ g!successes) (~ g!failures)]) (` (run' (list (~@ group))))
+ (' #let) (` [(~ g!total-successes) (n.+ (~ g!successes) (~ g!total-successes))
+ (~ g!total-failures) (n.+ (~ g!failures) (~ g!total-failures))])))
+ groups)))]
(exec (log! ($_ _composeT_
"Test-suite finished."
"\n"
@@ -314,8 +270,11 @@
(def: #export (seq left right)
{#;doc "Sequencing combinator."}
(-> Test Test Test)
- (do Monad<Promise>
- [[l-counter l-documentation] left
- [r-counter r-documentation] right]
- (wrap [(add-counters l-counter r-counter)
- (format l-documentation "\n" r-documentation)])))
+ (do r;Monad<Random>
+ [left left
+ right right]
+ (wrap (do Monad<Promise>
+ [[l-counter l-documentation] left
+ [r-counter r-documentation] right]
+ (wrap [(add-counters l-counter r-counter)
+ (format l-documentation "\n" r-documentation)])))))
diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux
index f44430c6c..9c348720b 100644
--- a/stdlib/test/test/lux.lux
+++ b/stdlib/test/test/lux.lux
@@ -12,37 +12,45 @@
(meta ["s" syntax #+ syntax:])))
(context: "Value identity."
- [size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10))))
- x (r;text size)
- y (r;text size)]
- ($_ seq
- (test "Every value is identical to itself, and the 'id' function doesn't change values in any way."
- (and (is x x)
- (is x (id x))))
-
- (test "Values created separately can't be identical."
- (not (is x y)))
- ))
+ (<| (times +100)
+ (do @
+ [size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10))))
+ x (r;text size)
+ y (r;text size)]
+ ($_ seq
+ (test "Every value is identical to itself, and the 'id' function doesn't change values in any way."
+ (and (is x x)
+ (is x (id x))))
+
+ (test "Values created separately can't be identical."
+ (not (is x y)))
+ ))))
(do-template [category rand-gen inc dec even? odd? = < >]
[(context: (format "[" category "] " "Moving up-down or down-up should result in same value.")
- [value rand-gen]
- (test "" (and (|> value inc dec (= value))
- (|> value dec inc (= value)))))
+ (<| (times +100)
+ (do @
+ [value rand-gen]
+ (test "" (and (|> value inc dec (= value))
+ (|> value dec inc (= value)))))))
(context: (format "[" category "] " "(x+1) > x && (x-1) < x")
- [value rand-gen]
- (test "" (and (|> value inc (> value))
- (|> value dec (< value)))))
+ (<| (times +100)
+ (do @
+ [value rand-gen]
+ (test "" (and (|> value inc (> value))
+ (|> value dec (< value)))))))
(context: (format "[" category "] " "Every odd/even number is surrounded by two of the other kind.")
- [value rand-gen]
- (test ""
- (if (even? value)
- (and (|> value inc odd?)
- (|> value dec odd?))
- (and (|> value inc even?)
- (|> value dec even?)))))]
+ (<| (times +100)
+ (do @
+ [value rand-gen]
+ (test ""
+ (if (even? value)
+ (and (|> value inc odd?)
+ (|> value dec odd?))
+ (and (|> value inc even?)
+ (|> value dec even?)))))))]
["Nat" r;nat n.inc n.dec n.even? n.odd? n.= n.< n.>]
["Int" r;int i.inc i.dec i.even? i.odd? i.= i.< i.>]
@@ -50,23 +58,27 @@
(do-template [category rand-gen = < > <= >= min max]
[(context: (format "[" category "] " "The symmetry of numerical comparisons.")
- [x rand-gen
- y rand-gen]
- (test ""
- (or (= x y)
- (if (< y x)
- (> x y)
- (< x y)))))
+ (<| (times +100)
+ (do @
+ [x rand-gen
+ y rand-gen]
+ (test ""
+ (or (= x y)
+ (if (< y x)
+ (> x y)
+ (< x y)))))))
(context: (format "[" category "] " "Minimums and maximums.")
- [x rand-gen
- y rand-gen]
- (test ""
- (and (and (<= x (min x y))
- (<= y (min x y)))
- (and (>= x (max x y))
- (>= y (max x y)))
- )))]
+ (<| (times +100)
+ (do @
+ [x rand-gen
+ y rand-gen]
+ (test ""
+ (and (and (<= x (min x y))
+ (<= y (min x y)))
+ (and (>= x (max x y))
+ (>= y (max x y)))
+ )))))]
["Int" r;int i.= i.< i.> i.<= i.>= i.min i.max]
["Nat" r;nat n.= n.< n.> n.<= n.>= n.min n.max]
@@ -76,45 +88,53 @@
(do-template [category rand-gen = + - * / <%> > <0> <1> <factor> %x <cap> <prep>]
[(context: (format "[" category "] " "Additive identity")
- [x rand-gen]
- (test ""
- (and (|> x (+ <0>) (= x))
- (|> x (- <0>) (= x)))))
+ (<| (times +100)
+ (do @
+ [x rand-gen]
+ (test ""
+ (and (|> x (+ <0>) (= x))
+ (|> x (- <0>) (= x)))))))
(context: (format "[" category "] " "Addition & Substraction")
- [x (:: @ map <prep> rand-gen)
- y (:: @ map <prep> rand-gen)
- #let [x (* <factor> x)
- y (* <factor> y)]]
- (test ""
- (and (|> x (- y) (+ y) (= x))
- (|> x (+ y) (- y) (= x)))))
+ (<| (times +100)
+ (do @
+ [x (:: @ map <prep> rand-gen)
+ y (:: @ map <prep> rand-gen)
+ #let [x (* <factor> x)
+ y (* <factor> y)]]
+ (test ""
+ (and (|> x (- y) (+ y) (= x))
+ (|> x (+ y) (- y) (= x)))))))
(context: (format "[" category "] " "Multiplicative identity")
- [x rand-gen]
- (test ""
- ## Skip this test for Deg
- ## because Deg division loses the last
- ## 32 bits of precision.
- (or (text/= "Deg" category)
- (and (|> x (* <1>) (= x))
- (|> x (/ <1>) (= x))))))
+ (<| (times +100)
+ (do @
+ [x rand-gen]
+ (test ""
+ ## Skip this test for Deg
+ ## because Deg division loses the last
+ ## 32 bits of precision.
+ (or (text/= "Deg" category)
+ (and (|> x (* <1>) (= x))
+ (|> x (/ <1>) (= x))))))))
(context: (format "[" category "] " "Multiplication & Division")
- [x (:: @ map <cap> rand-gen)
- y (|> rand-gen
- (:: @ map <cap>)
- (r;filter (|>. (= <0>) not)))
- #let [r (<%> y x)
- x' (- r x)]]
- (test ""
- ## Skip this test for Deg
- ## because Deg division loses the last
- ## 32 bits of precision.
- (or (text/= "Deg" category)
- (or (> x' y)
- (|> x' (/ y) (* y) (= x'))))
- ))]
+ (<| (times +100)
+ (do @
+ [x (:: @ map <cap> rand-gen)
+ y (|> rand-gen
+ (:: @ map <cap>)
+ (r;filter (|>. (= <0>) not)))
+ #let [r (<%> y x)
+ x' (- r x)]]
+ (test ""
+ ## Skip this test for Deg
+ ## because Deg division loses the last
+ ## 32 bits of precision.
+ (or (text/= "Deg" category)
+ (or (> x' y)
+ (|> x' (/ y) (* y) (= x'))))
+ ))))]
["Nat" r;nat n.= n.+ n.- n.* n./ n.% n.> +0 +1 +1000000 %n (n.% +1000) id]
["Int" r;int i.= i.+ i.- i.* i./ i.% i.> 0 1 1000000 %i (i.% 1000) id]
@@ -124,10 +144,12 @@
(do-template [category rand-gen -> <- = <cap> %a %z]
[(context: (format "[" category "] " "Numeric conversions")
- [value rand-gen
- #let [value (<cap> value)]]
- (test ""
- (|> value -> <- (= value))))]
+ (<| (times +100)
+ (do @
+ [value rand-gen
+ #let [value (<cap> value)]]
+ (test ""
+ (|> value -> <- (= value))))))]
["Int->Nat" r;int int-to-nat nat-to-int i.= (i.% 1000000) %i %n]
["Nat->Int" r;nat nat-to-int int-to-nat n.= (n.% +1000000) %n %i]
@@ -173,11 +195,13 @@
(i.+ (i.* x x) (i.* y y)))
(context: "Templates."
- [x r;int
- y r;int]
- (test "Template application is a stand-in for the templated code."
- (i.= (i.+ (i.* x x) (i.* y y))
- (hypotenuse x y))))
+ (<| (times +100)
+ (do @
+ [x r;int
+ y r;int]
+ (test "Template application is a stand-in for the templated code."
+ (i.= (i.+ (i.* x x) (i.* y y))
+ (hypotenuse x y))))))
(context: "Cross-platform support."
($_ seq
diff --git a/stdlib/test/test/lux/cli.lux b/stdlib/test/test/lux/cli.lux
index 410751b13..d6161a2b8 100644
--- a/stdlib/test/test/lux/cli.lux
+++ b/stdlib/test/test/lux/cli.lux
@@ -16,43 +16,45 @@
lux/test)
(context: "CLI"
- [num-args (|> r;nat (:: @ map (n.% +10)))
- #let [(^open "Nat/") number;Codec<Text,Nat>
- gen-arg (:: @ map Nat/encode r;nat)]
- yes gen-arg
- #let [gen-ignore (|> (r;text +5) (r;filter (|>. (text/= yes) not)))]
- no gen-ignore
- pre-ignore (r;list +5 gen-ignore)
- post-ignore (r;list +5 gen-ignore)]
- ($_ seq
- (test "Can read any argument."
- (|> (.;run (list yes) .;any)
- (case> (#E;Error _)
- false
-
- (#E;Success arg)
- (text/= arg yes))))
- (test "Can test tokens."
- (and (|> (.;run (list yes) (.;this yes))
- (case> (#E;Error _) false (#E;Success _) true))
- (|> (.;run (list no) (.;this yes))
- (case> (#E;Error _) true (#E;Success _) false))))
- (test "Can use custom token parsers."
- (|> (.;run (list yes) (.;parse Nat/decode))
- (case> (#E;Error _)
- false
-
- (#E;Success parsed)
- (text/= (Nat/encode parsed)
- yes))))
- (test "Can query if there are any more inputs."
- (and (|> (.;run (list) .;end)
- (case> (#E;Success []) true _ false))
- (|> (.;run (list yes) (p;not .;end))
- (case> (#E;Success []) false _ true))))
- (test "Can parse CLI input anywhere."
- (|> (.;run (list;concat (list pre-ignore (list yes) post-ignore))
- (|> (.;somewhere (.;this yes))
- (p;before (p;some .;any))))
- (case> (#E;Error _) false (#E;Success _) true)))
- ))
+ (<| (times +100)
+ (do @
+ [num-args (|> r;nat (:: @ map (n.% +10)))
+ #let [(^open "Nat/") number;Codec<Text,Nat>
+ gen-arg (:: @ map Nat/encode r;nat)]
+ yes gen-arg
+ #let [gen-ignore (|> (r;text +5) (r;filter (|>. (text/= yes) not)))]
+ no gen-ignore
+ pre-ignore (r;list +5 gen-ignore)
+ post-ignore (r;list +5 gen-ignore)]
+ ($_ seq
+ (test "Can read any argument."
+ (|> (.;run (list yes) .;any)
+ (case> (#E;Error _)
+ false
+
+ (#E;Success arg)
+ (text/= arg yes))))
+ (test "Can test tokens."
+ (and (|> (.;run (list yes) (.;this yes))
+ (case> (#E;Error _) false (#E;Success _) true))
+ (|> (.;run (list no) (.;this yes))
+ (case> (#E;Error _) true (#E;Success _) false))))
+ (test "Can use custom token parsers."
+ (|> (.;run (list yes) (.;parse Nat/decode))
+ (case> (#E;Error _)
+ false
+
+ (#E;Success parsed)
+ (text/= (Nat/encode parsed)
+ yes))))
+ (test "Can query if there are any more inputs."
+ (and (|> (.;run (list) .;end)
+ (case> (#E;Success []) true _ false))
+ (|> (.;run (list yes) (p;not .;end))
+ (case> (#E;Success []) false _ true))))
+ (test "Can parse CLI input anywhere."
+ (|> (.;run (list;concat (list pre-ignore (list yes) post-ignore))
+ (|> (.;somewhere (.;this yes))
+ (p;before (p;some .;any))))
+ (case> (#E;Error _) false (#E;Success _) true)))
+ ))))
diff --git a/stdlib/test/test/lux/concurrency/actor.lux b/stdlib/test/test/lux/concurrency/actor.lux
index f5d230833..c6c127fde 100644
--- a/stdlib/test/test/lux/concurrency/actor.lux
+++ b/stdlib/test/test/lux/concurrency/actor.lux
@@ -68,20 +68,20 @@
(wrap (and first-time
(not second-time))))))
- (do P;Monad<Promise>
- [result (do T;Monad<Task>
- [#let [counter (io;run (new@Counter +0))]
- output-1 (count! +1 counter)
- output-2 (count! +1 counter)
- output-3 (count! +1 counter)]
- (wrap (and (n.= +1 output-1)
- (n.= +2 output-2)
- (n.= +3 output-3))))]
- (test "Can send messages to actors."
- (case result
- (#E;Success outcome)
- outcome
+ (wrap (do P;Monad<Promise>
+ [result (do T;Monad<Task>
+ [#let [counter (io;run (new@Counter +0))]
+ output-1 (count! +1 counter)
+ output-2 (count! +1 counter)
+ output-3 (count! +1 counter)]
+ (wrap (and (n.= +1 output-1)
+ (n.= +2 output-2)
+ (n.= +3 output-3))))]
+ (assert "Can send messages to actors."
+ (case result
+ (#E;Success outcome)
+ outcome
- (#E;Error error)
- false)))
+ (#E;Error error)
+ false))))
))
diff --git a/stdlib/test/test/lux/concurrency/atom.lux b/stdlib/test/test/lux/concurrency/atom.lux
index 538e7d676..90c1c07d2 100644
--- a/stdlib/test/test/lux/concurrency/atom.lux
+++ b/stdlib/test/test/lux/concurrency/atom.lux
@@ -10,23 +10,25 @@
lux/test)
(context: "Atoms"
- [value r;nat
- swap-value r;nat
- set-value r;nat
- #let [box (&;atom value)]]
- ($_ seq
- (test "Can obtain the value of an atom."
- (n.= value (io;run (&;get box))))
+ (<| (times +100)
+ (do @
+ [value r;nat
+ swap-value r;nat
+ set-value r;nat
+ #let [box (&;atom value)]]
+ ($_ seq
+ (test "Can obtain the value of an atom."
+ (n.= value (io;run (&;get box))))
- (test "Can swap the value of an atom."
- (and (io;run (&;compare-and-swap value swap-value box))
- (n.= swap-value (io;run (&;get box)))))
+ (test "Can swap the value of an atom."
+ (and (io;run (&;compare-and-swap value swap-value box))
+ (n.= swap-value (io;run (&;get box)))))
- (test "Can update the value of an atom."
- (exec (io;run (&;update n.inc box))
- (n.= (n.inc swap-value) (io;run (&;get box)))))
+ (test "Can update the value of an atom."
+ (exec (io;run (&;update n.inc box))
+ (n.= (n.inc swap-value) (io;run (&;get box)))))
- (test "Can immediately set the value of an atom."
- (exec (io;run (&;set set-value box))
- (n.= set-value (io;run (&;get box)))))
- ))
+ (test "Can immediately set the value of an atom."
+ (exec (io;run (&;set set-value box))
+ (n.= set-value (io;run (&;get box)))))
+ ))))
diff --git a/stdlib/test/test/lux/concurrency/frp.lux b/stdlib/test/test/lux/concurrency/frp.lux
index de462b2b6..21a650882 100644
--- a/stdlib/test/test/lux/concurrency/frp.lux
+++ b/stdlib/test/test/lux/concurrency/frp.lux
@@ -19,106 +19,106 @@
(context: "FRP"
($_ seq
- (do P;Monad<Promise>
- [elems (&;consume (to-channel (list 0 1 2 3 4 5)))]
- (test "Can consume a channel into a list."
- (case elems
- (^ (list 0 1 2 3 4 5))
- true
-
- _
- false)))
-
- (do P;Monad<Promise>
- [elems (&;consume (let [input (to-channel (list 0 1 2 3 4 5))
- output (&;channel Int)]
- (exec (&;pipe input output)
- output)))]
- (test "Can pipe one channel into another."
- (case elems
- (^ (list 0 1 2 3 4 5))
- true
-
- _
- false)))
-
- (do P;Monad<Promise>
- [elems (&;consume (&;filter i.even? (to-channel (list 0 1 2 3 4 5))))]
- (test "Can filter a channel's elements."
- (case elems
- (^ (list 0 2 4))
- true
-
- _
- false)))
-
- (do P;Monad<Promise>
- [elems (&;consume (&;merge (list (to-channel (list 0 1 2 3 4 5))
- (to-channel (list 0 -1 -2 -3 -4 -5)))))]
- (test "Can merge channels."
- (case elems
- (^ (list 0 1 2 3 4 5 0 -1 -2 -3 -4 -5))
- true
-
- _
- false)))
+ (wrap (do P;Monad<Promise>
+ [elems (&;consume (to-channel (list 0 1 2 3 4 5)))]
+ (assert "Can consume a channel into a list."
+ (case elems
+ (^ (list 0 1 2 3 4 5))
+ true
+
+ _
+ false))))
+
+ (wrap (do P;Monad<Promise>
+ [elems (&;consume (let [input (to-channel (list 0 1 2 3 4 5))
+ output (&;channel Int)]
+ (exec (&;pipe input output)
+ output)))]
+ (assert "Can pipe one channel into another."
+ (case elems
+ (^ (list 0 1 2 3 4 5))
+ true
+
+ _
+ false))))
+
+ (wrap (do P;Monad<Promise>
+ [elems (&;consume (&;filter i.even? (to-channel (list 0 1 2 3 4 5))))]
+ (assert "Can filter a channel's elements."
+ (case elems
+ (^ (list 0 2 4))
+ true
+
+ _
+ false))))
+
+ (wrap (do P;Monad<Promise>
+ [elems (&;consume (&;merge (list (to-channel (list 0 1 2 3 4 5))
+ (to-channel (list 0 -1 -2 -3 -4 -5)))))]
+ (assert "Can merge channels."
+ (case elems
+ (^ (list 0 1 2 3 4 5 0 -1 -2 -3 -4 -5))
+ true
+
+ _
+ false))))
- (do P;Monad<Promise>
- [output (&;fold (function [base input] (P/wrap (i.+ input base))) 0 (to-channel (list 0 1 2 3 4 5)))]
- (test "Can fold over a channel."
- (i.= 15 output)))
-
- (do P;Monad<Promise>
- [elems (&;consume (&;distinct number;Eq<Int> (to-channel (list 0 0 0 1 2 2 3 3 3 3 4 4 4 5 5))))]
- (test "Can avoid immediate repetition in the channel."
- (case elems
- (^ (list 0 1 2 3 4 5))
- true
-
- _
- false)))
-
- (do P;Monad<Promise>
- [elems (&;consume (&;once (:: @ wrap 12345)))]
- (test "Can convert a promise into a single-value channel."
- (case elems
- (^ (list 12345))
- true
-
- _
- false)))
-
- (do P;Monad<Promise>
- [elems (&;consume (:: &;Functor<Channel> map i.inc (to-channel (list 0 1 2 3 4 5))))]
- (test "Functor goes over every element in a channel."
- (case elems
- (^ (list 1 2 3 4 5 6))
- true
-
- _
- false)))
-
- (do P;Monad<Promise>
- [elems (&;consume (let [(^open) &;Applicative<Channel>]
- (apply (wrap i.inc) (wrap 12345))))]
- (test "Applicative works over all channel values."
- (case elems
- (^ (list 12346))
- true
-
- _
- false)))
-
- (do P;Monad<Promise>
- [elems (&;consume (do &;Monad<Channel>
- [f (wrap i.inc)
- a (wrap 12345)]
- (wrap (f a))))]
- (test "Monad works over all channel values."
- (case elems
- (^ (list 12346))
- true
-
- _
- false)))
+ (wrap (do P;Monad<Promise>
+ [output (&;fold (function [base input] (P/wrap (i.+ input base))) 0 (to-channel (list 0 1 2 3 4 5)))]
+ (assert "Can fold over a channel."
+ (i.= 15 output))))
+
+ (wrap (do P;Monad<Promise>
+ [elems (&;consume (&;distinct number;Eq<Int> (to-channel (list 0 0 0 1 2 2 3 3 3 3 4 4 4 5 5))))]
+ (assert "Can avoid immediate repetition in the channel."
+ (case elems
+ (^ (list 0 1 2 3 4 5))
+ true
+
+ _
+ false))))
+
+ (wrap (do P;Monad<Promise>
+ [elems (&;consume (&;once (:: @ wrap 12345)))]
+ (assert "Can convert a promise into a single-value channel."
+ (case elems
+ (^ (list 12345))
+ true
+
+ _
+ false))))
+
+ (wrap (do P;Monad<Promise>
+ [elems (&;consume (:: &;Functor<Channel> map i.inc (to-channel (list 0 1 2 3 4 5))))]
+ (assert "Functor goes over every element in a channel."
+ (case elems
+ (^ (list 1 2 3 4 5 6))
+ true
+
+ _
+ false))))
+
+ (wrap (do P;Monad<Promise>
+ [elems (&;consume (let [(^open) &;Applicative<Channel>]
+ (apply (wrap i.inc) (wrap 12345))))]
+ (assert "Applicative works over all channel values."
+ (case elems
+ (^ (list 12346))
+ true
+
+ _
+ false))))
+
+ (wrap (do P;Monad<Promise>
+ [elems (&;consume (do &;Monad<Channel>
+ [f (wrap i.inc)
+ a (wrap 12345)]
+ (wrap (f a))))]
+ (assert "Monad works over all channel values."
+ (case elems
+ (^ (list 12346))
+ true
+
+ _
+ false))))
))
diff --git a/stdlib/test/test/lux/concurrency/promise.lux b/stdlib/test/test/lux/concurrency/promise.lux
index 7b8f3fdd3..6ebc5ee5a 100644
--- a/stdlib/test/test/lux/concurrency/promise.lux
+++ b/stdlib/test/test/lux/concurrency/promise.lux
@@ -11,42 +11,42 @@
(context: "Promises"
($_ seq
- (do &;Monad<Promise>
- [running? (&;future (io true))]
- (test "Can run IO actions in separate threads."
- running?))
+ (wrap (do &;Monad<Promise>
+ [running? (&;future (io true))]
+ (assert "Can run IO actions in separate threads."
+ running?)))
- (do &;Monad<Promise>
- [_ (&;wait +500)]
- (test "Can wait for a specified amount of time."
- true))
+ (wrap (do &;Monad<Promise>
+ [_ (&;wait +500)]
+ (assert "Can wait for a specified amount of time."
+ true)))
- (do &;Monad<Promise>
- [[left right] (&;seq (&;future (io true))
- (&;future (io false)))]
- (test "Can combine promises sequentially."
- (and left (not right))))
+ (wrap (do &;Monad<Promise>
+ [[left right] (&;seq (&;future (io true))
+ (&;future (io false)))]
+ (assert "Can combine promises sequentially."
+ (and left (not right)))))
- (do &;Monad<Promise>
- [?left (&;alt (&;delay +100 true)
- (&;delay +200 false))
- ?right (&;alt (&;delay +200 true)
- (&;delay +100 false))]
- (test "Can combine promises alternatively."
- (case [?left ?right]
- [(#;Left true) (#;Right false)]
- true
+ (wrap (do &;Monad<Promise>
+ [?left (&;alt (&;delay +100 true)
+ (&;delay +200 false))
+ ?right (&;alt (&;delay +200 true)
+ (&;delay +100 false))]
+ (assert "Can combine promises alternatively."
+ (case [?left ?right]
+ [(#;Left true) (#;Right false)]
+ true
- _
- false)))
+ _
+ false))))
- (do &;Monad<Promise>
- [?left (&;either (&;delay +100 true)
- (&;delay +200 false))
- ?right (&;either (&;delay +200 true)
- (&;delay +100 false))]
- (test "Can combine promises alternatively [Part 2]."
- (and ?left (not ?right))))
+ (wrap (do &;Monad<Promise>
+ [?left (&;either (&;delay +100 true)
+ (&;delay +200 false))
+ ?right (&;either (&;delay +200 true)
+ (&;delay +100 false))]
+ (assert "Can combine promises alternatively [Part 2]."
+ (and ?left (not ?right)))))
(test "Can poll a promise for its value."
(and (|> (&;poll (&/wrap true))
@@ -58,14 +58,14 @@
(and (not (io;run (&;resolve false (&/wrap true))))
(io;run (&;resolve true (&;promise Bool)))))
- (do &;Monad<Promise>
- [?none (&;time-out +100 (&;delay +200 true))
- ?some (&;time-out +200 (&;delay +100 true))]
- (test "Can establish maximum waiting times for promises to be fulfilled."
- (case [?none ?some]
- [#;None (#;Some true)]
- true
+ (wrap (do &;Monad<Promise>
+ [?none (&;time-out +100 (&;delay +200 true))
+ ?some (&;time-out +200 (&;delay +100 true))]
+ (assert "Can establish maximum waiting times for promises to be fulfilled."
+ (case [?none ?some]
+ [#;None (#;Some true)]
+ true
- _
- false)))
+ _
+ false))))
))
diff --git a/stdlib/test/test/lux/concurrency/stm.lux b/stdlib/test/test/lux/concurrency/stm.lux
index 52361b85a..96c486e67 100644
--- a/stdlib/test/test/lux/concurrency/stm.lux
+++ b/stdlib/test/test/lux/concurrency/stm.lux
@@ -14,43 +14,38 @@
(def: iterations/processes Int 100)
(context: "STM"
- (do promise;Monad<Promise>
- [#let [_var (&;var 0)
- changes (io;run (&;follow _var))]
- output1 (&;commit (&;read _var))
- output2 (&;commit (do &;Monad<STM>
- [_ (&;write 5 _var)]
- (&;read _var)))
- output3 (&;commit (do &;Monad<STM>
- [temp (&;read _var)
- _ (&;update (i.* 3) _var)]
- (&;read _var)))
- ?c1+changes' changes
- #let [[c1 changes'] (maybe;default [-1 changes] ?c1+changes')]
- ?c2+changes' changes'
- #let [[c2 changes'] (maybe;default [-1 changes] ?c2+changes')]]
- ($_ seq
- (test "Can read STM vars."
- (i.= 0 output1))
-
- (test "Can write STM vars."
- (i.= 5 output2))
-
- (test "Can update STM vars."
- (i.= 15 output3))
-
- (test "Can follow all the changes to STM vars."
- (and (i.= 5 c1) (i.= 15 c2)))
-
- (let [_concurrency-var (&;var 0)]
- (do promise;Monad<Promise>
- [_ (M;seq @
- (map (function [_]
- (M;map @ (function [_] (&;commit (&;update i.inc _concurrency-var)))
- (list;i.range 1 iterations/processes)))
- (list;i.range 1 (nat-to-int promise;concurrency-level))))
- last-val (&;commit (&;read _concurrency-var))]
- (test "Can modify STM vars concurrently from multiple threads."
- (i.= (i.* iterations/processes (nat-to-int promise;concurrency-level))
- last-val))))
- )))
+ ($_ seq
+ (wrap (do promise;Monad<Promise>
+ [#let [_var (&;var 0)
+ changes (io;run (&;follow _var))]
+ output1 (&;commit (&;read _var))
+ output2 (&;commit (do &;Monad<STM>
+ [_ (&;write 5 _var)]
+ (&;read _var)))
+ output3 (&;commit (do &;Monad<STM>
+ [temp (&;read _var)
+ _ (&;update (i.* 3) _var)]
+ (&;read _var)))
+ ?c1+changes' changes
+ #let [[c1 changes'] (maybe;default [-1 changes] ?c1+changes')]
+ ?c2+changes' changes'
+ #let [[c2 changes'] (maybe;default [-1 changes] ?c2+changes')]]
+ (assert "Can read STM vars.
+ Can write STM vars.
+ Can update STM vars.
+ Can follow all the changes to STM vars."
+ (and (i.= 0 output1)
+ (i.= 5 output2)
+ (i.= 15 output3)
+ (and (i.= 5 c1) (i.= 15 c2))))))
+ (wrap (let [_concurrency-var (&;var 0)]
+ (do promise;Monad<Promise>
+ [_ (M;seq @
+ (map (function [_]
+ (M;map @ (function [_] (&;commit (&;update i.inc _concurrency-var)))
+ (list;i.range 1 iterations/processes)))
+ (list;i.range 1 (nat-to-int promise;concurrency-level))))
+ last-val (&;commit (&;read _concurrency-var))]
+ (assert "Can modify STM vars concurrently from multiple threads."
+ (i.= (i.* iterations/processes (nat-to-int promise;concurrency-level))
+ last-val)))))))
diff --git a/stdlib/test/test/lux/control/cont.lux b/stdlib/test/test/lux/control/cont.lux
index ea86ccb05..23b3a9bf3 100644
--- a/stdlib/test/test/lux/control/cont.lux
+++ b/stdlib/test/test/lux/control/cont.lux
@@ -12,64 +12,66 @@
lux/test)
(context: "Continuations"
- [sample r;nat
- #let [(^open "&/") &;Monad<Cont>]
- elems (r;list +3 r;nat)]
- ($_ seq
- (test "Can run continuations to compute their values."
- (n.= sample (&;run (&/wrap sample))))
+ (<| (times +100)
+ (do @
+ [sample r;nat
+ #let [(^open "&/") &;Monad<Cont>]
+ elems (r;list +3 r;nat)]
+ ($_ seq
+ (test "Can run continuations to compute their values."
+ (n.= sample (&;run (&/wrap sample))))
- (test "Can use functor."
- (n.= (n.inc sample) (&;run (&/map n.inc (&/wrap sample)))))
+ (test "Can use functor."
+ (n.= (n.inc sample) (&;run (&/map n.inc (&/wrap sample)))))
- (test "Can use applicative."
- (n.= (n.inc sample) (&;run (&/apply (&/wrap n.inc) (&/wrap sample)))))
+ (test "Can use applicative."
+ (n.= (n.inc sample) (&;run (&/apply (&/wrap n.inc) (&/wrap sample)))))
- (test "Can use monad."
- (n.= (n.inc sample) (&;run (do &;Monad<Cont>
- [func (wrap n.inc)
- arg (wrap sample)]
- (wrap (func arg))))))
+ (test "Can use monad."
+ (n.= (n.inc sample) (&;run (do &;Monad<Cont>
+ [func (wrap n.inc)
+ arg (wrap sample)]
+ (wrap (func arg))))))
- (test "Can use the current-continuation as a escape hatch."
- (n.= (n.* +2 sample)
- (&;run (do &;Monad<Cont>
- [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 as a escape hatch."
+ (n.= (n.* +2 sample)
+ (&;run (do &;Monad<Cont>
+ [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<Cont>
- [[restart [output idx]] (&;portal [sample +0])]
- (if (n.< +10 idx)
- (restart [(n.+ +10 output) (n.inc idx)])
- (wrap output))))))
+ (test "Can use the current-continuation to build a time machine."
+ (n.= (n.+ +100 sample)
+ (&;run (do &;Monad<Cont>
+ [[restart [output idx]] (&;portal [sample +0])]
+ (if (n.< +10 idx)
+ (restart [(n.+ +10 output) (n.inc idx)])
+ (wrap output))))))
- (test "Can use delimited continuations with shifting."
- (let [(^open "&/") &;Monad<Cont>
- (^open "L/") (list;Eq<List> number;Eq<Nat>)
- visit (: (-> (List Nat)
- (&;Cont (List Nat) (List Nat)))
- (function visit [xs]
- (case xs
- #;Nil
- (&/wrap #;Nil)
+ (test "Can use delimited continuations with shifting."
+ (let [(^open "&/") &;Monad<Cont>
+ (^open "L/") (list;Eq<List> number;Eq<Nat>)
+ visit (: (-> (List Nat)
+ (&;Cont (List Nat) (List Nat)))
+ (function visit [xs]
+ (case xs
+ #;Nil
+ (&/wrap #;Nil)
- (#;Cons x xs')
- (do &;Monad<Cont>
- [output (&;shift (function [k]
- (do @
- [tail (k xs')]
- (wrap (#;Cons x tail)))))]
- (visit output)))))]
- (L/= elems
- (&;run (&;reset (visit elems))))
- ))
- ))
+ (#;Cons x xs')
+ (do &;Monad<Cont>
+ [output (&;shift (function [k]
+ (do @
+ [tail (k xs')]
+ (wrap (#;Cons x tail)))))]
+ (visit output)))))]
+ (L/= elems
+ (&;run (&;reset (visit elems))))
+ ))
+ ))))
diff --git a/stdlib/test/test/lux/control/exception.lux b/stdlib/test/test/lux/control/exception.lux
index fc552b69c..144a08b1f 100644
--- a/stdlib/test/test/lux/control/exception.lux
+++ b/stdlib/test/test/lux/control/exception.lux
@@ -17,31 +17,33 @@
(exception: Unknown-Exception)
(context: "Exceptions"
- [should-throw? r;bool
- which? r;bool
- should-catch? r;bool
- default-val r;nat
- some-val r;nat
- another-val r;nat
- otherwise-val r;nat
- #let [this-ex (if should-catch?
- (if which?
- Some-Exception
- Another-Exception)
- Unknown-Exception)
- expected (if should-throw?
- (if should-catch?
- (if which?
- some-val
- another-val)
- otherwise-val)
- default-val)
- actual (|> (: (E;Error Nat)
- (if should-throw?
- (&;throw this-ex "Uh-oh...")
- (&;return default-val)))
- (&;catch Some-Exception (function [ex] some-val))
- (&;catch Another-Exception (function [ex] another-val))
- (&;otherwise (function [ex] otherwise-val)))]]
- (test "Catch and otherwhise handlers can properly handle the flow of exception-handling."
- (n.= expected actual)))
+ (<| (times +100)
+ (do @
+ [should-throw? r;bool
+ which? r;bool
+ should-catch? r;bool
+ default-val r;nat
+ some-val r;nat
+ another-val r;nat
+ otherwise-val r;nat
+ #let [this-ex (if should-catch?
+ (if which?
+ Some-Exception
+ Another-Exception)
+ Unknown-Exception)
+ expected (if should-throw?
+ (if should-catch?
+ (if which?
+ some-val
+ another-val)
+ otherwise-val)
+ default-val)
+ actual (|> (: (E;Error Nat)
+ (if should-throw?
+ (&;throw this-ex "Uh-oh...")
+ (&;return default-val)))
+ (&;catch Some-Exception (function [ex] some-val))
+ (&;catch Another-Exception (function [ex] another-val))
+ (&;otherwise (function [ex] otherwise-val)))]]
+ (test "Catch and otherwhise handlers can properly handle the flow of exception-handling."
+ (n.= expected actual)))))
diff --git a/stdlib/test/test/lux/control/interval.lux b/stdlib/test/test/lux/control/interval.lux
index 2ba5198bc..589063961 100644
--- a/stdlib/test/test/lux/control/interval.lux
+++ b/stdlib/test/test/lux/control/interval.lux
@@ -12,34 +12,38 @@
["L" coll/list])))
(context: "Equality."
- [bottom r;int
- top r;int
- #let [(^open "&/") &;Eq<Interval>]]
- ($_ seq
- (test "Every interval is equal to itself."
- (and (let [self (&;between number;Enum<Int> bottom top)]
- (&/= self self))
- (let [self (&;between number;Enum<Int> top bottom)]
- (&/= self self))
- (let [self (&;singleton number;Enum<Int> bottom)]
- (&/= self self))))))
+ (<| (times +100)
+ (do @
+ [bottom r;int
+ top r;int
+ #let [(^open "&/") &;Eq<Interval>]]
+ ($_ seq
+ (test "Every interval is equal to itself."
+ (and (let [self (&;between number;Enum<Int> bottom top)]
+ (&/= self self))
+ (let [self (&;between number;Enum<Int> top bottom)]
+ (&/= self self))
+ (let [self (&;singleton number;Enum<Int> bottom)]
+ (&/= self self))))))))
(context: "Boundaries"
- [bottom r;int
- top r;int
- #let [interval (&;between number;Enum<Int> bottom top)]]
- ($_ seq
- (test "Every boundary value belongs to it's interval."
- (and (&;within? interval bottom)
- (&;within? interval top)))
- (test "Every interval starts with its bottom."
- (&;starts-with? bottom interval))
- (test "Every interval ends with its top."
- (&;ends-with? top interval))
- (test "The boundary values border the interval."
- (and (&;borders? interval bottom)
- (&;borders? interval top)))
- ))
+ (<| (times +100)
+ (do @
+ [bottom r;int
+ top r;int
+ #let [interval (&;between number;Enum<Int> bottom top)]]
+ ($_ seq
+ (test "Every boundary value belongs to it's interval."
+ (and (&;within? interval bottom)
+ (&;within? interval top)))
+ (test "Every interval starts with its bottom."
+ (&;starts-with? bottom interval))
+ (test "Every interval ends with its top."
+ (&;ends-with? top interval))
+ (test "The boundary values border the interval."
+ (and (&;borders? interval bottom)
+ (&;borders? interval top)))
+ ))))
(def: (list-to-4tuple list)
(-> (List Int) [Int Int Int Int])
@@ -79,139 +83,151 @@
gen-singleton))
(context: "Unions"
- [some-interval gen-interval
- left-inner gen-inner
- right-inner gen-inner
- left-singleton gen-singleton
- right-singleton gen-singleton
- left-outer gen-outer
- right-outer gen-outer
- #let [(^open "&/") &;Eq<Interval>]]
- ($_ seq
- (test "The union of an interval to itself yields the same interval."
- (&/= some-interval (&;union some-interval some-interval)))
- (test "The union of 2 inner intervals is another inner interval."
- (&;inner? (&;union left-inner right-inner)))
- (test "The union of 2 outer intervals yields an inner interval when their complements don't overlap, and an outer when they do."
- (if (&;overlaps? (&;complement left-outer) (&;complement right-outer))
- (&;outer? (&;union left-outer right-outer))
- (&;inner? (&;union left-outer right-outer))))
- ))
+ (<| (times +100)
+ (do @
+ [some-interval gen-interval
+ left-inner gen-inner
+ right-inner gen-inner
+ left-singleton gen-singleton
+ right-singleton gen-singleton
+ left-outer gen-outer
+ right-outer gen-outer
+ #let [(^open "&/") &;Eq<Interval>]]
+ ($_ seq
+ (test "The union of an interval to itself yields the same interval."
+ (&/= some-interval (&;union some-interval some-interval)))
+ (test "The union of 2 inner intervals is another inner interval."
+ (&;inner? (&;union left-inner right-inner)))
+ (test "The union of 2 outer intervals yields an inner interval when their complements don't overlap, and an outer when they do."
+ (if (&;overlaps? (&;complement left-outer) (&;complement right-outer))
+ (&;outer? (&;union left-outer right-outer))
+ (&;inner? (&;union left-outer right-outer))))
+ ))))
(context: "Intersections"
- [some-interval gen-interval
- left-inner gen-inner
- right-inner gen-inner
- left-singleton gen-singleton
- right-singleton gen-singleton
- left-outer gen-outer
- right-outer gen-outer
- #let [(^open "&/") &;Eq<Interval>]]
- ($_ seq
- (test "The intersection of an interval to itself yields the same interval."
- (&/= some-interval (&;intersection some-interval some-interval)))
- (test "The intersection of 2 inner intervals yields an inner interval when they overlap, and an outer when they don't."
- (if (&;overlaps? left-inner right-inner)
- (&;inner? (&;intersection left-inner right-inner))
- (&;outer? (&;intersection left-inner right-inner))))
- (test "The intersection of 2 outer intervals is another outer interval."
- (&;outer? (&;intersection left-outer right-outer)))
- ))
+ (<| (times +100)
+ (do @
+ [some-interval gen-interval
+ left-inner gen-inner
+ right-inner gen-inner
+ left-singleton gen-singleton
+ right-singleton gen-singleton
+ left-outer gen-outer
+ right-outer gen-outer
+ #let [(^open "&/") &;Eq<Interval>]]
+ ($_ seq
+ (test "The intersection of an interval to itself yields the same interval."
+ (&/= some-interval (&;intersection some-interval some-interval)))
+ (test "The intersection of 2 inner intervals yields an inner interval when they overlap, and an outer when they don't."
+ (if (&;overlaps? left-inner right-inner)
+ (&;inner? (&;intersection left-inner right-inner))
+ (&;outer? (&;intersection left-inner right-inner))))
+ (test "The intersection of 2 outer intervals is another outer interval."
+ (&;outer? (&;intersection left-outer right-outer)))
+ ))))
(context: "Complement"
- [some-interval gen-interval
- #let [(^open "&/") &;Eq<Interval>]]
- ($_ seq
- (test "The complement of a complement is the same as the original."
- (&/= some-interval (|> some-interval &;complement &;complement)))
- (test "The complement of an interval does not overlap it."
- (not (&;overlaps? some-interval (&;complement some-interval))))
- ))
+ (<| (times +100)
+ (do @
+ [some-interval gen-interval
+ #let [(^open "&/") &;Eq<Interval>]]
+ ($_ seq
+ (test "The complement of a complement is the same as the original."
+ (&/= some-interval (|> some-interval &;complement &;complement)))
+ (test "The complement of an interval does not overlap it."
+ (not (&;overlaps? some-interval (&;complement some-interval))))
+ ))))
(context: "Positioning/location"
- [[l m r] (|> (r;set number;Hash<Int> +3 r;int)
- (:: @ map (|>. S;to-list
- (L;sort i.<)
- (case> (^ (list b t1 t2))
- [b t1 t2]
-
- _
- (undefined)))))
- #let [left (&;singleton number;Enum<Int> l)
- right (&;singleton number;Enum<Int> r)]]
- ($_ seq
- (test "'precedes?' and 'succeeds?' are symetric."
- (and (&;precedes? right left)
- (&;succeeds? left right)))
- (test "Can check if an interval is before or after some element."
- (and (&;before? m left)
- (&;after? m right)))
- ))
-
-(context: "Touching intervals"
- [[b t1 t2] (|> (r;set number;Hash<Int> +3 r;int)
- (:: @ map (|>. S;to-list
- (L;sort i.<)
- (case> (^ (list b t1 t2))
- [b t1 t2]
-
- _
- (undefined)))))
- #let [int-left (&;between number;Enum<Int> t1 t2)
- int-right (&;between number;Enum<Int> b t1)]]
- ($_ seq
- (test "An interval meets another if it's top is the other's bottom."
- (&;meets? int-left int-right))
- (test "Two intervals touch one another if any one meets the other."
- (&;touches? int-left int-right))
- (test "Can check if 2 intervals start together."
- (&;starts? (&;between number;Enum<Int> b t2)
- (&;between number;Enum<Int> b t1)))
- (test "Can check if 2 intervals finish together."
- (&;finishes? (&;between number;Enum<Int> b t2)
- (&;between number;Enum<Int> t1 t2)))
- ))
-
-(context: "Nesting & overlap"
- [some-interval gen-interval
- [x0 x1 x2 x3] (|> (r;set number;Hash<Int> +4 r;int)
+ (<| (times +100)
+ (do @
+ [[l m r] (|> (r;set number;Hash<Int> +3 r;int)
(:: @ map (|>. S;to-list
(L;sort i.<)
- (case> (^ (list x0 x1 x2 x3))
- [x0 x1 x2 x3]
+ (case> (^ (list b t1 t2))
+ [b t1 t2]
_
- (undefined)))))]
- ($_ seq
- (test "Every interval is nested into itself."
- (&;nested? some-interval some-interval))
- (test "No interval overlaps with itself."
- (not (&;overlaps? some-interval some-interval)))
- (let [small-inner (&;between number;Enum<Int> x1 x2)
- large-inner (&;between number;Enum<Int> x0 x3)]
- (test "Inner intervals can be nested inside one another."
- (and (&;nested? large-inner small-inner)
- (not (&;nested? small-inner large-inner)))))
- (let [left-inner (&;between number;Enum<Int> x0 x2)
- right-inner (&;between number;Enum<Int> x1 x3)]
- (test "Inner intervals can overlap one another."
- (and (&;overlaps? left-inner right-inner)
- (&;overlaps? right-inner left-inner))))
- (let [small-outer (&;between number;Enum<Int> x2 x1)
- large-outer (&;between number;Enum<Int> x3 x0)]
- (test "Outer intervals can be nested inside one another."
- (and (&;nested? small-outer large-outer)
- (not (&;nested? large-outer small-outer)))))
- (let [left-inner (&;between number;Enum<Int> x0 x1)
- right-inner (&;between number;Enum<Int> x2 x3)
- outer (&;between number;Enum<Int> x0 x3)]
- (test "Inners can be nested inside outers."
- (and (&;nested? outer left-inner)
- (&;nested? outer right-inner))))
- (let [left-inner (&;between number;Enum<Int> x0 x2)
- right-inner (&;between number;Enum<Int> x1 x3)
- outer (&;between number;Enum<Int> x1 x2)]
- (test "Inners can overlap outers."
- (and (&;overlaps? outer left-inner)
- (&;overlaps? outer right-inner))))
- ))
+ (undefined)))))
+ #let [left (&;singleton number;Enum<Int> l)
+ right (&;singleton number;Enum<Int> r)]]
+ ($_ seq
+ (test "'precedes?' and 'succeeds?' are symetric."
+ (and (&;precedes? right left)
+ (&;succeeds? left right)))
+ (test "Can check if an interval is before or after some element."
+ (and (&;before? m left)
+ (&;after? m right)))
+ ))))
+
+(context: "Touching intervals"
+ (<| (times +100)
+ (do @
+ [[b t1 t2] (|> (r;set number;Hash<Int> +3 r;int)
+ (:: @ map (|>. S;to-list
+ (L;sort i.<)
+ (case> (^ (list b t1 t2))
+ [b t1 t2]
+
+ _
+ (undefined)))))
+ #let [int-left (&;between number;Enum<Int> t1 t2)
+ int-right (&;between number;Enum<Int> b t1)]]
+ ($_ seq
+ (test "An interval meets another if it's top is the other's bottom."
+ (&;meets? int-left int-right))
+ (test "Two intervals touch one another if any one meets the other."
+ (&;touches? int-left int-right))
+ (test "Can check if 2 intervals start together."
+ (&;starts? (&;between number;Enum<Int> b t2)
+ (&;between number;Enum<Int> b t1)))
+ (test "Can check if 2 intervals finish together."
+ (&;finishes? (&;between number;Enum<Int> b t2)
+ (&;between number;Enum<Int> t1 t2)))
+ ))))
+
+(context: "Nesting & overlap"
+ (<| (times +100)
+ (do @
+ [some-interval gen-interval
+ [x0 x1 x2 x3] (|> (r;set number;Hash<Int> +4 r;int)
+ (:: @ map (|>. S;to-list
+ (L;sort i.<)
+ (case> (^ (list x0 x1 x2 x3))
+ [x0 x1 x2 x3]
+
+ _
+ (undefined)))))]
+ ($_ seq
+ (test "Every interval is nested into itself."
+ (&;nested? some-interval some-interval))
+ (test "No interval overlaps with itself."
+ (not (&;overlaps? some-interval some-interval)))
+ (let [small-inner (&;between number;Enum<Int> x1 x2)
+ large-inner (&;between number;Enum<Int> x0 x3)]
+ (test "Inner intervals can be nested inside one another."
+ (and (&;nested? large-inner small-inner)
+ (not (&;nested? small-inner large-inner)))))
+ (let [left-inner (&;between number;Enum<Int> x0 x2)
+ right-inner (&;between number;Enum<Int> x1 x3)]
+ (test "Inner intervals can overlap one another."
+ (and (&;overlaps? left-inner right-inner)
+ (&;overlaps? right-inner left-inner))))
+ (let [small-outer (&;between number;Enum<Int> x2 x1)
+ large-outer (&;between number;Enum<Int> x3 x0)]
+ (test "Outer intervals can be nested inside one another."
+ (and (&;nested? small-outer large-outer)
+ (not (&;nested? large-outer small-outer)))))
+ (let [left-inner (&;between number;Enum<Int> x0 x1)
+ right-inner (&;between number;Enum<Int> x2 x3)
+ outer (&;between number;Enum<Int> x0 x3)]
+ (test "Inners can be nested inside outers."
+ (and (&;nested? outer left-inner)
+ (&;nested? outer right-inner))))
+ (let [left-inner (&;between number;Enum<Int> x0 x2)
+ right-inner (&;between number;Enum<Int> x1 x3)
+ outer (&;between number;Enum<Int> x1 x2)]
+ (test "Inners can overlap outers."
+ (and (&;overlaps? outer left-inner)
+ (&;overlaps? outer right-inner))))
+ ))))
diff --git a/stdlib/test/test/lux/control/state.lux b/stdlib/test/test/lux/control/state.lux
index 1447e61c3..e2b25d051 100644
--- a/stdlib/test/test/lux/control/state.lux
+++ b/stdlib/test/test/lux/control/state.lux
@@ -19,89 +19,97 @@
(n.= output)))
(context: "Basics"
- [state r;nat
- value r;nat]
- ($_ seq
- (test "Can get the state as a value."
- (with-conditions [state state]
- &;get))
- (test "Can replace the state."
- (with-conditions [state value]
- (do &;Monad<State>
- [_ (&;put value)]
- &;get)))
- (test "Can update the state."
- (with-conditions [state (n.* value state)]
- (do &;Monad<State>
- [_ (&;update (n.* value))]
- &;get)))
- (test "Can use the state."
- (with-conditions [state (n.inc state)]
- (&;use n.inc)))
- (test "Can use a temporary (local) state."
- (with-conditions [state (n.* value state)]
- (&;local (n.* value)
- &;get)))
- ))
+ (<| (times +100)
+ (do @
+ [state r;nat
+ value r;nat]
+ ($_ seq
+ (test "Can get the state as a value."
+ (with-conditions [state state]
+ &;get))
+ (test "Can replace the state."
+ (with-conditions [state value]
+ (do &;Monad<State>
+ [_ (&;put value)]
+ &;get)))
+ (test "Can update the state."
+ (with-conditions [state (n.* value state)]
+ (do &;Monad<State>
+ [_ (&;update (n.* value))]
+ &;get)))
+ (test "Can use the state."
+ (with-conditions [state (n.inc state)]
+ (&;use n.inc)))
+ (test "Can use a temporary (local) state."
+ (with-conditions [state (n.* value state)]
+ (&;local (n.* value)
+ &;get)))
+ ))))
(context: "Structures"
- [state r;nat
- value r;nat]
- ($_ seq
- (test "Can use functor."
- (with-conditions [state (n.inc state)]
- (:: &;Functor<State> map n.inc &;get)))
- (test "Can use applicative."
- (let [(^open "&/") &;Applicative<State>]
- (and (with-conditions [state value]
- (&/wrap value))
- (with-conditions [state (n.+ value value)]
- (&/apply (&/wrap (n.+ value))
- (&/wrap value))))))
- (test "Can use monad."
- (with-conditions [state (n.+ value value)]
- (: (&;State Nat Nat)
- (do &;Monad<State>
- [f (wrap n.+)
- x (wrap value)
- y (wrap value)]
- (wrap (f x y))))))
- ))
+ (<| (times +100)
+ (do @
+ [state r;nat
+ value r;nat]
+ ($_ seq
+ (test "Can use functor."
+ (with-conditions [state (n.inc state)]
+ (:: &;Functor<State> map n.inc &;get)))
+ (test "Can use applicative."
+ (let [(^open "&/") &;Applicative<State>]
+ (and (with-conditions [state value]
+ (&/wrap value))
+ (with-conditions [state (n.+ value value)]
+ (&/apply (&/wrap (n.+ value))
+ (&/wrap value))))))
+ (test "Can use monad."
+ (with-conditions [state (n.+ value value)]
+ (: (&;State Nat Nat)
+ (do &;Monad<State>
+ [f (wrap n.+)
+ x (wrap value)
+ y (wrap value)]
+ (wrap (f x y))))))
+ ))))
(context: "Monad transformer"
- [state r;nat
- left r;nat
- right r;nat]
- (let [(^open "io/") io;Monad<IO>]
- (test "Can add state functionality to any monad."
- (|> (: (&;State' io;IO Nat Nat)
- (do (&;StateT io;Monad<IO>)
- [a (&;lift io;Monad<IO> (io/wrap left))
- b (wrap right)]
- (wrap (n.+ a b))))
- (&;run' state)
- io;run
- (case> [state' output']
- (and (n.= state state')
- (n.= (n.+ left right) output')))))
- ))
+ (<| (times +100)
+ (do @
+ [state r;nat
+ left r;nat
+ right r;nat]
+ (let [(^open "io/") io;Monad<IO>]
+ (test "Can add state functionality to any monad."
+ (|> (: (&;State' io;IO Nat Nat)
+ (do (&;StateT io;Monad<IO>)
+ [a (&;lift io;Monad<IO> (io/wrap left))
+ b (wrap right)]
+ (wrap (n.+ a b))))
+ (&;run' state)
+ io;run
+ (case> [state' output']
+ (and (n.= state state')
+ (n.= (n.+ left right) output')))))
+ ))))
(context: "Loops"
- [limit (|> r;nat (:: @ map (n.% +10)))
- #let [condition (do &;Monad<State>
- [state &;get]
- (wrap (n.< limit state)))]]
- ($_ seq
- (test "'while' will only execute if the condition is true."
- (|> (&;while condition (&;update n.inc))
- (&;run +0)
- (case> [state' output']
- (n.= limit state'))))
- (test "'do-while' will execute at least once."
- (|> (&;do-while condition (&;update n.inc))
- (&;run +0)
- (case> [state' output']
- (or (n.= limit state')
- (and (n.= +0 limit)
- (n.= +1 state'))))))
- ))
+ (<| (times +100)
+ (do @
+ [limit (|> r;nat (:: @ map (n.% +10)))
+ #let [condition (do &;Monad<State>
+ [state &;get]
+ (wrap (n.< limit state)))]]
+ ($_ seq
+ (test "'while' will only execute if the condition is true."
+ (|> (&;while condition (&;update n.inc))
+ (&;run +0)
+ (case> [state' output']
+ (n.= limit state'))))
+ (test "'do-while' will execute at least once."
+ (|> (&;do-while condition (&;update n.inc))
+ (&;run +0)
+ (case> [state' output']
+ (or (n.= limit state')
+ (and (n.= +0 limit)
+ (n.= +1 state'))))))
+ ))))
diff --git a/stdlib/test/test/lux/data/bit.lux b/stdlib/test/test/lux/data/bit.lux
index 8bbe8e599..62bc2ce0b 100644
--- a/stdlib/test/test/lux/data/bit.lux
+++ b/stdlib/test/test/lux/data/bit.lux
@@ -8,62 +8,64 @@
lux/test)
(context: "Bitwise operations."
- [pattern r;nat
- idx (:: @ map (n.% &;width) r;nat)]
- ($_ seq
- (test "Clearing and settings bits should alter the count."
- (and (n.< (&;count (&;set idx pattern))
- (&;count (&;clear idx pattern)))
- (n.<= (&;count pattern)
- (&;count (&;clear idx pattern)))
- (n.>= (&;count pattern)
- (&;count (&;set idx pattern)))))
- (test "Can query whether a bit is set."
- (and (or (and (&;set? idx pattern)
- (not (&;set? idx (&;clear idx pattern))))
- (and (not (&;set? idx pattern))
- (&;set? idx (&;set idx pattern))))
+ (<| (times +100)
+ (do @
+ [pattern r;nat
+ idx (:: @ map (n.% &;width) r;nat)]
+ ($_ seq
+ (test "Clearing and settings bits should alter the count."
+ (and (n.< (&;count (&;set idx pattern))
+ (&;count (&;clear idx pattern)))
+ (n.<= (&;count pattern)
+ (&;count (&;clear idx pattern)))
+ (n.>= (&;count pattern)
+ (&;count (&;set idx pattern)))))
+ (test "Can query whether a bit is set."
+ (and (or (and (&;set? idx pattern)
+ (not (&;set? idx (&;clear idx pattern))))
+ (and (not (&;set? idx pattern))
+ (&;set? idx (&;set idx pattern))))
- (or (and (&;set? idx pattern)
- (not (&;set? idx (&;flip idx pattern))))
- (and (not (&;set? idx pattern))
- (&;set? idx (&;flip idx pattern))))))
- (test "The negation of a bit pattern should have a complementary bit count."
- (n.= &;width
- (n.+ (&;count pattern)
- (&;count (&;not pattern)))))
- (test "Can do simple binary boolean logic."
- (and (n.= +0
- (&;and pattern
- (&;not pattern)))
- (n.= (&;not +0)
- (&;or pattern
- (&;not pattern)))
- (n.= (&;not +0)
- (&;xor pattern
- (&;not pattern)))
- (n.= +0
- (&;xor pattern
- pattern))))
- (test "rotate-left and rotate-right are inverses of one another."
- (and (|> pattern
- (&;rotate-left idx)
- (&;rotate-right idx)
- (n.= pattern))
- (|> pattern
- (&;rotate-right idx)
- (&;rotate-left idx)
- (n.= pattern))))
- (test "Rotate as many spaces as the bit-pattern's width leaves the pattern unchanged."
- (and (|> pattern
- (&;rotate-left &;width)
- (n.= pattern))
- (|> pattern
- (&;rotate-right &;width)
- (n.= pattern))))
- (test "Shift right respect the sign of ints."
- (let [value (nat-to-int pattern)]
- (if (i.< 0 value)
- (i.< 0 (&;signed-shift-right idx value))
- (i.>= 0 (&;signed-shift-right idx value)))))
- ))
+ (or (and (&;set? idx pattern)
+ (not (&;set? idx (&;flip idx pattern))))
+ (and (not (&;set? idx pattern))
+ (&;set? idx (&;flip idx pattern))))))
+ (test "The negation of a bit pattern should have a complementary bit count."
+ (n.= &;width
+ (n.+ (&;count pattern)
+ (&;count (&;not pattern)))))
+ (test "Can do simple binary boolean logic."
+ (and (n.= +0
+ (&;and pattern
+ (&;not pattern)))
+ (n.= (&;not +0)
+ (&;or pattern
+ (&;not pattern)))
+ (n.= (&;not +0)
+ (&;xor pattern
+ (&;not pattern)))
+ (n.= +0
+ (&;xor pattern
+ pattern))))
+ (test "rotate-left and rotate-right are inverses of one another."
+ (and (|> pattern
+ (&;rotate-left idx)
+ (&;rotate-right idx)
+ (n.= pattern))
+ (|> pattern
+ (&;rotate-right idx)
+ (&;rotate-left idx)
+ (n.= pattern))))
+ (test "Rotate as many spaces as the bit-pattern's width leaves the pattern unchanged."
+ (and (|> pattern
+ (&;rotate-left &;width)
+ (n.= pattern))
+ (|> pattern
+ (&;rotate-right &;width)
+ (n.= pattern))))
+ (test "Shift right respect the sign of ints."
+ (let [value (nat-to-int pattern)]
+ (if (i.< 0 value)
+ (i.< 0 (&;signed-shift-right idx value))
+ (i.>= 0 (&;signed-shift-right idx value)))))
+ ))))
diff --git a/stdlib/test/test/lux/data/bool.lux b/stdlib/test/test/lux/data/bool.lux
index 69366a3d2..0336c15e7 100644
--- a/stdlib/test/test/lux/data/bool.lux
+++ b/stdlib/test/test/lux/data/bool.lux
@@ -7,27 +7,29 @@
lux/test)
(context: "Boolean operations."
- [value r;bool]
- (test "" (and (not (and value (not value)))
- (or value (not value))
+ (<| (times +100)
+ (do @
+ [value r;bool]
+ (test "" (and (not (and value (not value)))
+ (or value (not value))
- (not (:: Or@Monoid<Bool> identity))
- (:: Or@Monoid<Bool> compose value (not value))
- (:: And@Monoid<Bool> identity)
- (not (:: And@Monoid<Bool> compose value (not value)))
-
- (:: Eq<Bool> = value (not (not value)))
- (not (:: Eq<Bool> = value (not value)))
+ (not (:: Or@Monoid<Bool> identity))
+ (:: Or@Monoid<Bool> compose value (not value))
+ (:: And@Monoid<Bool> identity)
+ (not (:: And@Monoid<Bool> compose value (not value)))
+
+ (:: Eq<Bool> = value (not (not value)))
+ (not (:: Eq<Bool> = value (not value)))
- (not (:: Eq<Bool> = value ((complement id) value)))
- (:: Eq<Bool> = value ((complement not) value))
+ (not (:: Eq<Bool> = value ((complement id) value)))
+ (:: Eq<Bool> = value ((complement not) value))
- (case (|> value
- (:: Codec<Text,Bool> encode)
- (:: Codec<Text,Bool> decode))
- (#;Right dec-value)
- (:: Eq<Bool> = value dec-value)
+ (case (|> value
+ (:: Codec<Text,Bool> encode)
+ (:: Codec<Text,Bool> decode))
+ (#;Right dec-value)
+ (:: Eq<Bool> = value dec-value)
- (#;Left _)
- false)
- )))
+ (#;Left _)
+ false)
+ )))))
diff --git a/stdlib/test/test/lux/data/coll/array.lux b/stdlib/test/test/lux/data/coll/array.lux
index e32bf2e0f..5f679b910 100644
--- a/stdlib/test/test/lux/data/coll/array.lux
+++ b/stdlib/test/test/lux/data/coll/array.lux
@@ -16,115 +16,125 @@
(:: r;Monad<Random> map (|>. (n.% +100) (n.+ +1)))))
(context: "Arrays and their copies"
- [size bounded-size
- original (r;array size r;nat)
- #let [clone (@;clone original)
- copy (: (Array Nat)
- (@;new size))
- manual-copy (: (Array Nat)
- (@;new size))]]
- ($_ seq
- (test "Size function must correctly return size of array."
- (n.= size (@;size original)))
- (test "Cloning an array should yield and identical array, but not the same one."
- (and (:: (@;Eq<Array> number;Eq<Nat>) = original clone)
- (not (is original clone))))
- (test "Full-range manual copies should give the same result as cloning."
- (exec (@;copy size +0 original +0 copy)
- (and (:: (@;Eq<Array> number;Eq<Nat>) = original copy)
- (not (is original copy)))))
- (test "Array folding should go over all values."
- (exec (:: @;Fold<Array> fold
- (function [x idx]
- (exec (@;write idx x manual-copy)
- (n.inc idx)))
- +0
- original)
- (:: (@;Eq<Array> number;Eq<Nat>) = original manual-copy)))
- (test "Transformations between (full) arrays and lists shouldn't cause lose or change any values."
- (|> original
- @;to-list @;from-list
- (:: (@;Eq<Array> number;Eq<Nat>) = original)))
- ))
+ (<| (times +100)
+ (do @
+ [size bounded-size
+ original (r;array size r;nat)
+ #let [clone (@;clone original)
+ copy (: (Array Nat)
+ (@;new size))
+ manual-copy (: (Array Nat)
+ (@;new size))]]
+ ($_ seq
+ (test "Size function must correctly return size of array."
+ (n.= size (@;size original)))
+ (test "Cloning an array should yield and identical array, but not the same one."
+ (and (:: (@;Eq<Array> number;Eq<Nat>) = original clone)
+ (not (is original clone))))
+ (test "Full-range manual copies should give the same result as cloning."
+ (exec (@;copy size +0 original +0 copy)
+ (and (:: (@;Eq<Array> number;Eq<Nat>) = original copy)
+ (not (is original copy)))))
+ (test "Array folding should go over all values."
+ (exec (:: @;Fold<Array> fold
+ (function [x idx]
+ (exec (@;write idx x manual-copy)
+ (n.inc idx)))
+ +0
+ original)
+ (:: (@;Eq<Array> number;Eq<Nat>) = original manual-copy)))
+ (test "Transformations between (full) arrays and lists shouldn't cause lose or change any values."
+ (|> original
+ @;to-list @;from-list
+ (:: (@;Eq<Array> number;Eq<Nat>) = original)))
+ ))))
(context: "Array mutation"
- [size bounded-size
- idx (:: @ map (n.% size) r;nat)
- array (|> (r;array size r;nat)
- (r;filter (|>. @;to-list (list;any? n.odd?))))
- #let [value (maybe;assume (@;read idx array))]]
- ($_ seq
- (test "Shouldn't be able to find a value in an unoccupied cell."
- (case (@;read idx (@;delete idx array))
- (#;Some _) false
- #;None true))
- (test "You should be able to access values put into the array."
- (case (@;read idx (@;write idx value array))
- (#;Some value') (n.= value' value)
- #;None false))
- (test "All cells should be occupied on a full array."
- (and (n.= size (@;occupied array))
- (n.= +0 (@;vacant array))))
- (test "Filtering mutates the array to remove invalid values."
- (exec (@;filter n.even? array)
- (and (n.< size (@;occupied array))
- (n.> +0 (@;vacant array))
- (n.= size (n.+ (@;occupied array)
- (@;vacant array))))))
- ))
+ (<| (times +100)
+ (do @
+ [size bounded-size
+ idx (:: @ map (n.% size) r;nat)
+ array (|> (r;array size r;nat)
+ (r;filter (|>. @;to-list (list;any? n.odd?))))
+ #let [value (maybe;assume (@;read idx array))]]
+ ($_ seq
+ (test "Shouldn't be able to find a value in an unoccupied cell."
+ (case (@;read idx (@;delete idx array))
+ (#;Some _) false
+ #;None true))
+ (test "You should be able to access values put into the array."
+ (case (@;read idx (@;write idx value array))
+ (#;Some value') (n.= value' value)
+ #;None false))
+ (test "All cells should be occupied on a full array."
+ (and (n.= size (@;occupied array))
+ (n.= +0 (@;vacant array))))
+ (test "Filtering mutates the array to remove invalid values."
+ (exec (@;filter n.even? array)
+ (and (n.< size (@;occupied array))
+ (n.> +0 (@;vacant array))
+ (n.= size (n.+ (@;occupied array)
+ (@;vacant array))))))
+ ))))
(context: "Finding values."
- [size bounded-size
- array (|> (r;array size r;nat)
- (r;filter (|>. @;to-list (list;any? n.even?))))]
- ($_ seq
- (test "Can find values inside arrays."
- (|> (@;find n.even? array)
- (case> (#;Some _) true
- #;None false)))
- (test "Can find values inside arrays (with access to indices)."
- (|> (@;find+ (function [idx n]
- (and (n.even? n)
- (n.< size idx)))
- array)
- (case> (#;Some _) true
- #;None false)))))
+ (<| (times +100)
+ (do @
+ [size bounded-size
+ array (|> (r;array size r;nat)
+ (r;filter (|>. @;to-list (list;any? n.even?))))]
+ ($_ seq
+ (test "Can find values inside arrays."
+ (|> (@;find n.even? array)
+ (case> (#;Some _) true
+ #;None false)))
+ (test "Can find values inside arrays (with access to indices)."
+ (|> (@;find+ (function [idx n]
+ (and (n.even? n)
+ (n.< size idx)))
+ array)
+ (case> (#;Some _) true
+ #;None false)))))))
(context: "Functor"
- [size bounded-size
- array (r;array size r;nat)]
- (let [(^open) @;Functor<Array>
- (^open) (@;Eq<Array> number;Eq<Nat>)]
- ($_ seq
- (test "Functor shouldn't alter original array."
- (let [copy (map id array)]
- (and (= array copy)
- (not (is array copy)))))
- (test "Functor should go over all available array elements."
- (let [there (map n.inc array)
- back-again (map n.dec there)]
- (and (not (= array there))
- (= array back-again)))))))
+ (<| (times +100)
+ (do @
+ [size bounded-size
+ array (r;array size r;nat)]
+ (let [(^open) @;Functor<Array>
+ (^open) (@;Eq<Array> number;Eq<Nat>)]
+ ($_ seq
+ (test "Functor shouldn't alter original array."
+ (let [copy (map id array)]
+ (and (= array copy)
+ (not (is array copy)))))
+ (test "Functor should go over all available array elements."
+ (let [there (map n.inc array)
+ back-again (map n.dec there)]
+ (and (not (= array there))
+ (= array back-again)))))))))
(context: "Monoid"
- [sizeL bounded-size
- sizeR bounded-size
- left (r;array sizeL r;nat)
- right (r;array sizeR r;nat)
- #let [(^open) @;Monoid<Array>
- (^open) (@;Eq<Array> number;Eq<Nat>)
- fusion (compose left right)]]
- ($_ seq
- (test "Appending two arrays should produce a new one twice as large."
- (n.= (n.+ sizeL sizeR) (@;size fusion)))
- (test "First elements of fused array should equal the first array."
- (|> (: (Array Nat)
- (@;new sizeL))
- (@;copy sizeL +0 fusion +0)
- (= left)))
- (test "Last elements of fused array should equal the second array."
- (|> (: (Array Nat)
- (@;new sizeR))
- (@;copy sizeR sizeL fusion +0)
- (= right)))
- ))
+ (<| (times +100)
+ (do @
+ [sizeL bounded-size
+ sizeR bounded-size
+ left (r;array sizeL r;nat)
+ right (r;array sizeR r;nat)
+ #let [(^open) @;Monoid<Array>
+ (^open) (@;Eq<Array> number;Eq<Nat>)
+ fusion (compose left right)]]
+ ($_ seq
+ (test "Appending two arrays should produce a new one twice as large."
+ (n.= (n.+ sizeL sizeR) (@;size fusion)))
+ (test "First elements of fused array should equal the first array."
+ (|> (: (Array Nat)
+ (@;new sizeL))
+ (@;copy sizeL +0 fusion +0)
+ (= left)))
+ (test "Last elements of fused array should equal the second array."
+ (|> (: (Array Nat)
+ (@;new sizeR))
+ (@;copy sizeR sizeL fusion +0)
+ (= right)))
+ ))))
diff --git a/stdlib/test/test/lux/data/coll/dict.lux b/stdlib/test/test/lux/data/coll/dict.lux
index defea0534..f2e47615a 100644
--- a/stdlib/test/test/lux/data/coll/dict.lux
+++ b/stdlib/test/test/lux/data/coll/dict.lux
@@ -13,114 +13,116 @@
lux/test)
(context: "Dictionaries."
- [#let [capped-nat (:: r;Monad<Random> map (n.% +100) r;nat)]
- size capped-nat
- dict (r;dict number;Hash<Nat> size r;nat capped-nat)
- non-key (|> r;nat (r;filter (function [key] (not (&;contains? key dict)))))
- test-val (|> r;nat (r;filter (function [val] (not (list;member? number;Eq<Nat> (&;values dict) val)))))]
- ($_ seq
- (test "Size function should correctly represent Dict size."
- (n.= size (&;size dict)))
-
- (test "Dicts of size 0 should be considered empty."
- (if (n.= +0 size)
- (&;empty? dict)
- (not (&;empty? dict))))
-
- (test "The functions 'entries', 'keys' and 'values' should be synchronized."
- (:: (list;Eq<List> (eq;seq number;Eq<Nat> number;Eq<Nat>)) =
- (&;entries dict)
- (list;zip2 (&;keys dict)
- (&;values dict))))
-
- (test "Dict should be able to recognize it's own keys."
- (list;every? (function [key] (&;contains? key dict))
- (&;keys dict)))
-
- (test "Should be able to get every key."
- (list;every? (function [key] (case (&;get key dict)
- (#;Some _) true
- _ false))
- (&;keys dict)))
-
- (test "Shouldn't be able to access non-existant keys."
- (case (&;get non-key dict)
- (#;Some _) false
- _ true))
-
- (test "Should be able to put and then get a value."
- (case (&;get non-key (&;put non-key test-val dict))
- (#;Some v) (n.= test-val v)
- _ true))
-
- (test "Should be able to put~ and then get a value."
- (case (&;get non-key (&;put~ non-key test-val dict))
- (#;Some v) (n.= test-val v)
- _ true))
-
- (test "Shouldn't be able to put~ an existing key."
- (or (n.= +0 size)
- (let [first-key (|> dict &;keys list;head maybe;assume)]
- (case (&;get first-key (&;put~ first-key test-val dict))
- (#;Some v) (not (n.= test-val v))
- _ true))))
-
- (test "Removing a key should make it's value inaccessible."
- (let [base (&;put non-key test-val dict)]
- (and (&;contains? non-key base)
- (not (&;contains? non-key (&;remove non-key base))))))
-
- (test "Should be possible to update values via their keys."
- (let [base (&;put non-key test-val dict)
- updt (&;update non-key n.inc base)]
- (case [(&;get non-key base) (&;get non-key updt)]
- [(#;Some x) (#;Some y)]
- (n.= (n.inc x) y)
+ (<| (times +100)
+ (do @
+ [#let [capped-nat (:: r;Monad<Random> map (n.% +100) r;nat)]
+ size capped-nat
+ dict (r;dict number;Hash<Nat> size r;nat capped-nat)
+ non-key (|> r;nat (r;filter (function [key] (not (&;contains? key dict)))))
+ test-val (|> r;nat (r;filter (function [val] (not (list;member? number;Eq<Nat> (&;values dict) val)))))]
+ ($_ seq
+ (test "Size function should correctly represent Dict size."
+ (n.= size (&;size dict)))
+
+ (test "Dicts of size 0 should be considered empty."
+ (if (n.= +0 size)
+ (&;empty? dict)
+ (not (&;empty? dict))))
+
+ (test "The functions 'entries', 'keys' and 'values' should be synchronized."
+ (:: (list;Eq<List> (eq;seq number;Eq<Nat> number;Eq<Nat>)) =
+ (&;entries dict)
+ (list;zip2 (&;keys dict)
+ (&;values dict))))
+
+ (test "Dict should be able to recognize it's own keys."
+ (list;every? (function [key] (&;contains? key dict))
+ (&;keys dict)))
+
+ (test "Should be able to get every key."
+ (list;every? (function [key] (case (&;get key dict)
+ (#;Some _) true
+ _ false))
+ (&;keys dict)))
+
+ (test "Shouldn't be able to access non-existant keys."
+ (case (&;get non-key dict)
+ (#;Some _) false
+ _ true))
+
+ (test "Should be able to put and then get a value."
+ (case (&;get non-key (&;put non-key test-val dict))
+ (#;Some v) (n.= test-val v)
+ _ true))
+
+ (test "Should be able to put~ and then get a value."
+ (case (&;get non-key (&;put~ non-key test-val dict))
+ (#;Some v) (n.= test-val v)
+ _ true))
+
+ (test "Shouldn't be able to put~ an existing key."
+ (or (n.= +0 size)
+ (let [first-key (|> dict &;keys list;head maybe;assume)]
+ (case (&;get first-key (&;put~ first-key test-val dict))
+ (#;Some v) (not (n.= test-val v))
+ _ true))))
+
+ (test "Removing a key should make it's value inaccessible."
+ (let [base (&;put non-key test-val dict)]
+ (and (&;contains? non-key base)
+ (not (&;contains? non-key (&;remove non-key base))))))
+
+ (test "Should be possible to update values via their keys."
+ (let [base (&;put non-key test-val dict)
+ updt (&;update non-key n.inc base)]
+ (case [(&;get non-key base) (&;get non-key updt)]
+ [(#;Some x) (#;Some y)]
+ (n.= (n.inc x) y)
- _
- false)))
-
- (test "Additions and removals to a Dict should affect its size."
- (let [plus (&;put non-key test-val dict)
- base (&;remove non-key plus)]
- (and (n.= (n.inc (&;size dict)) (&;size plus))
- (n.= (n.dec (&;size plus)) (&;size base)))))
+ _
+ false)))
+
+ (test "Additions and removals to a Dict should affect its size."
+ (let [plus (&;put non-key test-val dict)
+ base (&;remove non-key plus)]
+ (and (n.= (n.inc (&;size dict)) (&;size plus))
+ (n.= (n.dec (&;size plus)) (&;size base)))))
- (test "A Dict should equal itself & going to<->from lists shouldn't change that."
- (let [(^open) (&;Eq<Dict> number;Eq<Nat>)]
- (and (= dict dict)
- (|> dict &;entries (&;from-list number;Hash<Nat>) (= dict)))))
+ (test "A Dict should equal itself & going to<->from lists shouldn't change that."
+ (let [(^open) (&;Eq<Dict> number;Eq<Nat>)]
+ (and (= dict dict)
+ (|> dict &;entries (&;from-list number;Hash<Nat>) (= dict)))))
- (test "Merging a Dict to itself changes nothing."
- (let [(^open) (&;Eq<Dict> number;Eq<Nat>)]
- (= dict (&;merge dict dict))))
+ (test "Merging a Dict to itself changes nothing."
+ (let [(^open) (&;Eq<Dict> number;Eq<Nat>)]
+ (= dict (&;merge dict dict))))
- (test "If you merge, and the second dict has overlapping keys, it should overwrite yours."
- (let [dict' (|> dict &;entries
- (L/map (function [[k v]] [k (n.inc v)]))
- (&;from-list number;Hash<Nat>))
- (^open) (&;Eq<Dict> number;Eq<Nat>)]
- (= dict' (&;merge dict' dict))))
+ (test "If you merge, and the second dict has overlapping keys, it should overwrite yours."
+ (let [dict' (|> dict &;entries
+ (L/map (function [[k v]] [k (n.inc v)]))
+ (&;from-list number;Hash<Nat>))
+ (^open) (&;Eq<Dict> number;Eq<Nat>)]
+ (= dict' (&;merge dict' dict))))
- (test "Can merge values in such a way that they become combined."
- (list;every? (function [[x x*2]] (n.= (n.* +2 x) x*2))
- (list;zip2 (&;values dict)
- (&;values (&;merge-with n.+ dict dict)))))
+ (test "Can merge values in such a way that they become combined."
+ (list;every? (function [[x x*2]] (n.= (n.* +2 x) x*2))
+ (list;zip2 (&;values dict)
+ (&;values (&;merge-with n.+ dict dict)))))
- (test "Should be able to select subset of keys from dict."
- (|> dict
- (&;put non-key test-val)
- (&;select (list non-key))
- &;size
- (n.= +1)))
+ (test "Should be able to select subset of keys from dict."
+ (|> dict
+ (&;put non-key test-val)
+ (&;select (list non-key))
+ &;size
+ (n.= +1)))
- (test "Should be able to re-bind existing values to different keys."
- (or (n.= +0 size)
- (let [first-key (|> dict &;keys list;head maybe;assume)
- rebound (&;re-bind first-key non-key dict)]
- (and (n.= (&;size dict) (&;size rebound))
- (&;contains? non-key rebound)
- (not (&;contains? first-key rebound))
- (n.= (maybe;assume (&;get first-key dict))
- (maybe;assume (&;get non-key rebound)))))))
- ))
+ (test "Should be able to re-bind existing values to different keys."
+ (or (n.= +0 size)
+ (let [first-key (|> dict &;keys list;head maybe;assume)
+ rebound (&;re-bind first-key non-key dict)]
+ (and (n.= (&;size dict) (&;size rebound))
+ (&;contains? non-key rebound)
+ (not (&;contains? first-key rebound))
+ (n.= (maybe;assume (&;get first-key dict))
+ (maybe;assume (&;get non-key rebound)))))))
+ ))))
diff --git a/stdlib/test/test/lux/data/coll/list.lux b/stdlib/test/test/lux/data/coll/list.lux
index 2b5146a65..c1e69445f 100644
--- a/stdlib/test/test/lux/data/coll/list.lux
+++ b/stdlib/test/test/lux/data/coll/list.lux
@@ -18,191 +18,197 @@
(:: r;Monad<Random> map (|>. (n.% +100) (n.+ +10)))))
(context: "Lists: Part 1"
- [size bounded-size
- idx (:: @ map (n.% size) r;nat)
- sample (r;list size r;nat)
- other-size bounded-size
- other-sample (r;list other-size r;nat)
- separator r;nat
- #let [(^open) (&;Eq<List> number;Eq<Nat>)
- (^open "&/") &;Functor<List>]]
- ($_ seq
- (test "The size function should correctly portray the size of the list."
- (n.= size (&;size sample)))
-
- (test "The repeat function should produce as many elements as asked of it."
- (n.= size (&;size (&;repeat size []))))
-
- (test "Reversing a list does not change it's size."
- (n.= (&;size sample)
- (&;size (&;reverse sample))))
-
- (test "Reversing a list twice results in the original list."
- (= sample
- (&;reverse (&;reverse sample))))
-
- (test "Filtering by a predicate and its complement should result in a number of elements equal to the original list."
- (and (n.= (&;size sample)
- (n.+ (&;size (&;filter n.even? sample))
- (&;size (&;filter (bool;complement n.even?) sample))))
- (let [[plus minus] (&;partition n.even? sample)]
- (n.= (&;size sample)
- (n.+ (&;size plus)
- (&;size minus))))))
-
- (test "If every element in a list satisfies a predicate, there can't be any that satisfy its complement."
- (if (&;every? n.even? sample)
- (and (not (&;any? (bool;complement n.even?) sample))
- (&;empty? (&;filter (bool;complement n.even?) sample)))
- (&;any? (bool;complement n.even?) sample)))
-
- (test "Any element of the list can be considered its member."
- (let [elem (maybe;assume (&;nth idx sample))]
- (&;member? number;Eq<Nat> sample elem)))
- ))
+ (<| (times +100)
+ (do @
+ [size bounded-size
+ idx (:: @ map (n.% size) r;nat)
+ sample (r;list size r;nat)
+ other-size bounded-size
+ other-sample (r;list other-size r;nat)
+ separator r;nat
+ #let [(^open) (&;Eq<List> number;Eq<Nat>)
+ (^open "&/") &;Functor<List>]]
+ ($_ seq
+ (test "The size function should correctly portray the size of the list."
+ (n.= size (&;size sample)))
+
+ (test "The repeat function should produce as many elements as asked of it."
+ (n.= size (&;size (&;repeat size []))))
+
+ (test "Reversing a list does not change it's size."
+ (n.= (&;size sample)
+ (&;size (&;reverse sample))))
+
+ (test "Reversing a list twice results in the original list."
+ (= sample
+ (&;reverse (&;reverse sample))))
+
+ (test "Filtering by a predicate and its complement should result in a number of elements equal to the original list."
+ (and (n.= (&;size sample)
+ (n.+ (&;size (&;filter n.even? sample))
+ (&;size (&;filter (bool;complement n.even?) sample))))
+ (let [[plus minus] (&;partition n.even? sample)]
+ (n.= (&;size sample)
+ (n.+ (&;size plus)
+ (&;size minus))))))
+
+ (test "If every element in a list satisfies a predicate, there can't be any that satisfy its complement."
+ (if (&;every? n.even? sample)
+ (and (not (&;any? (bool;complement n.even?) sample))
+ (&;empty? (&;filter (bool;complement n.even?) sample)))
+ (&;any? (bool;complement n.even?) sample)))
+
+ (test "Any element of the list can be considered its member."
+ (let [elem (maybe;assume (&;nth idx sample))]
+ (&;member? number;Eq<Nat> sample elem)))
+ ))))
(context: "Lists: Part 2"
- [size bounded-size
- idx (:: @ map (n.% size) r;nat)
- sample (r;list size r;nat)
- other-size bounded-size
- other-sample (r;list other-size r;nat)
- separator r;nat
- #let [(^open) (&;Eq<List> number;Eq<Nat>)
- (^open "&/") &;Functor<List>]]
- ($_ seq
- (test "Appending the head and the tail should yield the original list."
- (let [head (maybe;assume (&;head sample))
- tail (maybe;assume (&;tail sample))]
- (= sample
- (#;Cons head tail))))
-
- (test "Appending the inits and the last should yield the original list."
- (let [(^open) &;Monoid<List>
- inits (maybe;assume (&;inits sample))
- last (maybe;assume (&;last sample))]
- (= sample
- (compose inits (list last)))))
-
- (test "Functor should go over every element of the list."
- (let [(^open) &;Functor<List>
- there (map n.inc sample)
- back-again (map n.dec there)]
- (and (not (= sample there))
- (= sample back-again))))
-
- (test "Splitting a list into chunks and re-appending them should yield the original list."
- (let [(^open) &;Monoid<List>
- [left right] (&;split idx sample)
- [left' right'] (&;split-with n.even? sample)]
- (and (= sample
- (compose left right))
- (= sample
- (compose left' right'))
- (= sample
- (compose (&;take idx sample)
- (&;drop idx sample)))
- (= sample
- (compose (&;take-while n.even? sample)
- (&;drop-while n.even? sample)))
- )))
-
- (test "Segmenting the list in pairs should yield as many elements as N/2."
- (n.= (n./ +2 size)
- (&;size (&;as-pairs sample))))
-
- (test "Sorting a list shouldn't change it's size."
- (n.= (&;size sample)
- (&;size (&;sort n.< sample))))
-
- (test "Sorting a list with one order should yield the reverse of sorting it with the opposite order."
- (= (&;sort n.< sample)
- (&;reverse (&;sort n.> sample))))
- ))
+ (<| (times +100)
+ (do @
+ [size bounded-size
+ idx (:: @ map (n.% size) r;nat)
+ sample (r;list size r;nat)
+ other-size bounded-size
+ other-sample (r;list other-size r;nat)
+ separator r;nat
+ #let [(^open) (&;Eq<List> number;Eq<Nat>)
+ (^open "&/") &;Functor<List>]]
+ ($_ seq
+ (test "Appending the head and the tail should yield the original list."
+ (let [head (maybe;assume (&;head sample))
+ tail (maybe;assume (&;tail sample))]
+ (= sample
+ (#;Cons head tail))))
+
+ (test "Appending the inits and the last should yield the original list."
+ (let [(^open) &;Monoid<List>
+ inits (maybe;assume (&;inits sample))
+ last (maybe;assume (&;last sample))]
+ (= sample
+ (compose inits (list last)))))
+
+ (test "Functor should go over every element of the list."
+ (let [(^open) &;Functor<List>
+ there (map n.inc sample)
+ back-again (map n.dec there)]
+ (and (not (= sample there))
+ (= sample back-again))))
+
+ (test "Splitting a list into chunks and re-appending them should yield the original list."
+ (let [(^open) &;Monoid<List>
+ [left right] (&;split idx sample)
+ [left' right'] (&;split-with n.even? sample)]
+ (and (= sample
+ (compose left right))
+ (= sample
+ (compose left' right'))
+ (= sample
+ (compose (&;take idx sample)
+ (&;drop idx sample)))
+ (= sample
+ (compose (&;take-while n.even? sample)
+ (&;drop-while n.even? sample)))
+ )))
+
+ (test "Segmenting the list in pairs should yield as many elements as N/2."
+ (n.= (n./ +2 size)
+ (&;size (&;as-pairs sample))))
+
+ (test "Sorting a list shouldn't change it's size."
+ (n.= (&;size sample)
+ (&;size (&;sort n.< sample))))
+
+ (test "Sorting a list with one order should yield the reverse of sorting it with the opposite order."
+ (= (&;sort n.< sample)
+ (&;reverse (&;sort n.> sample))))
+ ))))
(context: "Lists: Part 3"
- [size bounded-size
- idx (:: @ map (n.% size) r;nat)
- sample (r;list size r;nat)
- other-size bounded-size
- other-sample (r;list other-size r;nat)
- separator r;nat
- #let [(^open) (&;Eq<List> number;Eq<Nat>)
- (^open "&/") &;Functor<List>]]
- ($_ seq
- (test "If you zip 2 lists, the result's size will be that of the smaller list."
- (n.= (&;size (&;zip2 sample other-sample))
- (n.min (&;size sample) (&;size other-sample))))
-
- (test "I can pair-up elements of a list in order."
- (let [(^open) &;Functor<List>
- zipped (&;zip2 sample other-sample)
- num-zipper (&;size zipped)]
- (and (|> zipped (map product;left) (= (&;take num-zipper sample)))
- (|> zipped (map product;right) (= (&;take num-zipper other-sample))))))
-
- (test "You can generate indices for any size, and they will be in ascending order."
- (let [(^open) &;Functor<List>
- indices (&;indices size)]
- (and (n.= size (&;size indices))
- (= indices
- (&;sort n.< indices))
- (&;every? (n.= (n.dec size))
- (&;zip2-with n.+
- indices
- (&;sort n.> indices)))
- )))
-
- (test "The 'interpose' function places a value between every member of a list."
- (let [(^open) &;Functor<List>
- sample+ (&;interpose separator sample)]
- (and (n.= (|> size (n.* +2) n.dec)
- (&;size sample+))
- (|> sample+ &;as-pairs (map product;right) (&;every? (n.= separator))))))
-
- (test "List append is a monoid."
- (let [(^open) &;Monoid<List>]
- (and (= sample (compose identity sample))
- (= sample (compose sample identity))
- (let [[left right] (&;split size (compose sample other-sample))]
- (and (= sample left)
- (= other-sample right))))))
-
- (test "Applicative allows you to create singleton lists, and apply lists of functions to lists of values."
- (let [(^open) &;Applicative<List>]
- (and (= (list separator) (wrap separator))
- (= (map n.inc sample)
- (apply (wrap n.inc) sample)))))
-
- (test "List concatenation is a monad."
- (let [(^open) &;Monad<List>
- (^open) &;Monoid<List>]
- (= (compose sample other-sample)
- (join (list sample other-sample)))))
-
- (test "You can find any value that satisfies some criterium, if such values exist in the list."
- (case (&;find n.even? sample)
- (#;Some found)
- (and (n.even? found)
- (&;any? n.even? sample)
- (not (&;every? (bool;complement n.even?) sample)))
-
- #;None
- (and (not (&;any? n.even? sample))
- (&;every? (bool;complement n.even?) sample))))
-
- (test "You can iteratively construct a list, generating values until you're done."
- (= (&;n.range +0 (n.dec size))
- (&;iterate (function [n] (if (n.< size n) (#;Some (n.inc n)) #;None))
- +0)))
-
- (test "Can enumerate all elements in a list."
- (let [enum-sample (&;enumerate sample)]
- (and (= (&;indices (&;size enum-sample))
- (&/map product;left enum-sample))
- (= sample
- (&/map product;right enum-sample)))))
- ))
+ (<| (times +100)
+ (do @
+ [size bounded-size
+ idx (:: @ map (n.% size) r;nat)
+ sample (r;list size r;nat)
+ other-size bounded-size
+ other-sample (r;list other-size r;nat)
+ separator r;nat
+ #let [(^open) (&;Eq<List> number;Eq<Nat>)
+ (^open "&/") &;Functor<List>]]
+ ($_ seq
+ (test "If you zip 2 lists, the result's size will be that of the smaller list."
+ (n.= (&;size (&;zip2 sample other-sample))
+ (n.min (&;size sample) (&;size other-sample))))
+
+ (test "I can pair-up elements of a list in order."
+ (let [(^open) &;Functor<List>
+ zipped (&;zip2 sample other-sample)
+ num-zipper (&;size zipped)]
+ (and (|> zipped (map product;left) (= (&;take num-zipper sample)))
+ (|> zipped (map product;right) (= (&;take num-zipper other-sample))))))
+
+ (test "You can generate indices for any size, and they will be in ascending order."
+ (let [(^open) &;Functor<List>
+ indices (&;indices size)]
+ (and (n.= size (&;size indices))
+ (= indices
+ (&;sort n.< indices))
+ (&;every? (n.= (n.dec size))
+ (&;zip2-with n.+
+ indices
+ (&;sort n.> indices)))
+ )))
+
+ (test "The 'interpose' function places a value between every member of a list."
+ (let [(^open) &;Functor<List>
+ sample+ (&;interpose separator sample)]
+ (and (n.= (|> size (n.* +2) n.dec)
+ (&;size sample+))
+ (|> sample+ &;as-pairs (map product;right) (&;every? (n.= separator))))))
+
+ (test "List append is a monoid."
+ (let [(^open) &;Monoid<List>]
+ (and (= sample (compose identity sample))
+ (= sample (compose sample identity))
+ (let [[left right] (&;split size (compose sample other-sample))]
+ (and (= sample left)
+ (= other-sample right))))))
+
+ (test "Applicative allows you to create singleton lists, and apply lists of functions to lists of values."
+ (let [(^open) &;Applicative<List>]
+ (and (= (list separator) (wrap separator))
+ (= (map n.inc sample)
+ (apply (wrap n.inc) sample)))))
+
+ (test "List concatenation is a monad."
+ (let [(^open) &;Monad<List>
+ (^open) &;Monoid<List>]
+ (= (compose sample other-sample)
+ (join (list sample other-sample)))))
+
+ (test "You can find any value that satisfies some criterium, if such values exist in the list."
+ (case (&;find n.even? sample)
+ (#;Some found)
+ (and (n.even? found)
+ (&;any? n.even? sample)
+ (not (&;every? (bool;complement n.even?) sample)))
+
+ #;None
+ (and (not (&;any? n.even? sample))
+ (&;every? (bool;complement n.even?) sample))))
+
+ (test "You can iteratively construct a list, generating values until you're done."
+ (= (&;n.range +0 (n.dec size))
+ (&;iterate (function [n] (if (n.< size n) (#;Some (n.inc n)) #;None))
+ +0)))
+
+ (test "Can enumerate all elements in a list."
+ (let [enum-sample (&;enumerate sample)]
+ (and (= (&;indices (&;size enum-sample))
+ (&/map product;left enum-sample))
+ (= sample
+ (&/map product;right enum-sample)))))
+ ))))
(context: "Monad transformer"
(let [lift (&;lift io;Monad<IO>)
diff --git a/stdlib/test/test/lux/data/coll/ordered/dict.lux b/stdlib/test/test/lux/data/coll/ordered/dict.lux
index e2c0d3b7d..49e4f2678 100644
--- a/stdlib/test/test/lux/data/coll/ordered/dict.lux
+++ b/stdlib/test/test/lux/data/coll/ordered/dict.lux
@@ -13,74 +13,76 @@
lux/test)
(context: "Dict"
- [size (|> r;nat (:: @ map (n.% +100)))
- keys (r;set number;Hash<Nat> size r;nat)
- values (r;set number;Hash<Nat> size r;nat)
- extra-key (|> r;nat (r;filter (|>. (s;member? keys) not)))
- extra-value r;nat
- #let [pairs (list;zip2 (s;to-list keys)
- (s;to-list values))
- sample (&;from-list number;Order<Nat> pairs)
- sorted-pairs (list;sort (function [[left _] [right _]]
- (n.< left right))
- pairs)
- sorted-values (L/map product;right sorted-pairs)
- (^open "&/") (&;Eq<Dict> number;Eq<Nat>)]]
- ($_ seq
- (test "Can query the size of a dictionary."
- (n.= size (&;size sample)))
+ (<| (times +100)
+ (do @
+ [size (|> r;nat (:: @ map (n.% +100)))
+ keys (r;set number;Hash<Nat> size r;nat)
+ values (r;set number;Hash<Nat> size r;nat)
+ extra-key (|> r;nat (r;filter (|>. (s;member? keys) not)))
+ extra-value r;nat
+ #let [pairs (list;zip2 (s;to-list keys)
+ (s;to-list values))
+ sample (&;from-list number;Order<Nat> pairs)
+ sorted-pairs (list;sort (function [[left _] [right _]]
+ (n.< left right))
+ pairs)
+ sorted-values (L/map product;right sorted-pairs)
+ (^open "&/") (&;Eq<Dict> number;Eq<Nat>)]]
+ ($_ seq
+ (test "Can query the size of a dictionary."
+ (n.= size (&;size sample)))
- (test "Can query value for minimum key."
- (case [(&;min sample) (list;head sorted-values)]
- [#;None #;None]
- true
+ (test "Can query value for minimum key."
+ (case [(&;min sample) (list;head sorted-values)]
+ [#;None #;None]
+ true
- [(#;Some reference) (#;Some sample)]
- (n.= reference sample)
+ [(#;Some reference) (#;Some sample)]
+ (n.= reference sample)
- _
- false))
+ _
+ false))
- (test "Can query value for maximum key."
- (case [(&;max sample) (list;last sorted-values)]
- [#;None #;None]
- true
+ (test "Can query value for maximum key."
+ (case [(&;max sample) (list;last sorted-values)]
+ [#;None #;None]
+ true
- [(#;Some reference) (#;Some sample)]
- (n.= reference sample)
+ [(#;Some reference) (#;Some sample)]
+ (n.= reference sample)
- _
- false))
+ _
+ false))
- (test "Converting dictionaries to/from lists cannot change their values."
- (|> sample
- &;entries (&;from-list number;Order<Nat>)
- (&/= sample)))
+ (test "Converting dictionaries to/from lists cannot change their values."
+ (|> sample
+ &;entries (&;from-list number;Order<Nat>)
+ (&/= sample)))
- (test "Order is preserved."
- (let [(^open "L/") (list;Eq<List> (: (Eq [Nat Nat])
- (function [[kr vr] [ks vs]]
- (and (n.= kr ks)
- (n.= vr vs)))))]
- (L/= (&;entries sample)
- sorted-pairs)))
+ (test "Order is preserved."
+ (let [(^open "L/") (list;Eq<List> (: (Eq [Nat Nat])
+ (function [[kr vr] [ks vs]]
+ (and (n.= kr ks)
+ (n.= vr vs)))))]
+ (L/= (&;entries sample)
+ sorted-pairs)))
- (test "Every key in a dictionary must be identifiable."
- (list;every? (function [key] (&;contains? key sample))
- (&;keys sample)))
+ (test "Every key in a dictionary must be identifiable."
+ (list;every? (function [key] (&;contains? key sample))
+ (&;keys sample)))
- (test "Can add and remove elements in a dictionary."
- (and (not (&;contains? extra-key sample))
- (let [sample' (&;put extra-key extra-value sample)
- sample'' (&;remove extra-key sample')]
- (and (&;contains? extra-key sample')
- (not (&;contains? extra-key sample''))
- (case [(&;get extra-key sample')
- (&;get extra-key sample'')]
- [(#;Some found) #;None]
- (n.= extra-value found)
+ (test "Can add and remove elements in a dictionary."
+ (and (not (&;contains? extra-key sample))
+ (let [sample' (&;put extra-key extra-value sample)
+ sample'' (&;remove extra-key sample')]
+ (and (&;contains? extra-key sample')
+ (not (&;contains? extra-key sample''))
+ (case [(&;get extra-key sample')
+ (&;get extra-key sample'')]
+ [(#;Some found) #;None]
+ (n.= extra-value found)
- _
- false)))
- ))
- ))
+ _
+ false)))
+ ))
+ ))))
diff --git a/stdlib/test/test/lux/data/coll/ordered/set.lux b/stdlib/test/test/lux/data/coll/ordered/set.lux
index 937d54aa7..f01db29a5 100644
--- a/stdlib/test/test/lux/data/coll/ordered/set.lux
+++ b/stdlib/test/test/lux/data/coll/ordered/set.lux
@@ -16,77 +16,79 @@
(:: r;Monad<Random> map (n.% +100))))
(context: "Sets"
- [sizeL gen-nat
- sizeR gen-nat
- listL (|> (r;set number;Hash<Nat> sizeL gen-nat) (:: @ map s;to-list))
- listR (|> (r;set number;Hash<Nat> sizeR gen-nat) (:: @ map s;to-list))
- #let [(^open "&/") &;Eq<Set>
- setL (&;from-list number;Order<Nat> listL)
- setR (&;from-list number;Order<Nat> listR)
- sortedL (list;sort n.< listL)
- minL (list;head sortedL)
- maxL (list;last sortedL)]]
- ($_ seq
- (test "I can query the size of a set."
- (n.= sizeL (&;size setL)))
-
- (test "Can query minimum value."
- (case [(&;min setL) minL]
- [#;None #;None]
- true
-
- [(#;Some reference) (#;Some sample)]
- (n.= reference sample)
-
- _
- false))
-
- (test "Can query maximum value."
- (case [(&;max setL) maxL]
- [#;None #;None]
- true
-
- [(#;Some reference) (#;Some sample)]
- (n.= reference sample)
-
- _
- false))
-
- (test "Converting sets to/from lists can't change their values."
- (|> setL
- &;to-list (&;from-list number;Order<Nat>)
- (&/= setL)))
-
- (test "Order is preserved."
- (let [listL (&;to-list setL)
- (^open "L/") (list;Eq<List> number;Eq<Nat>)]
- (L/= listL
- (list;sort n.< listL))))
-
- (test "Every set is a sub-set of the union of itself with another."
- (let [setLR (&;union setL setR)]
- (and (&;sub? setLR setL)
- (&;sub? setLR setR))))
-
- (test "Every set is a super-set of the intersection of itself with another."
- (let [setLR (&;intersection setL setR)]
- (and (&;super? setLR setL)
- (&;super? setLR setR))))
-
- (test "Union with the empty set leaves a set unchanged."
- (&/= setL
- (&;union (&;new number;Order<Nat>)
- setL)))
-
- (test "Intersection with the empty set results in the empty set."
- (let [empty-set (&;new number;Order<Nat>)]
- (&/= empty-set
- (&;intersection empty-set setL))))
-
- (test "After substracting a set A from another B, no member of A can be a member of B."
- (let [sub (&;difference setR setL)]
- (not (list;any? (&;member? sub) (&;to-list setR)))))
-
- (test "Every member of a set must be identifiable."
- (list;every? (&;member? setL) (&;to-list setL)))
- ))
+ (<| (times +100)
+ (do @
+ [sizeL gen-nat
+ sizeR gen-nat
+ listL (|> (r;set number;Hash<Nat> sizeL gen-nat) (:: @ map s;to-list))
+ listR (|> (r;set number;Hash<Nat> sizeR gen-nat) (:: @ map s;to-list))
+ #let [(^open "&/") &;Eq<Set>
+ setL (&;from-list number;Order<Nat> listL)
+ setR (&;from-list number;Order<Nat> listR)
+ sortedL (list;sort n.< listL)
+ minL (list;head sortedL)
+ maxL (list;last sortedL)]]
+ ($_ seq
+ (test "I can query the size of a set."
+ (n.= sizeL (&;size setL)))
+
+ (test "Can query minimum value."
+ (case [(&;min setL) minL]
+ [#;None #;None]
+ true
+
+ [(#;Some reference) (#;Some sample)]
+ (n.= reference sample)
+
+ _
+ false))
+
+ (test "Can query maximum value."
+ (case [(&;max setL) maxL]
+ [#;None #;None]
+ true
+
+ [(#;Some reference) (#;Some sample)]
+ (n.= reference sample)
+
+ _
+ false))
+
+ (test "Converting sets to/from lists can't change their values."
+ (|> setL
+ &;to-list (&;from-list number;Order<Nat>)
+ (&/= setL)))
+
+ (test "Order is preserved."
+ (let [listL (&;to-list setL)
+ (^open "L/") (list;Eq<List> number;Eq<Nat>)]
+ (L/= listL
+ (list;sort n.< listL))))
+
+ (test "Every set is a sub-set of the union of itself with another."
+ (let [setLR (&;union setL setR)]
+ (and (&;sub? setLR setL)
+ (&;sub? setLR setR))))
+
+ (test "Every set is a super-set of the intersection of itself with another."
+ (let [setLR (&;intersection setL setR)]
+ (and (&;super? setLR setL)
+ (&;super? setLR setR))))
+
+ (test "Union with the empty set leaves a set unchanged."
+ (&/= setL
+ (&;union (&;new number;Order<Nat>)
+ setL)))
+
+ (test "Intersection with the empty set results in the empty set."
+ (let [empty-set (&;new number;Order<Nat>)]
+ (&/= empty-set
+ (&;intersection empty-set setL))))
+
+ (test "After substracting a set A from another B, no member of A can be a member of B."
+ (let [sub (&;difference setR setL)]
+ (not (list;any? (&;member? sub) (&;to-list setR)))))
+
+ (test "Every member of a set must be identifiable."
+ (list;every? (&;member? setL) (&;to-list setL)))
+ ))))
diff --git a/stdlib/test/test/lux/data/coll/priority-queue.lux b/stdlib/test/test/lux/data/coll/priority-queue.lux
index 07a2200a3..7a3d5a659 100644
--- a/stdlib/test/test/lux/data/coll/priority-queue.lux
+++ b/stdlib/test/test/lux/data/coll/priority-queue.lux
@@ -20,31 +20,33 @@
inputs)))
(context: "Queues"
- [size (|> r;nat (:: @ map (n.% +100)))
- sample (gen-queue size)
- non-member-priority r;nat
- non-member (|> r;nat (r;filter (|>. (&;member? number;Eq<Nat> sample) not)))]
- ($_ seq
- (test "I can query the size of a queue (and empty queues have size 0)."
- (n.= size (&;size sample)))
+ (<| (times +100)
+ (do @
+ [size (|> r;nat (:: @ map (n.% +100)))
+ sample (gen-queue size)
+ non-member-priority r;nat
+ non-member (|> r;nat (r;filter (|>. (&;member? number;Eq<Nat> sample) not)))]
+ ($_ seq
+ (test "I can query the size of a queue (and empty queues have size 0)."
+ (n.= size (&;size sample)))
- (test "Enqueueing and dequeing affects the size of queues."
- (and (n.= (n.inc size)
- (&;size (&;push non-member-priority non-member sample)))
- (or (n.= +0 (&;size sample))
- (n.= (n.dec size)
- (&;size (&;pop sample))))))
+ (test "Enqueueing and dequeing affects the size of queues."
+ (and (n.= (n.inc size)
+ (&;size (&;push non-member-priority non-member sample)))
+ (or (n.= +0 (&;size sample))
+ (n.= (n.dec size)
+ (&;size (&;pop sample))))))
- (test "I can query whether an element belongs to a queue."
- (and (and (not (&;member? number;Eq<Nat> sample non-member))
- (&;member? number;Eq<Nat>
- (&;push non-member-priority non-member sample)
- non-member))
- (or (n.= +0 (&;size sample))
- (and (&;member? number;Eq<Nat>
- sample
- (maybe;assume (&;peek sample)))
- (not (&;member? number;Eq<Nat>
- (&;pop sample)
- (maybe;assume (&;peek sample))))))))
- ))
+ (test "I can query whether an element belongs to a queue."
+ (and (and (not (&;member? number;Eq<Nat> sample non-member))
+ (&;member? number;Eq<Nat>
+ (&;push non-member-priority non-member sample)
+ non-member))
+ (or (n.= +0 (&;size sample))
+ (and (&;member? number;Eq<Nat>
+ sample
+ (maybe;assume (&;peek sample)))
+ (not (&;member? number;Eq<Nat>
+ (&;pop sample)
+ (maybe;assume (&;peek sample))))))))
+ ))))
diff --git a/stdlib/test/test/lux/data/coll/queue.lux b/stdlib/test/test/lux/data/coll/queue.lux
index ddccc282b..bf04cd90c 100644
--- a/stdlib/test/test/lux/data/coll/queue.lux
+++ b/stdlib/test/test/lux/data/coll/queue.lux
@@ -8,42 +8,44 @@
lux/test)
(context: "Queues"
- [size (:: @ map (n.% +100) r;nat)
- sample (r;queue size r;nat)
- non-member (|> r;nat
- (r;filter (. not (&;member? number;Eq<Nat> sample))))]
- ($_ seq
- (test "I can query the size of a queue (and empty queues have size 0)."
- (if (n.= +0 size)
- (&;empty? sample)
- (n.= size (&;size sample))))
+ (<| (times +100)
+ (do @
+ [size (:: @ map (n.% +100) r;nat)
+ sample (r;queue size r;nat)
+ non-member (|> r;nat
+ (r;filter (. not (&;member? number;Eq<Nat> sample))))]
+ ($_ seq
+ (test "I can query the size of a queue (and empty queues have size 0)."
+ (if (n.= +0 size)
+ (&;empty? sample)
+ (n.= size (&;size sample))))
- (test "Enqueueing and dequeing affects the size of queues."
- (and (n.= (n.inc size) (&;size (&;push non-member sample)))
- (or (&;empty? sample)
- (n.= (n.dec size) (&;size (&;pop sample))))
- (n.= size (&;size (&;pop (&;push non-member sample))))))
+ (test "Enqueueing and dequeing affects the size of queues."
+ (and (n.= (n.inc size) (&;size (&;push non-member sample)))
+ (or (&;empty? sample)
+ (n.= (n.dec size) (&;size (&;pop sample))))
+ (n.= size (&;size (&;pop (&;push non-member sample))))))
- (test "Transforming to/from list can't change the queue."
- (let [(^open "&/") (&;Eq<Queue> number;Eq<Nat>)]
- (|> sample
- &;to-list &;from-list
- (&/= sample))))
+ (test "Transforming to/from list can't change the queue."
+ (let [(^open "&/") (&;Eq<Queue> number;Eq<Nat>)]
+ (|> sample
+ &;to-list &;from-list
+ (&/= sample))))
- (test "I can always peek at a non-empty queue."
- (case (&;peek sample)
- #;None (&;empty? sample)
- (#;Some _) true))
+ (test "I can always peek at a non-empty queue."
+ (case (&;peek sample)
+ #;None (&;empty? sample)
+ (#;Some _) true))
- (test "I can query whether an element belongs to a queue."
- (and (not (&;member? number;Eq<Nat> sample non-member))
- (&;member? number;Eq<Nat> (&;push non-member sample)
- non-member)
- (case (&;peek sample)
- #;None
- (&;empty? sample)
-
- (#;Some first)
- (and (&;member? number;Eq<Nat> sample first)
- (not (&;member? number;Eq<Nat> (&;pop sample) first))))))
- ))
+ (test "I can query whether an element belongs to a queue."
+ (and (not (&;member? number;Eq<Nat> sample non-member))
+ (&;member? number;Eq<Nat> (&;push non-member sample)
+ non-member)
+ (case (&;peek sample)
+ #;None
+ (&;empty? sample)
+
+ (#;Some first)
+ (and (&;member? number;Eq<Nat> sample first)
+ (not (&;member? number;Eq<Nat> (&;pop sample) first))))))
+ ))))
diff --git a/stdlib/test/test/lux/data/coll/sequence.lux b/stdlib/test/test/lux/data/coll/sequence.lux
index 596805d51..f52cb3abf 100644
--- a/stdlib/test/test/lux/data/coll/sequence.lux
+++ b/stdlib/test/test/lux/data/coll/sequence.lux
@@ -12,61 +12,63 @@
lux/test)
(context: "Sequences"
- [size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +1))))
- idx (|> r;nat (:: @ map (n.% size)))
- sample (r;sequence size r;nat)
- other-sample (r;sequence size r;nat)
- non-member (|> r;nat (r;filter (. not (&;member? number;Eq<Nat> sample))))
- #let [(^open "&/") (&;Eq<Sequence> number;Eq<Nat>)
- (^open "&/") &;Monad<Sequence>
- (^open "&/") &;Fold<Sequence>
- (^open "&/") &;Monoid<Sequence>]]
- ($_ seq
- (test "Can query size of sequence."
- (if (&;empty? sample)
- (and (n.= +0 size)
- (n.= +0 (&;size sample)))
- (n.= size (&;size sample))))
+ (<| (times +100)
+ (do @
+ [size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +1))))
+ idx (|> r;nat (:: @ map (n.% size)))
+ sample (r;sequence size r;nat)
+ other-sample (r;sequence size r;nat)
+ non-member (|> r;nat (r;filter (. not (&;member? number;Eq<Nat> sample))))
+ #let [(^open "&/") (&;Eq<Sequence> number;Eq<Nat>)
+ (^open "&/") &;Monad<Sequence>
+ (^open "&/") &;Fold<Sequence>
+ (^open "&/") &;Monoid<Sequence>]]
+ ($_ seq
+ (test "Can query size of sequence."
+ (if (&;empty? sample)
+ (and (n.= +0 size)
+ (n.= +0 (&;size sample)))
+ (n.= size (&;size sample))))
- (test "Can add and remove elements to sequences."
- (and (n.= (n.inc size) (&;size (&;add non-member sample)))
- (n.= (n.dec size) (&;size (&;pop sample)))))
+ (test "Can add and remove elements to sequences."
+ (and (n.= (n.inc size) (&;size (&;add non-member sample)))
+ (n.= (n.dec size) (&;size (&;pop sample)))))
- (test "Can put and get elements into sequences."
- (|> sample
- (&;put idx non-member)
- (&;nth idx)
- maybe;assume
- (is non-member)))
+ (test "Can put and get elements into sequences."
+ (|> sample
+ (&;put idx non-member)
+ (&;nth idx)
+ maybe;assume
+ (is non-member)))
- (test "Can update elements of sequences."
- (|> sample
- (&;put idx non-member) (&;update idx n.inc)
- (&;nth idx) maybe;assume
- (n.= (n.inc non-member))))
+ (test "Can update elements of sequences."
+ (|> sample
+ (&;put idx non-member) (&;update idx n.inc)
+ (&;nth idx) maybe;assume
+ (n.= (n.inc non-member))))
- (test "Can safely transform to/from lists."
- (|> sample &;to-list &;from-list (&/= sample)))
+ (test "Can safely transform to/from lists."
+ (|> sample &;to-list &;from-list (&/= sample)))
- (test "Can identify members of a sequence."
- (and (not (&;member? number;Eq<Nat> sample non-member))
- (&;member? number;Eq<Nat> (&;add non-member sample) non-member)))
+ (test "Can identify members of a sequence."
+ (and (not (&;member? number;Eq<Nat> sample non-member))
+ (&;member? number;Eq<Nat> (&;add non-member sample) non-member)))
- (test "Can fold over elements of sequence."
- (n.= (List/fold n.+ +0 (&;to-list sample))
- (&/fold n.+ +0 sample)))
-
- (test "Functor goes over every element."
- (let [there (&/map n.inc sample)
- back-again (&/map n.dec there)]
- (and (not (&/= sample there))
- (&/= sample back-again))))
+ (test "Can fold over elements of sequence."
+ (n.= (List/fold n.+ +0 (&;to-list sample))
+ (&/fold n.+ +0 sample)))
+
+ (test "Functor goes over every element."
+ (let [there (&/map n.inc sample)
+ back-again (&/map n.dec there)]
+ (and (not (&/= sample there))
+ (&/= sample back-again))))
- (test "Applicative allows you to create singleton sequences, and apply sequences of functions to sequences of values."
- (and (&/= (&;sequence non-member) (&/wrap non-member))
- (&/= (&/map n.inc sample) (&/apply (&/wrap n.inc) sample))))
+ (test "Applicative allows you to create singleton sequences, and apply sequences of functions to sequences of values."
+ (and (&/= (&;sequence non-member) (&/wrap non-member))
+ (&/= (&/map n.inc sample) (&/apply (&/wrap n.inc) sample))))
- (test "Sequence concatenation is a monad."
- (&/= (&/compose sample other-sample)
- (&/join (&;sequence sample other-sample))))
- ))
+ (test "Sequence concatenation is a monad."
+ (&/= (&/compose sample other-sample)
+ (&/join (&;sequence sample other-sample))))
+ ))))
diff --git a/stdlib/test/test/lux/data/coll/set.lux b/stdlib/test/test/lux/data/coll/set.lux
index 38ca47f81..c13f60f25 100644
--- a/stdlib/test/test/lux/data/coll/set.lux
+++ b/stdlib/test/test/lux/data/coll/set.lux
@@ -14,49 +14,51 @@
(:: r;Monad<Random> map (n.% +100))))
(context: "Sets"
- [sizeL gen-nat
- sizeR gen-nat
- setL (r;set number;Hash<Nat> sizeL gen-nat)
- setR (r;set number;Hash<Nat> sizeR gen-nat)
- non-member (|> gen-nat
- (r;filter (. not (&;member? setL))))
- #let [(^open "&/") &;Eq<Set>]]
- ($_ seq
- (test "I can query the size of a set."
- (and (n.= sizeL (&;size setL))
- (n.= sizeR (&;size setR))))
-
- (test "Converting sets to/from lists can't change their values."
- (|> setL
- &;to-list (&;from-list number;Hash<Nat>)
- (&/= setL)))
-
- (test "Every set is a sub-set of the union of itself with another."
- (let [setLR (&;union setL setR)]
- (and (&;sub? setLR setL)
- (&;sub? setLR setR))))
-
- (test "Every set is a super-set of the intersection of itself with another."
- (let [setLR (&;intersection setL setR)]
- (and (&;super? setLR setL)
- (&;super? setLR setR))))
-
- (test "Union with the empty set leaves a set unchanged."
- (&/= setL
- (&;union (&;new number;Hash<Nat>)
- setL)))
-
- (test "Intersection with the empty set results in the empty set."
- (let [empty-set (&;new number;Hash<Nat>)]
- (&/= empty-set
- (&;intersection empty-set setL))))
-
- (test "After substracting a set A from another B, no member of A can be a member of B."
- (let [sub (&;difference setR setL)]
- (not (list;any? (&;member? sub) (&;to-list setR)))))
-
- (test "Every member of a set must be identifiable."
- (and (not (&;member? setL non-member))
- (&;member? (&;add non-member setL) non-member)
- (not (&;member? (&;remove non-member (&;add non-member setL)) non-member))))
- ))
+ (<| (times +100)
+ (do @
+ [sizeL gen-nat
+ sizeR gen-nat
+ setL (r;set number;Hash<Nat> sizeL gen-nat)
+ setR (r;set number;Hash<Nat> sizeR gen-nat)
+ non-member (|> gen-nat
+ (r;filter (. not (&;member? setL))))
+ #let [(^open "&/") &;Eq<Set>]]
+ ($_ seq
+ (test "I can query the size of a set."
+ (and (n.= sizeL (&;size setL))
+ (n.= sizeR (&;size setR))))
+
+ (test "Converting sets to/from lists can't change their values."
+ (|> setL
+ &;to-list (&;from-list number;Hash<Nat>)
+ (&/= setL)))
+
+ (test "Every set is a sub-set of the union of itself with another."
+ (let [setLR (&;union setL setR)]
+ (and (&;sub? setLR setL)
+ (&;sub? setLR setR))))
+
+ (test "Every set is a super-set of the intersection of itself with another."
+ (let [setLR (&;intersection setL setR)]
+ (and (&;super? setLR setL)
+ (&;super? setLR setR))))
+
+ (test "Union with the empty set leaves a set unchanged."
+ (&/= setL
+ (&;union (&;new number;Hash<Nat>)
+ setL)))
+
+ (test "Intersection with the empty set results in the empty set."
+ (let [empty-set (&;new number;Hash<Nat>)]
+ (&/= empty-set
+ (&;intersection empty-set setL))))
+
+ (test "After substracting a set A from another B, no member of A can be a member of B."
+ (let [sub (&;difference setR setL)]
+ (not (list;any? (&;member? sub) (&;to-list setR)))))
+
+ (test "Every member of a set must be identifiable."
+ (and (not (&;member? setL non-member))
+ (&;member? (&;add non-member setL) non-member)
+ (not (&;member? (&;remove non-member (&;add non-member setL)) non-member))))
+ ))))
diff --git a/stdlib/test/test/lux/data/coll/stack.lux b/stdlib/test/test/lux/data/coll/stack.lux
index fc7e2f4b2..069a9258b 100644
--- a/stdlib/test/test/lux/data/coll/stack.lux
+++ b/stdlib/test/test/lux/data/coll/stack.lux
@@ -15,29 +15,31 @@
(:: r;Monad<Random> map (n.% +100))))
(context: "Stacks"
- [size gen-nat
- sample (r;stack size gen-nat)
- new-top gen-nat]
- ($_ seq
- (test "Can query the size of a stack."
- (n.= size (&;size sample)))
+ (<| (times +100)
+ (do @
+ [size gen-nat
+ sample (r;stack size gen-nat)
+ new-top gen-nat]
+ ($_ seq
+ (test "Can query the size of a stack."
+ (n.= size (&;size sample)))
- (test "Can peek inside non-empty stacks."
- (case (&;peek sample)
- #;None (&;empty? sample)
- (#;Some _) (not (&;empty? sample))))
+ (test "Can peek inside non-empty stacks."
+ (case (&;peek sample)
+ #;None (&;empty? sample)
+ (#;Some _) (not (&;empty? sample))))
- (test "Popping empty stacks doesn't change anything.
+ (test "Popping empty stacks doesn't change anything.
But, if they're non-empty, the top of the stack is removed."
- (let [sample' (&;pop sample)]
- (or (n.= (&;size sample) (n.inc (&;size sample')))
- (and (&;empty? sample) (&;empty? sample')))
- ))
+ (let [sample' (&;pop sample)]
+ (or (n.= (&;size sample) (n.inc (&;size sample')))
+ (and (&;empty? sample) (&;empty? sample')))
+ ))
- (test "Pushing onto a stack always increases it by 1, adding a new value at the top."
- (and (is sample
- (&;pop (&;push new-top sample)))
- (n.= (n.inc (&;size sample)) (&;size (&;push new-top sample)))
- (|> (&;push new-top sample) &;peek maybe;assume
- (is new-top))))
- ))
+ (test "Pushing onto a stack always increases it by 1, adding a new value at the top."
+ (and (is sample
+ (&;pop (&;push new-top sample)))
+ (n.= (n.inc (&;size sample)) (&;size (&;push new-top sample)))
+ (|> (&;push new-top sample) &;peek maybe;assume
+ (is new-top))))
+ ))))
diff --git a/stdlib/test/test/lux/data/coll/stream.lux b/stdlib/test/test/lux/data/coll/stream.lux
index a5a978f49..fdb7965b2 100644
--- a/stdlib/test/test/lux/data/coll/stream.lux
+++ b/stdlib/test/test/lux/data/coll/stream.lux
@@ -14,87 +14,89 @@
lux/test)
(context: "Streams"
- [size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +2))))
- offset (|> r;nat (:: @ map (n.% +100)))
- factor (|> r;nat (:: @ map (|>. (n.% +100) (n.max +2))))
- elem r;nat
- cycle-seed (r;list size r;nat)
- cycle-sample-idx (|> r;nat (:: @ map (n.% +1000)))
- #let [(^open "List/") (list;Eq<List> number;Eq<Nat>)
- sample0 (&;iterate n.inc +0)
- sample1 (&;iterate n.inc offset)]]
- ($_ seq
- (test "Can move along a stream and take slices off it."
- (and (and (List/= (list;n.range +0 (n.dec size))
- (&;take size sample0))
- (List/= (list;n.range offset (n.dec (n.+ offset size)))
- (&;take size (&;drop offset sample0)))
- (let [[drops takes...] (&;split size sample0)]
- (and (List/= (list;n.range +0 (n.dec size))
- drops)
- (List/= (list;n.range size (n.dec (n.* +2 size)))
- (&;take size takes...)))))
- (and (List/= (list;n.range +0 (n.dec size))
- (&;take-while (n.< size) sample0))
- (List/= (list;n.range offset (n.dec (n.+ offset size)))
- (&;take-while (n.< (n.+ offset size))
- (&;drop-while (n.< offset) sample0)))
- (let [[drops takes...] (&;split-while (n.< size) sample0)]
- (and (List/= (list;n.range +0 (n.dec size))
- drops)
- (List/= (list;n.range size (n.dec (n.* +2 size)))
- (&;take-while (n.< (n.* +2 size)) takes...)))))
- ))
+ (<| (times +100)
+ (do @
+ [size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +2))))
+ offset (|> r;nat (:: @ map (n.% +100)))
+ factor (|> r;nat (:: @ map (|>. (n.% +100) (n.max +2))))
+ elem r;nat
+ cycle-seed (r;list size r;nat)
+ cycle-sample-idx (|> r;nat (:: @ map (n.% +1000)))
+ #let [(^open "List/") (list;Eq<List> number;Eq<Nat>)
+ sample0 (&;iterate n.inc +0)
+ sample1 (&;iterate n.inc offset)]]
+ ($_ seq
+ (test "Can move along a stream and take slices off it."
+ (and (and (List/= (list;n.range +0 (n.dec size))
+ (&;take size sample0))
+ (List/= (list;n.range offset (n.dec (n.+ offset size)))
+ (&;take size (&;drop offset sample0)))
+ (let [[drops takes...] (&;split size sample0)]
+ (and (List/= (list;n.range +0 (n.dec size))
+ drops)
+ (List/= (list;n.range size (n.dec (n.* +2 size)))
+ (&;take size takes...)))))
+ (and (List/= (list;n.range +0 (n.dec size))
+ (&;take-while (n.< size) sample0))
+ (List/= (list;n.range offset (n.dec (n.+ offset size)))
+ (&;take-while (n.< (n.+ offset size))
+ (&;drop-while (n.< offset) sample0)))
+ (let [[drops takes...] (&;split-while (n.< size) sample0)]
+ (and (List/= (list;n.range +0 (n.dec size))
+ drops)
+ (List/= (list;n.range size (n.dec (n.* +2 size)))
+ (&;take-while (n.< (n.* +2 size)) takes...)))))
+ ))
- (test "Can repeat any element and infinite number of times."
- (n.= elem (&;nth offset (&;repeat elem))))
+ (test "Can repeat any element and infinite number of times."
+ (n.= elem (&;nth offset (&;repeat elem))))
- (test "Can obtain the head & tail of a stream."
- (and (n.= offset (&;head sample1))
- (List/= (list;n.range (n.inc offset) (n.+ offset size))
- (&;take size (&;tail sample1)))))
+ (test "Can obtain the head & tail of a stream."
+ (and (n.= offset (&;head sample1))
+ (List/= (list;n.range (n.inc offset) (n.+ offset size))
+ (&;take size (&;tail sample1)))))
- (test "Can filter streams."
- (and (n.= (n.* +2 offset)
- (&;nth offset
- (&;filter n.even? sample0)))
- (let [[evens odds] (&;partition n.even? (&;iterate n.inc +0))]
- (and (n.= (n.* +2 offset)
- (&;nth offset evens))
- (n.= (n.inc (n.* +2 offset))
- (&;nth offset odds))))))
+ (test "Can filter streams."
+ (and (n.= (n.* +2 offset)
+ (&;nth offset
+ (&;filter n.even? sample0)))
+ (let [[evens odds] (&;partition n.even? (&;iterate n.inc +0))]
+ (and (n.= (n.* +2 offset)
+ (&;nth offset evens))
+ (n.= (n.inc (n.* +2 offset))
+ (&;nth offset odds))))))
- (test "Functor goes over 'all' elements in a stream."
- (let [(^open "&/") &;Functor<Stream>
- there (&/map (n.* factor) sample0)
- back-again (&/map (n./ factor) there)]
- (and (not (List/= (&;take size sample0)
- (&;take size there)))
- (List/= (&;take size sample0)
- (&;take size back-again)))))
+ (test "Functor goes over 'all' elements in a stream."
+ (let [(^open "&/") &;Functor<Stream>
+ there (&/map (n.* factor) sample0)
+ back-again (&/map (n./ factor) there)]
+ (and (not (List/= (&;take size sample0)
+ (&;take size there)))
+ (List/= (&;take size sample0)
+ (&;take size back-again)))))
- (test "CoMonad produces a value for every element in a stream."
- (let [(^open "&/") &;Functor<Stream>]
- (List/= (&;take size (&/map (n.* factor) sample1))
- (&;take size
- (be &;CoMonad<Stream>
- [inputs sample1]
- (n.* factor (&;head inputs)))))))
+ (test "CoMonad produces a value for every element in a stream."
+ (let [(^open "&/") &;Functor<Stream>]
+ (List/= (&;take size (&/map (n.* factor) sample1))
+ (&;take size
+ (be &;CoMonad<Stream>
+ [inputs sample1]
+ (n.* factor (&;head inputs)))))))
- (test "'unfold' generalizes 'iterate'."
- (let [(^open "&/") &;Functor<Stream>
- (^open "List/") (list;Eq<List> text;Eq<Text>)]
- (List/= (&;take size
- (&/map Nat/encode (&;iterate n.inc offset)))
- (&;take size
- (&;unfold (function [n] [(n.inc n) (Nat/encode n)])
- offset)))))
+ (test "'unfold' generalizes 'iterate'."
+ (let [(^open "&/") &;Functor<Stream>
+ (^open "List/") (list;Eq<List> text;Eq<Text>)]
+ (List/= (&;take size
+ (&/map Nat/encode (&;iterate n.inc offset)))
+ (&;take size
+ (&;unfold (function [n] [(n.inc n) (Nat/encode n)])
+ offset)))))
- (test "Can cycle over the same elements as an infinite stream."
- (|> (&;cycle cycle-seed)
- maybe;assume
- (&;nth cycle-sample-idx)
- (n.= (|> cycle-seed
- (list;nth (n.% size cycle-sample-idx))
- maybe;assume))))
- ))
+ (test "Can cycle over the same elements as an infinite stream."
+ (|> (&;cycle cycle-seed)
+ maybe;assume
+ (&;nth cycle-sample-idx)
+ (n.= (|> cycle-seed
+ (list;nth (n.% size cycle-sample-idx))
+ maybe;assume))))
+ ))))
diff --git a/stdlib/test/test/lux/data/coll/tree/rose.lux b/stdlib/test/test/lux/data/coll/tree/rose.lux
index ca95fd185..7a69fbf0e 100644
--- a/stdlib/test/test/lux/data/coll/tree/rose.lux
+++ b/stdlib/test/test/lux/data/coll/tree/rose.lux
@@ -27,19 +27,21 @@
))))
(context: "Trees"
- [[size sample] gen-tree
- #let [(^open "&/") (&;Eq<Tree> number;Eq<Nat>)
- (^open "&/") &;Fold<Tree>
- concat (function [addition partial] (format partial (%n addition)))]]
- ($_ seq
- (test "Can compare trees for equality."
- (&/= sample sample))
+ (<| (times +100)
+ (do @
+ [[size sample] gen-tree
+ #let [(^open "&/") (&;Eq<Tree> number;Eq<Nat>)
+ (^open "&/") &;Fold<Tree>
+ concat (function [addition partial] (format partial (%n addition)))]]
+ ($_ seq
+ (test "Can compare trees for equality."
+ (&/= sample sample))
- (test "Can flatten a tree to get all the nodes as a flat tree."
- (n.= size
- (list;size (&;flatten sample))))
+ (test "Can flatten a tree to get all the nodes as a flat tree."
+ (n.= size
+ (list;size (&;flatten sample))))
- (test "Can fold trees."
- (T/= (&/fold concat "" sample)
- (L/fold concat "" (&;flatten sample))))
- ))
+ (test "Can fold trees."
+ (T/= (&/fold concat "" sample)
+ (L/fold concat "" (&;flatten sample))))
+ ))))
diff --git a/stdlib/test/test/lux/data/coll/tree/zipper.lux b/stdlib/test/test/lux/data/coll/tree/zipper.lux
index a65292cf0..691510885 100644
--- a/stdlib/test/test/lux/data/coll/tree/zipper.lux
+++ b/stdlib/test/test/lux/data/coll/tree/zipper.lux
@@ -30,93 +30,95 @@
(recur (&;next zipper)))))
(context: "Zippers."
- [sample gen-tree
- new-val r;nat
- pre-val r;nat
- post-val r;nat
- #let [(^open "tree/") (rose;Eq<Tree> number;Eq<Nat>)
- (^open "L/") (list;Eq<List> number;Eq<Nat>)]]
- ($_ seq
- (test "Trees can be converted to/from zippers."
- (|> sample
- &;zip &;unzip
- (tree/= sample)))
+ (<| (times +100)
+ (do @
+ [sample gen-tree
+ new-val r;nat
+ pre-val r;nat
+ post-val r;nat
+ #let [(^open "tree/") (rose;Eq<Tree> number;Eq<Nat>)
+ (^open "L/") (list;Eq<List> number;Eq<Nat>)]]
+ ($_ seq
+ (test "Trees can be converted to/from zippers."
+ (|> sample
+ &;zip &;unzip
+ (tree/= sample)))
- (test "Creating a zipper gives you a root node."
- (|> sample &;zip &;root?))
-
- (test "Can move down inside branches. Can move up from lower nodes."
- (let [zipper (&;zip sample)]
- (if (&;branch? zipper)
- (let [child (|> zipper &;down)]
- (and (not (tree/= sample (&;unzip child)))
- (|> child &;up (is zipper) not)
- (|> child &;root (is zipper) not)))
- (and (&;leaf? zipper)
- (|> zipper (&;prepend-child new-val) &;branch?)))))
+ (test "Creating a zipper gives you a root node."
+ (|> sample &;zip &;root?))
+
+ (test "Can move down inside branches. Can move up from lower nodes."
+ (let [zipper (&;zip sample)]
+ (if (&;branch? zipper)
+ (let [child (|> zipper &;down)]
+ (and (not (tree/= sample (&;unzip child)))
+ (|> child &;up (is zipper) not)
+ (|> child &;root (is zipper) not)))
+ (and (&;leaf? zipper)
+ (|> zipper (&;prepend-child new-val) &;branch?)))))
- (test "Can prepend and append children."
- (let [zipper (&;zip sample)]
- (if (&;branch? zipper)
- (let [mid-val (|> zipper &;down &;value)
- zipper (|> zipper
- (&;prepend-child pre-val)
- (&;append-child post-val))]
- (and (|> zipper &;down &;value (is pre-val))
- (|> zipper &;down &;right &;value (is mid-val))
- (|> zipper &;down &;right &;right &;value (is post-val))
- (|> zipper &;down &;rightmost &;leftmost &;value (is pre-val))
- (|> zipper &;down &;right &;left &;value (is pre-val))
- (|> zipper &;down &;rightmost &;value (is post-val))))
- true)))
+ (test "Can prepend and append children."
+ (let [zipper (&;zip sample)]
+ (if (&;branch? zipper)
+ (let [mid-val (|> zipper &;down &;value)
+ zipper (|> zipper
+ (&;prepend-child pre-val)
+ (&;append-child post-val))]
+ (and (|> zipper &;down &;value (is pre-val))
+ (|> zipper &;down &;right &;value (is mid-val))
+ (|> zipper &;down &;right &;right &;value (is post-val))
+ (|> zipper &;down &;rightmost &;leftmost &;value (is pre-val))
+ (|> zipper &;down &;right &;left &;value (is pre-val))
+ (|> zipper &;down &;rightmost &;value (is post-val))))
+ true)))
- (test "Can insert children around a node (unless it's root)."
- (let [zipper (&;zip sample)]
- (if (&;branch? zipper)
- (let [mid-val (|> zipper &;down &;value)
- zipper (|> zipper
- &;down
- (&;insert-left pre-val)
- maybe;assume
- (&;insert-right post-val)
- maybe;assume
- &;up)]
- (and (|> zipper &;down &;value (is pre-val))
- (|> zipper &;down &;right &;value (is mid-val))
- (|> zipper &;down &;right &;right &;value (is post-val))
- (|> zipper &;down &;rightmost &;leftmost &;value (is pre-val))
- (|> zipper &;down &;right &;left &;value (is pre-val))
- (|> zipper &;down &;rightmost &;value (is post-val))))
- (and (|> zipper (&;insert-left pre-val) (case> (#;Some _) false
- #;None true))
- (|> zipper (&;insert-right post-val) (case> (#;Some _) false
- #;None true))))))
-
- (test "Can set and update the value of a node."
- (|> sample &;zip (&;set new-val) &;value (n.= new-val)))
+ (test "Can insert children around a node (unless it's root)."
+ (let [zipper (&;zip sample)]
+ (if (&;branch? zipper)
+ (let [mid-val (|> zipper &;down &;value)
+ zipper (|> zipper
+ &;down
+ (&;insert-left pre-val)
+ maybe;assume
+ (&;insert-right post-val)
+ maybe;assume
+ &;up)]
+ (and (|> zipper &;down &;value (is pre-val))
+ (|> zipper &;down &;right &;value (is mid-val))
+ (|> zipper &;down &;right &;right &;value (is post-val))
+ (|> zipper &;down &;rightmost &;leftmost &;value (is pre-val))
+ (|> zipper &;down &;right &;left &;value (is pre-val))
+ (|> zipper &;down &;rightmost &;value (is post-val))))
+ (and (|> zipper (&;insert-left pre-val) (case> (#;Some _) false
+ #;None true))
+ (|> zipper (&;insert-right post-val) (case> (#;Some _) false
+ #;None true))))))
+
+ (test "Can set and update the value of a node."
+ (|> sample &;zip (&;set new-val) &;value (n.= new-val)))
- (test "Zipper traversal follows the outline of the tree depth-first."
- (L/= (rose;flatten sample)
- (loop [zipper (&;zip sample)]
- (if (&;end? zipper)
- (list (&;value zipper))
- (#;Cons (&;value zipper)
- (recur (&;next zipper)))))))
+ (test "Zipper traversal follows the outline of the tree depth-first."
+ (L/= (rose;flatten sample)
+ (loop [zipper (&;zip sample)]
+ (if (&;end? zipper)
+ (list (&;value zipper))
+ (#;Cons (&;value zipper)
+ (recur (&;next zipper)))))))
- (test "Backwards zipper traversal yield reverse tree flatten."
- (L/= (list;reverse (rose;flatten sample))
- (loop [zipper (to-end (&;zip sample))]
- (if (&;root? zipper)
- (list (&;value zipper))
- (#;Cons (&;value zipper)
- (recur (&;prev zipper)))))))
+ (test "Backwards zipper traversal yield reverse tree flatten."
+ (L/= (list;reverse (rose;flatten sample))
+ (loop [zipper (to-end (&;zip sample))]
+ (if (&;root? zipper)
+ (list (&;value zipper))
+ (#;Cons (&;value zipper)
+ (recur (&;prev zipper)))))))
- (test "Can remove nodes (except root nodes)."
- (let [zipper (&;zip sample)]
- (if (&;branch? zipper)
- (and (|> zipper &;down &;root? not)
- (|> zipper &;down &;remove (case> #;None false
- (#;Some node) (&;root? node))))
- (|> zipper &;remove (case> #;None true
- (#;Some _) false)))))
- ))
+ (test "Can remove nodes (except root nodes)."
+ (let [zipper (&;zip sample)]
+ (if (&;branch? zipper)
+ (and (|> zipper &;down &;root? not)
+ (|> zipper &;down &;remove (case> #;None false
+ (#;Some node) (&;root? node))))
+ (|> zipper &;remove (case> #;None true
+ (#;Some _) false)))))
+ ))))
diff --git a/stdlib/test/test/lux/data/color.lux b/stdlib/test/test/lux/data/color.lux
index 5ca3c95c3..ba0772349 100644
--- a/stdlib/test/test/lux/data/color.lux
+++ b/stdlib/test/test/lux/data/color.lux
@@ -44,53 +44,55 @@
)
(context: "Color."
- [any color
- colorful (|> color
- (r;filter (function [color] (|> (distance color black) (f.>= 100.0))))
- (r;filter (function [color] (|> (distance color white) (f.>= 100.0)))))
- mediocre (|> color
- (r;filter (|>. saturation
- ((function [saturation]
- (and (f.>= 0.25 saturation)
- (f.<= 0.75 saturation)))))))
- ratio (|> r;frac (r;filter (f.>= 0.5)))]
- ($_ seq
- (test "Has equality."
- (:: @;Eq<Color> = any any))
- (test "Can convert to/from HSL."
- (|> any @;to-hsl @;from-hsl
- (distance any)
- (f.<= error-margin)))
- (test "Can convert to/from HSB."
- (|> any @;to-hsb @;from-hsb
- (distance any)
- (f.<= error-margin)))
- (test "Can convert to/from CMYK."
- (|> any @;to-cmyk @;from-cmyk
- (distance any)
- (f.<= error-margin)))
- (test "Can interpolate between 2 colors."
- (and (f.<= (distance colorful black)
- (distance (@;darker ratio colorful) black))
- (f.<= (distance colorful white)
- (distance (@;brighter ratio colorful) white))))
- (test "Can calculate complement."
- (let [~any (@;complement any)
- (^open "@/") @;Eq<Color>]
- (and (not (@/= any ~any))
- (@/= any (@;complement ~any)))))
- (test "Can saturate color."
- (f.> (saturation mediocre)
- (saturation (@;saturate ratio mediocre))))
- (test "Can de-saturate color."
- (f.< (saturation mediocre)
- (saturation (@;de-saturate ratio mediocre))))
- (test "Can gray-scale color."
- (let [gray'ed (@;gray-scale mediocre)]
- (and (f.= 0.0
- (saturation gray'ed))
- (|> (luminance gray'ed)
- (f.- (luminance mediocre))
- frac/abs
- (f.<= error-margin)))))
- ))
+ (<| (times +100)
+ (do @
+ [any color
+ colorful (|> color
+ (r;filter (function [color] (|> (distance color black) (f.>= 100.0))))
+ (r;filter (function [color] (|> (distance color white) (f.>= 100.0)))))
+ mediocre (|> color
+ (r;filter (|>. saturation
+ ((function [saturation]
+ (and (f.>= 0.25 saturation)
+ (f.<= 0.75 saturation)))))))
+ ratio (|> r;frac (r;filter (f.>= 0.5)))]
+ ($_ seq
+ (test "Has equality."
+ (:: @;Eq<Color> = any any))
+ (test "Can convert to/from HSL."
+ (|> any @;to-hsl @;from-hsl
+ (distance any)
+ (f.<= error-margin)))
+ (test "Can convert to/from HSB."
+ (|> any @;to-hsb @;from-hsb
+ (distance any)
+ (f.<= error-margin)))
+ (test "Can convert to/from CMYK."
+ (|> any @;to-cmyk @;from-cmyk
+ (distance any)
+ (f.<= error-margin)))
+ (test "Can interpolate between 2 colors."
+ (and (f.<= (distance colorful black)
+ (distance (@;darker ratio colorful) black))
+ (f.<= (distance colorful white)
+ (distance (@;brighter ratio colorful) white))))
+ (test "Can calculate complement."
+ (let [~any (@;complement any)
+ (^open "@/") @;Eq<Color>]
+ (and (not (@/= any ~any))
+ (@/= any (@;complement ~any)))))
+ (test "Can saturate color."
+ (f.> (saturation mediocre)
+ (saturation (@;saturate ratio mediocre))))
+ (test "Can de-saturate color."
+ (f.< (saturation mediocre)
+ (saturation (@;de-saturate ratio mediocre))))
+ (test "Can gray-scale color."
+ (let [gray'ed (@;gray-scale mediocre)]
+ (and (f.= 0.0
+ (saturation gray'ed))
+ (|> (luminance gray'ed)
+ (f.- (luminance mediocre))
+ frac/abs
+ (f.<= error-margin)))))
+ ))))
diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux
index 7ab580684..91e6bede3 100644
--- a/stdlib/test/test/lux/data/format/json.lux
+++ b/stdlib/test/test/lux/data/format/json.lux
@@ -48,21 +48,23 @@
)))))
(context: "JSON"
- [sample gen-json
- #let [(^open "@/") @;Eq<JSON>
- (^open "@/") @;Codec<Text,JSON>]]
- ($_ seq
- (test "Every JSON is equal to itself."
- (@/= sample sample))
-
- (test "Can encode/decode JSON."
- (|> sample @/encode @/decode
- (case> (#;Right result)
- (@/= sample result)
-
- (#;Left _)
- false)))
- ))
+ (<| (times +100)
+ (do @
+ [sample gen-json
+ #let [(^open "@/") @;Eq<JSON>
+ (^open "@/") @;Codec<Text,JSON>]]
+ ($_ seq
+ (test "Every JSON is equal to itself."
+ (@/= sample sample))
+
+ (test "Can encode/decode JSON."
+ (|> sample @/encode @/decode
+ (case> (#;Right result)
+ (@/= sample result)
+
+ (#;Left _)
+ false)))
+ ))))
(type: Variant
(#Case0 Bool)
@@ -161,13 +163,15 @@
))))
(context: "Polytypism"
- [sample gen-record
- #let [(^open "@/") Eq<Record>
- (^open "@/") Codec<JSON,Record>]]
- (test "Can encode/decode arbitrary types."
- (|> sample @/encode @/decode
- (case> (#E;Success result)
- (@/= sample result)
-
- (#E;Error error)
- false))))
+ (<| (times +100)
+ (do @
+ [sample gen-record
+ #let [(^open "@/") Eq<Record>
+ (^open "@/") Codec<JSON,Record>]]
+ (test "Can encode/decode arbitrary types."
+ (|> sample @/encode @/decode
+ (case> (#E;Success result)
+ (@/= sample result)
+
+ (#E;Error error)
+ false))))))
diff --git a/stdlib/test/test/lux/data/format/xml.lux b/stdlib/test/test/lux/data/format/xml.lux
index 0a4179040..817c7159e 100644
--- a/stdlib/test/test/lux/data/format/xml.lux
+++ b/stdlib/test/test/lux/data/format/xml.lux
@@ -56,59 +56,63 @@
(r;list size gen-xml)))))))
(context: "XML."
- [sample gen-xml
- #let [(^open "&/") &;Eq<XML>
- (^open "&/") &;Codec<Text,XML>]]
- ($_ seq
- (test "Every XML is equal to itself."
- (&/= sample sample))
+ (<| (times +100)
+ (do @
+ [sample gen-xml
+ #let [(^open "&/") &;Eq<XML>
+ (^open "&/") &;Codec<Text,XML>]]
+ ($_ seq
+ (test "Every XML is equal to itself."
+ (&/= sample sample))
- (test "Can encode/decode XML."
- (|> sample &/encode &/decode
- (case> (#;Right result)
- (&/= sample result)
+ (test "Can encode/decode XML."
+ (|> sample &/encode &/decode
+ (case> (#;Right result)
+ (&/= sample result)
- (#;Left error)
- false)))
- ))
+ (#;Left error)
+ false)))
+ ))))
(context: "Parsing."
- [text (xml-text^ +1 +10)
- num-children (|> r;nat (:: @ map (n.% +5)))
- children (r;list num-children (xml-text^ +1 +10))
- tag xml-identifier^
- attr xml-identifier^
- value (xml-text^ +1 +10)
- #let [node (#&;Node tag
- (dict;put attr value &;attrs)
- (L/map (|>. #&;Text) children))]]
- ($_ seq
- (test "Can parse text."
- (E;default false
- (do E;Monad<Error>
- [output (&;run (#&;Text text)
- &;text)]
- (wrap (text/= text output)))))
- (test "Can parse attributes."
- (E;default false
- (do E;Monad<Error>
- [output (|> (&;attr attr)
- (p;before &;ignore)
- (&;run node))]
- (wrap (text/= value output)))))
- (test "Can parse nodes."
- (E;default false
- (do E;Monad<Error>
- [_ (|> (&;node tag)
- (p;before &;ignore)
- (&;run node))]
- (wrap true))))
- (test "Can parse children."
- (E;default false
- (do E;Monad<Error>
- [outputs (|> (&;children (p;some &;text))
- (&;run node))]
- (wrap (:: (list;Eq<List> text;Eq<Text>) =
- children
- outputs)))))
- ))
+ (<| (times +100)
+ (do @
+ [text (xml-text^ +1 +10)
+ num-children (|> r;nat (:: @ map (n.% +5)))
+ children (r;list num-children (xml-text^ +1 +10))
+ tag xml-identifier^
+ attr xml-identifier^
+ value (xml-text^ +1 +10)
+ #let [node (#&;Node tag
+ (dict;put attr value &;attrs)
+ (L/map (|>. #&;Text) children))]]
+ ($_ seq
+ (test "Can parse text."
+ (E;default false
+ (do E;Monad<Error>
+ [output (&;run (#&;Text text)
+ &;text)]
+ (wrap (text/= text output)))))
+ (test "Can parse attributes."
+ (E;default false
+ (do E;Monad<Error>
+ [output (|> (&;attr attr)
+ (p;before &;ignore)
+ (&;run node))]
+ (wrap (text/= value output)))))
+ (test "Can parse nodes."
+ (E;default false
+ (do E;Monad<Error>
+ [_ (|> (&;node tag)
+ (p;before &;ignore)
+ (&;run node))]
+ (wrap true))))
+ (test "Can parse children."
+ (E;default false
+ (do E;Monad<Error>
+ [outputs (|> (&;children (p;some &;text))
+ (&;run node))]
+ (wrap (:: (list;Eq<List> text;Eq<Text>) =
+ children
+ outputs)))))
+ ))))
diff --git a/stdlib/test/test/lux/data/ident.lux b/stdlib/test/test/lux/data/ident.lux
index cae265a45..24b06c7c7 100644
--- a/stdlib/test/test/lux/data/ident.lux
+++ b/stdlib/test/test/lux/data/ident.lux
@@ -14,44 +14,46 @@
(|> (r;text size) (r;filter (. not (text;contains? ";")))))
(context: "Idents"
- [## First Ident
- sizeM1 (|> r;nat (:: @ map (n.% +100)))
- sizeN1 (|> r;nat (:: @ map (|>. (n.% +100) (n.max +1))))
- module1 (gen-part sizeM1)
- name1 (gen-part sizeN1)
- #let [ident1 [module1 name1]]
- ## Second Ident
- sizeM2 (|> r;nat (:: @ map (n.% +100)))
- sizeN2 (|> r;nat (:: @ map (|>. (n.% +100) (n.max +1))))
- module2 (gen-part sizeM2)
- name2 (gen-part sizeN2)
- #let [ident2 [module2 name2]]
- #let [(^open "&/") &;Eq<Ident>
- (^open "&/") &;Codec<Text,Ident>]]
- ($_ seq
- (test "Can get the module & name parts of an ident."
- (and (is module1 (&;module ident1))
- (is name1 (&;name ident1))))
+ (<| (times +100)
+ (do @
+ [## First Ident
+ sizeM1 (|> r;nat (:: @ map (n.% +100)))
+ sizeN1 (|> r;nat (:: @ map (|>. (n.% +100) (n.max +1))))
+ module1 (gen-part sizeM1)
+ name1 (gen-part sizeN1)
+ #let [ident1 [module1 name1]]
+ ## Second Ident
+ sizeM2 (|> r;nat (:: @ map (n.% +100)))
+ sizeN2 (|> r;nat (:: @ map (|>. (n.% +100) (n.max +1))))
+ module2 (gen-part sizeM2)
+ name2 (gen-part sizeN2)
+ #let [ident2 [module2 name2]]
+ #let [(^open "&/") &;Eq<Ident>
+ (^open "&/") &;Codec<Text,Ident>]]
+ ($_ seq
+ (test "Can get the module & name parts of an ident."
+ (and (is module1 (&;module ident1))
+ (is name1 (&;name ident1))))
- (test "Can compare idents for equality."
- (and (&/= ident1 ident1)
- (if (&/= ident1 ident2)
- (and (Text/= module1 module2)
- (Text/= name1 name2))
- (or (not (Text/= module1 module2))
- (not (Text/= name1 name2))))))
+ (test "Can compare idents for equality."
+ (and (&/= ident1 ident1)
+ (if (&/= ident1 ident2)
+ (and (Text/= module1 module2)
+ (Text/= name1 name2))
+ (or (not (Text/= module1 module2))
+ (not (Text/= name1 name2))))))
- (test "Can encode idents as text."
- (|> ident1
- &/encode &/decode
- (case> (#;Right dec-ident) (&/= ident1 dec-ident)
- _ false)))
+ (test "Can encode idents as text."
+ (|> ident1
+ &/encode &/decode
+ (case> (#;Right dec-ident) (&/= ident1 dec-ident)
+ _ false)))
- (test "Encoding an ident without a module component results in text equal to the name of the ident."
- (if (text;empty? module1)
- (Text/= name1 (&/encode ident1))
- true))
- ))
+ (test "Encoding an ident without a module component results in text equal to the name of the ident."
+ (if (text;empty? module1)
+ (Text/= name1 (&/encode ident1))
+ true))
+ ))))
(context: "Ident-related macros."
(let [(^open "&/") &;Eq<Ident>]
diff --git a/stdlib/test/test/lux/data/lazy.lux b/stdlib/test/test/lux/data/lazy.lux
index 926157a07..ce0e6a79a 100644
--- a/stdlib/test/test/lux/data/lazy.lux
+++ b/stdlib/test/test/lux/data/lazy.lux
@@ -7,47 +7,51 @@
lux/test)
(context: "Lazy."
- [left r;nat
- right r;nat
- #let [lazy (&;freeze (n.* left right))
- expected (n.* left right)]]
- ($_ seq
- (test "Lazying does not alter the expected value."
- (n.= expected
- (&;thaw lazy)))
- (test "Lazy values only evaluate once."
- (and (not (is expected
- (&;thaw lazy)))
- (is (&;thaw lazy)
- (&;thaw lazy))))
- ))
+ (<| (times +100)
+ (do @
+ [left r;nat
+ right r;nat
+ #let [lazy (&;freeze (n.* left right))
+ expected (n.* left right)]]
+ ($_ seq
+ (test "Lazying does not alter the expected value."
+ (n.= expected
+ (&;thaw lazy)))
+ (test "Lazy values only evaluate once."
+ (and (not (is expected
+ (&;thaw lazy)))
+ (is (&;thaw lazy)
+ (&;thaw lazy))))
+ ))))
(context: "Functor, Applicative, Monad."
- [sample r;nat]
- ($_ seq
- (test "Functor map."
- (|> (&;freeze sample)
- (:: &;Functor<Lazy> map n.inc)
- &;thaw
- (n.= (n.inc sample))))
+ (<| (times +100)
+ (do @
+ [sample r;nat]
+ ($_ seq
+ (test "Functor map."
+ (|> (&;freeze sample)
+ (:: &;Functor<Lazy> map n.inc)
+ &;thaw
+ (n.= (n.inc sample))))
- (test "Applicative wrap."
- (|> sample
- (:: &;Applicative<Lazy> wrap)
- &;thaw
- (n.= sample)))
-
- (test "Applicative apply."
- (let [(^open "&/") &;Applicative<Lazy>]
- (|> (&/apply (&/wrap n.inc) (&/wrap sample))
- &;thaw
- (n.= (n.inc sample)))))
-
- (test "Monad."
- (|> (do &;Monad<Lazy>
- [f (wrap n.inc)
- a (wrap sample)]
- (wrap (f a)))
- &;thaw
- (n.= (n.inc sample))))
- ))
+ (test "Applicative wrap."
+ (|> sample
+ (:: &;Applicative<Lazy> wrap)
+ &;thaw
+ (n.= sample)))
+
+ (test "Applicative apply."
+ (let [(^open "&/") &;Applicative<Lazy>]
+ (|> (&/apply (&/wrap n.inc) (&/wrap sample))
+ &;thaw
+ (n.= (n.inc sample)))))
+
+ (test "Monad."
+ (|> (do &;Monad<Lazy>
+ [f (wrap n.inc)
+ a (wrap sample)]
+ (wrap (f a)))
+ &;thaw
+ (n.= (n.inc sample))))
+ ))))
diff --git a/stdlib/test/test/lux/data/number.lux b/stdlib/test/test/lux/data/number.lux
index 1a33fdc2c..c5ff11668 100644
--- a/stdlib/test/test/lux/data/number.lux
+++ b/stdlib/test/test/lux/data/number.lux
@@ -11,12 +11,14 @@
(do-template [category rand-gen <Eq> <Order>]
[(context: (format "[" category "] " "Eq & Order")
- [x rand-gen
- y rand-gen]
- (test "" (and (:: <Eq> = x x)
- (or (:: <Eq> = x y)
- (:: <Order> < y x)
- (:: <Order> > y x)))))]
+ (<| (times +100)
+ (do @
+ [x rand-gen
+ y rand-gen]
+ (test "" (and (:: <Eq> = x x)
+ (or (:: <Eq> = x y)
+ (:: <Order> < y x)
+ (:: <Order> > y x)))))))]
["Nat" r;nat Eq<Nat> Order<Nat>]
["Int" r;int Eq<Int> Order<Int>]
@@ -26,18 +28,20 @@
(do-template [category rand-gen <Number> <Order>]
[(context: (format "[" category "] " "Number")
- [x rand-gen
- #let [(^open) <Number>
- (^open) <Order>]]
- (test "" (and (>= x (abs x))
- ## abs(0.0) == 0.0 && negate(abs(0.0)) == -0.0
- (or (Text/= "Frac" category)
- (not (= x (negate x))))
- (= x (negate (negate x)))
- ## There is loss of precision when multiplying
- (or (Text/= "Deg" category)
- (= x (* (signum x)
- (abs x)))))))]
+ (<| (times +100)
+ (do @
+ [x rand-gen
+ #let [(^open) <Number>
+ (^open) <Order>]]
+ (test "" (and (>= x (abs x))
+ ## abs(0.0) == 0.0 && negate(abs(0.0)) == -0.0
+ (or (Text/= "Frac" category)
+ (not (= x (negate x))))
+ (= x (negate (negate x)))
+ ## There is loss of precision when multiplying
+ (or (Text/= "Deg" category)
+ (= x (* (signum x)
+ (abs x)))))))))]
## ["Nat" r;nat Number<Nat>]
["Int" r;int Number<Int> Order<Int>]
@@ -47,19 +51,21 @@
(do-template [category rand-gen <Enum> <Number> <Order>]
[(context: (format "[" category "] " "Enum")
- [x rand-gen]
- (test "" (let [(^open) <Number>
- (^open) <Order>]
- (and (> x
- (:: <Enum> succ x))
- (< x
- (:: <Enum> pred x))
-
- (= x
- (|> x (:: <Enum> pred) (:: <Enum> succ)))
- (= x
- (|> x (:: <Enum> succ) (:: <Enum> pred)))
- ))))]
+ (<| (times +100)
+ (do @
+ [x rand-gen]
+ (test "" (let [(^open) <Number>
+ (^open) <Order>]
+ (and (> x
+ (:: <Enum> succ x))
+ (< x
+ (:: <Enum> pred x))
+
+ (= x
+ (|> x (:: <Enum> pred) (:: <Enum> succ)))
+ (= x
+ (|> x (:: <Enum> succ) (:: <Enum> pred)))
+ ))))))]
["Nat" r;nat Enum<Nat> Number<Nat> Order<Nat>]
["Int" r;int Enum<Int> Number<Int> Order<Int>]
@@ -67,11 +73,13 @@
(do-template [category rand-gen <Number> <Order> <Interval> <test>]
[(context: (format "[" category "] " "Interval")
- [x (|> rand-gen (r;filter <test>))
- #let [(^open) <Number>
- (^open) <Order>]]
- (test "" (and (<= x (:: <Interval> bottom))
- (>= x (:: <Interval> top)))))]
+ (<| (times +100)
+ (do @
+ [x (|> rand-gen (r;filter <test>))
+ #let [(^open) <Number>
+ (^open) <Order>]]
+ (test "" (and (<= x (:: <Interval> bottom))
+ (>= x (:: <Interval> top)))))))]
["Nat" r;nat Number<Nat> Order<Nat> Interval<Nat> (function [_] true)]
["Int" r;int Number<Int> Order<Int> Interval<Int> (function [_] true)]
@@ -82,14 +90,16 @@
(do-template [category rand-gen <Number> <Order> <Monoid> <cap> <test>]
[(context: (format "[" category "] " "Monoid")
- [x (|> rand-gen (:: @ map (|>. (:: <Number> abs) <cap>)) (r;filter <test>))
- #let [(^open) <Number>
- (^open) <Order>
- (^open) <Monoid>]]
- (test "Composing with identity doesn't change the value."
- (and (= x (compose identity x))
- (= x (compose x identity))
- (= identity (compose identity identity)))))]
+ (<| (times +100)
+ (do @
+ [x (|> rand-gen (:: @ map (|>. (:: <Number> abs) <cap>)) (r;filter <test>))
+ #let [(^open) <Number>
+ (^open) <Order>
+ (^open) <Monoid>]]
+ (test "Composing with identity doesn't change the value."
+ (and (= x (compose identity x))
+ (= x (compose x identity))
+ (= identity (compose identity identity)))))))]
["Nat/Add" r;nat Number<Nat> Order<Nat> Add@Monoid<Nat> (n.% +1000) (function [_] true)]
["Nat/Mul" r;nat Number<Nat> Order<Nat> Mul@Monoid<Nat> (n.% +1000) (function [_] true)]
@@ -111,16 +121,18 @@
(do-template [<category> <rand-gen> <Eq> <Codec>]
[(context: (format "[" <category> "] " "Alternative formats")
- [x <rand-gen>]
- (test "Can encode/decode values."
- (|> x
- (:: <Codec> encode)
- (:: <Codec> decode)
- (case> (#;Right x')
- (:: <Eq> = x x')
-
- (#;Left _)
- false))))]
+ (<| (times +100)
+ (do @
+ [x <rand-gen>]
+ (test "Can encode/decode values."
+ (|> x
+ (:: <Codec> encode)
+ (:: <Codec> decode)
+ (case> (#;Right x')
+ (:: <Eq> = x x')
+
+ (#;Left _)
+ false))))))]
["Nat/Binary" r;nat Eq<Nat> Binary@Codec<Text,Nat>]
["Nat/Octal" r;nat Eq<Nat> Octal@Codec<Text,Nat>]
@@ -144,8 +156,10 @@
)
(context: "Can convert frac values to/from their bit patterns."
- [raw r;frac
- factor (|> r;nat (:: @ map (|>. (n.% +1000) (n.max +1))))
- #let [sample (|> factor nat-to-int int-to-frac (f.* raw))]]
- (test "Can convert frac values to/from their bit patterns."
- (|> sample frac-to-bits bits-to-frac (f.= sample))))
+ (<| (times +100)
+ (do @
+ [raw r;frac
+ factor (|> r;nat (:: @ map (|>. (n.% +1000) (n.max +1))))
+ #let [sample (|> factor nat-to-int int-to-frac (f.* raw))]]
+ (test "Can convert frac values to/from their bit patterns."
+ (|> sample frac-to-bits bits-to-frac (f.= sample))))))
diff --git a/stdlib/test/test/lux/data/number/complex.lux b/stdlib/test/test/lux/data/number/complex.lux
index 5fb5f6cfe..5b7e2e1e7 100644
--- a/stdlib/test/test/lux/data/number/complex.lux
+++ b/stdlib/test/test/lux/data/number/complex.lux
@@ -14,9 +14,6 @@
["r" math/random])
lux/test)
-## Based on org.apache.commons.math4.complex.Complex
-## https://github.com/apache/commons-math/blob/master/src/test/java/org/apache/commons/math4/complex/ComplexTest.java
-
(def: margin-of-error Frac 1.0e-10)
(def: (within? margin standard value)
@@ -44,156 +41,170 @@
(wrap (&;complex real imaginary))))
(context: "Construction"
- [real gen-dim
- imaginary gen-dim]
- ($_ seq
- (test "Can build and tear apart complex numbers"
- (let [r+i (&;complex real imaginary)]
- (and (f.= real (get@ #&;real r+i))
- (f.= imaginary (get@ #&;imaginary r+i)))))
-
- (test "If either the real part or the imaginary part is NaN, the composite is NaN."
- (and (&;not-a-number? (&;complex number;not-a-number imaginary))
- (&;not-a-number? (&;complex real number;not-a-number))))
- ))
+ (<| (times +100)
+ (do @
+ [real gen-dim
+ imaginary gen-dim]
+ ($_ seq
+ (test "Can build and tear apart complex numbers"
+ (let [r+i (&;complex real imaginary)]
+ (and (f.= real (get@ #&;real r+i))
+ (f.= imaginary (get@ #&;imaginary r+i)))))
+
+ (test "If either the real part or the imaginary part is NaN, the composite is NaN."
+ (and (&;not-a-number? (&;complex number;not-a-number imaginary))
+ (&;not-a-number? (&;complex real number;not-a-number))))
+ ))))
(context: "Absolute value"
- [real gen-dim
- imaginary gen-dim]
- ($_ seq
- (test "Absolute value of complex >= absolute value of any of the parts."
- (let [r+i (&;complex real imaginary)
- abs (get@ #&;real (&;c.abs r+i))]
- (and (f.>= (f/abs real) abs)
- (f.>= (f/abs imaginary) abs))))
-
- (test "The absolute value of a complex number involving a NaN on either dimension, results in a NaN value."
- (and (number;not-a-number? (get@ #&;real (&;c.abs (&;complex number;not-a-number imaginary))))
- (number;not-a-number? (get@ #&;real (&;c.abs (&;complex real number;not-a-number))))))
-
- (test "The absolute value of a complex number involving an infinity on either dimension, results in an infinite value."
- (and (f.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex number;positive-infinity imaginary))))
- (f.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex real number;positive-infinity))))
- (f.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex number;negative-infinity imaginary))))
- (f.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex real number;negative-infinity))))))
- ))
+ (<| (times +100)
+ (do @
+ [real gen-dim
+ imaginary gen-dim]
+ ($_ seq
+ (test "Absolute value of complex >= absolute value of any of the parts."
+ (let [r+i (&;complex real imaginary)
+ abs (get@ #&;real (&;c.abs r+i))]
+ (and (f.>= (f/abs real) abs)
+ (f.>= (f/abs imaginary) abs))))
+
+ (test "The absolute value of a complex number involving a NaN on either dimension, results in a NaN value."
+ (and (number;not-a-number? (get@ #&;real (&;c.abs (&;complex number;not-a-number imaginary))))
+ (number;not-a-number? (get@ #&;real (&;c.abs (&;complex real number;not-a-number))))))
+
+ (test "The absolute value of a complex number involving an infinity on either dimension, results in an infinite value."
+ (and (f.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex number;positive-infinity imaginary))))
+ (f.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex real number;positive-infinity))))
+ (f.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex number;negative-infinity imaginary))))
+ (f.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex real number;negative-infinity))))))
+ ))))
(context: "Addidion, substraction, multiplication and division"
- [x gen-complex
- y gen-complex
- factor gen-dim]
- ($_ seq
- (test "Adding 2 complex numbers is the same as adding their parts."
- (let [z (&;c.+ y x)]
- (and (&;c.= z
- (&;complex (f.+ (get@ #&;real y)
- (get@ #&;real x))
- (f.+ (get@ #&;imaginary y)
- (get@ #&;imaginary x)))))))
-
- (test "Subtracting 2 complex numbers is the same as adding their parts."
- (let [z (&;c.- y x)]
- (and (&;c.= z
- (&;complex (f.- (get@ #&;real y)
- (get@ #&;real x))
- (f.- (get@ #&;imaginary y)
- (get@ #&;imaginary x)))))))
-
- (test "Subtraction is the inverse of addition."
- (and (|> x (&;c.+ y) (&;c.- y) (within? margin-of-error x))
- (|> x (&;c.- y) (&;c.+ y) (within? margin-of-error x))))
-
- (test "Division is the inverse of multiplication."
- (|> x (&;c.* y) (&;c./ y) (within? margin-of-error x)))
-
- (test "Scalar division is the inverse of scalar multiplication."
- (|> x (&;c.*' factor) (&;c./' factor) (within? margin-of-error x)))
-
- (test "If you subtract the remainder, all divisions must be exact."
- (let [rem (&;c.% y x)
- quotient (|> x (&;c.- rem) (&;c./ y))
- floored (|> quotient
- (update@ #&;real math;floor)
- (update@ #&;imaginary math;floor))
- (^open "&/") &;Codec<Text,Complex>]
- (within? 0.000000000001
- x
- (|> quotient (&;c.* y) (&;c.+ rem)))))
- ))
+ (<| (times +100)
+ (do @
+ [x gen-complex
+ y gen-complex
+ factor gen-dim]
+ ($_ seq
+ (test "Adding 2 complex numbers is the same as adding their parts."
+ (let [z (&;c.+ y x)]
+ (and (&;c.= z
+ (&;complex (f.+ (get@ #&;real y)
+ (get@ #&;real x))
+ (f.+ (get@ #&;imaginary y)
+ (get@ #&;imaginary x)))))))
+
+ (test "Subtracting 2 complex numbers is the same as adding their parts."
+ (let [z (&;c.- y x)]
+ (and (&;c.= z
+ (&;complex (f.- (get@ #&;real y)
+ (get@ #&;real x))
+ (f.- (get@ #&;imaginary y)
+ (get@ #&;imaginary x)))))))
+
+ (test "Subtraction is the inverse of addition."
+ (and (|> x (&;c.+ y) (&;c.- y) (within? margin-of-error x))
+ (|> x (&;c.- y) (&;c.+ y) (within? margin-of-error x))))
+
+ (test "Division is the inverse of multiplication."
+ (|> x (&;c.* y) (&;c./ y) (within? margin-of-error x)))
+
+ (test "Scalar division is the inverse of scalar multiplication."
+ (|> x (&;c.*' factor) (&;c./' factor) (within? margin-of-error x)))
+
+ (test "If you subtract the remainder, all divisions must be exact."
+ (let [rem (&;c.% y x)
+ quotient (|> x (&;c.- rem) (&;c./ y))
+ floored (|> quotient
+ (update@ #&;real math;floor)
+ (update@ #&;imaginary math;floor))
+ (^open "&/") &;Codec<Text,Complex>]
+ (within? 0.000000000001
+ x
+ (|> quotient (&;c.* y) (&;c.+ rem)))))
+ ))))
(context: "Conjugate, reciprocal, signum, negation"
- [x gen-complex]
- ($_ seq
- (test "Conjugate has same real part as original, and opposite of imaginary part."
- (let [cx (&;conjugate x)]
- (and (f.= (get@ #&;real x)
- (get@ #&;real cx))
- (f.= (f/negate (get@ #&;imaginary x))
- (get@ #&;imaginary cx)))))
-
- (test "The reciprocal functions is its own inverse."
- (|> x &;reciprocal &;reciprocal (within? margin-of-error x)))
-
- (test "x*(x^-1) = 1"
- (|> x (&;c.* (&;reciprocal x)) (within? margin-of-error &;one)))
-
- (test "Absolute value of signum is always root2(2), 1 or 0."
- (let [signum-abs (|> x &;c.signum &;c.abs (get@ #&;real))]
- (or (f.= 0.0 signum-abs)
- (f.= 1.0 signum-abs)
- (f.= (math;root2 2.0) signum-abs))))
-
- (test "Negation is its own inverse."
- (let [there (&;c.negate x)
- back-again (&;c.negate there)]
- (and (not (&;c.= there x))
- (&;c.= back-again x))))
-
- (test "Negation doesn't change the absolute value."
- (f.= (get@ #&;real (&;c.abs x))
- (get@ #&;real (&;c.abs (&;c.negate x)))))
- ))
-
-## ## Don't know how to test complex trigonometry properly.
-## (context: "Trigonometry"
-## [x gen-complex]
-## ($_ seq
-## (test "Arc-sine is the inverse of sine."
-## (|> x &;sin &;asin (within? margin-of-error x)))
-
-## (test "Arc-cosine is the inverse of cosine."
-## (|> x &;cos &;acos (within? margin-of-error x)))
-
-## (test "Arc-tangent is the inverse of tangent."
-## (|> x &;tan &;atan (within? margin-of-error x))))
-## )
+ (<| (times +100)
+ (do @
+ [x gen-complex]
+ ($_ seq
+ (test "Conjugate has same real part as original, and opposite of imaginary part."
+ (let [cx (&;conjugate x)]
+ (and (f.= (get@ #&;real x)
+ (get@ #&;real cx))
+ (f.= (f/negate (get@ #&;imaginary x))
+ (get@ #&;imaginary cx)))))
+
+ (test "The reciprocal functions is its own inverse."
+ (|> x &;reciprocal &;reciprocal (within? margin-of-error x)))
+
+ (test "x*(x^-1) = 1"
+ (|> x (&;c.* (&;reciprocal x)) (within? margin-of-error &;one)))
+
+ (test "Absolute value of signum is always root2(2), 1 or 0."
+ (let [signum-abs (|> x &;c.signum &;c.abs (get@ #&;real))]
+ (or (f.= 0.0 signum-abs)
+ (f.= 1.0 signum-abs)
+ (f.= (math;root2 2.0) signum-abs))))
+
+ (test "Negation is its own inverse."
+ (let [there (&;c.negate x)
+ back-again (&;c.negate there)]
+ (and (not (&;c.= there x))
+ (&;c.= back-again x))))
+
+ (test "Negation doesn't change the absolute value."
+ (f.= (get@ #&;real (&;c.abs x))
+ (get@ #&;real (&;c.abs (&;c.negate x)))))
+ ))))
+
+(context: "Trigonometry"
+ (<| (times +100)
+ (do @
+ [x gen-complex]
+ ($_ seq
+ (test "Arc-sine is the inverse of sine."
+ (|> x &;sin &;asin (within? margin-of-error x)))
+
+ (test "Arc-cosine is the inverse of cosine."
+ (|> x &;cos &;acos (within? margin-of-error x)))
+
+ (test "Arc-tangent is the inverse of tangent."
+ (|> x &;tan &;atan (within? margin-of-error x)))))))
(context: "Power 2 and exponential/logarithm"
- [x gen-complex]
- ($_ seq
- (test "Square root is inverse of power 2.0"
- (|> x (&;pow' 2.0) &;root2 (within? margin-of-error x)))
+ (<| (times +100)
+ (do @
+ [x gen-complex]
+ ($_ seq
+ (test "Square root is inverse of power 2.0"
+ (|> x (&;pow' 2.0) &;root2 (within? margin-of-error x)))
- (test "Logarithm is inverse of exponentiation."
- (|> x &;log &;exp (within? margin-of-error x)))
- ))
+ (test "Logarithm is inverse of exponentiation."
+ (|> x &;log &;exp (within? margin-of-error x)))
+ ))))
(context: "Complex roots"
- [sample gen-complex
- degree (|> r;nat (:: @ map (|>. (n.max +1) (n.% +5))))]
- (test "Can calculate the N roots for any complex number."
- (|> sample
- (&;nth-roots degree)
- (List/map (&;pow' (|> degree nat-to-int int-to-frac)))
- (list;every? (within? margin-of-error sample)))))
+ (<| (times +100)
+ (do @
+ [sample gen-complex
+ degree (|> r;nat (:: @ map (|>. (n.max +1) (n.% +5))))]
+ (test "Can calculate the N roots for any complex number."
+ (|> sample
+ (&;nth-roots degree)
+ (List/map (&;pow' (|> degree nat-to-int int-to-frac)))
+ (list;every? (within? margin-of-error sample)))))))
(context: "Codec"
- [sample gen-complex
- #let [(^open "c/") &;Codec<Text,Complex>]]
- (test "Can encode/decode complex numbers."
- (|> sample c/encode c/decode
- (case> (#;Right output)
- (&;c.= sample output)
-
- _
- false))))
+ (<| (times +100)
+ (do @
+ [sample gen-complex
+ #let [(^open "c/") &;Codec<Text,Complex>]]
+ (test "Can encode/decode complex numbers."
+ (|> sample c/encode c/decode
+ (case> (#;Right output)
+ (&;c.= sample output)
+
+ _
+ false))))))
diff --git a/stdlib/test/test/lux/data/number/ratio.lux b/stdlib/test/test/lux/data/number/ratio.lux
index 20090fc8c..3e65ddd13 100644
--- a/stdlib/test/test/lux/data/number/ratio.lux
+++ b/stdlib/test/test/lux/data/number/ratio.lux
@@ -26,80 +26,90 @@
(wrap (&;ratio numerator denominator))))
(context: "Normalization"
- [denom1 gen-part
- denom2 gen-part
- sample gen-ratio]
- ($_ seq
- (test "All zeroes are the same."
- (&;q.= (&;ratio +0 denom1)
- (&;ratio +0 denom2)))
+ (<| (times +100)
+ (do @
+ [denom1 gen-part
+ denom2 gen-part
+ sample gen-ratio]
+ ($_ seq
+ (test "All zeroes are the same."
+ (&;q.= (&;ratio +0 denom1)
+ (&;ratio +0 denom2)))
- (test "All ratios are built normalized."
- (|> sample &;normalize (&;q.= sample)))
- ))
+ (test "All ratios are built normalized."
+ (|> sample &;normalize (&;q.= sample)))
+ ))))
(context: "Arithmetic"
- [x gen-ratio
- y gen-ratio
- #let [min (&;q.min x y)
- max (&;q.max x y)]]
- ($_ seq
- (test "Addition and subtraction are opposites."
- (and (|> max (&;q.- min) (&;q.+ min) (&;q.= max))
- (|> max (&;q.+ min) (&;q.- min) (&;q.= max))))
+ (<| (times +100)
+ (do @
+ [x gen-ratio
+ y gen-ratio
+ #let [min (&;q.min x y)
+ max (&;q.max x y)]]
+ ($_ seq
+ (test "Addition and subtraction are opposites."
+ (and (|> max (&;q.- min) (&;q.+ min) (&;q.= max))
+ (|> max (&;q.+ min) (&;q.- min) (&;q.= max))))
- (test "Multiplication and division are opposites."
- (and (|> max (&;q./ min) (&;q.* min) (&;q.= max))
- (|> max (&;q.* min) (&;q./ min) (&;q.= max))))
+ (test "Multiplication and division are opposites."
+ (and (|> max (&;q./ min) (&;q.* min) (&;q.= max))
+ (|> max (&;q.* min) (&;q./ min) (&;q.= max))))
- (test "Modulus by a larger ratio doesn't change the value."
- (|> min (&;q.% max) (&;q.= min)))
+ (test "Modulus by a larger ratio doesn't change the value."
+ (|> min (&;q.% max) (&;q.= min)))
- (test "Modulus by a smaller ratio results in a value smaller than the limit."
- (|> max (&;q.% min) (&;q.< min)))
+ (test "Modulus by a smaller ratio results in a value smaller than the limit."
+ (|> max (&;q.% min) (&;q.< min)))
- (test "Can get the remainder of a division."
- (let [remainder (&;q.% min max)
- multiple (&;q.- remainder max)
- factor (&;q./ min multiple)]
- (and (|> factor (get@ #&;denominator) (n.= +1))
- (|> factor (&;q.* min) (&;q.+ remainder) (&;q.= max)))))
- ))
+ (test "Can get the remainder of a division."
+ (let [remainder (&;q.% min max)
+ multiple (&;q.- remainder max)
+ factor (&;q./ min multiple)]
+ (and (|> factor (get@ #&;denominator) (n.= +1))
+ (|> factor (&;q.* min) (&;q.+ remainder) (&;q.= max)))))
+ ))))
(context: "Negation, absolute value and signum"
- [sample gen-ratio]
- ($_ seq
- (test "Negation is it's own inverse."
- (let [there (&/negate sample)
- back-again (&/negate there)]
- (and (not (&;q.= there sample))
- (&;q.= back-again sample))))
+ (<| (times +100)
+ (do @
+ [sample gen-ratio]
+ ($_ seq
+ (test "Negation is it's own inverse."
+ (let [there (&/negate sample)
+ back-again (&/negate there)]
+ (and (not (&;q.= there sample))
+ (&;q.= back-again sample))))
- (test "All ratios are already at their absolute value."
- (|> sample &/abs (&;q.= sample)))
-
- (test "Signum is the identity."
- (|> sample (&;q.* (&/signum sample)) (&;q.= sample)))
- ))
+ (test "All ratios are already at their absolute value."
+ (|> sample &/abs (&;q.= sample)))
+
+ (test "Signum is the identity."
+ (|> sample (&;q.* (&/signum sample)) (&;q.= sample)))
+ ))))
(context: "Order"
- [x gen-ratio
- y gen-ratio]
- ($_ seq
- (test "Can compare ratios."
- (and (or (&;q.<= y x)
- (&;q.> y x))
- (or (&;q.>= y x)
- (&;q.< y x))))
- ))
+ (<| (times +100)
+ (do @
+ [x gen-ratio
+ y gen-ratio]
+ ($_ seq
+ (test "Can compare ratios."
+ (and (or (&;q.<= y x)
+ (&;q.> y x))
+ (or (&;q.>= y x)
+ (&;q.< y x))))
+ ))))
(context: "Codec"
- [sample gen-ratio
- #let [(^open "&/") &;Codec<Text,Ratio>]]
- (test "Can encode/decode ratios."
- (|> sample &/encode &/decode
- (case> (#;Right output)
- (&;q.= sample output)
-
- _
- false))))
+ (<| (times +100)
+ (do @
+ [sample gen-ratio
+ #let [(^open "&/") &;Codec<Text,Ratio>]]
+ (test "Can encode/decode ratios."
+ (|> sample &/encode &/decode
+ (case> (#;Right output)
+ (&;q.= sample output)
+
+ _
+ false))))))
diff --git a/stdlib/test/test/lux/data/text.lux b/stdlib/test/test/lux/data/text.lux
index 68015a820..c32494861 100644
--- a/stdlib/test/test/lux/data/text.lux
+++ b/stdlib/test/test/lux/data/text.lux
@@ -11,11 +11,13 @@
lux/test)
(context: "Size"
- [size (:: @ map (n.% +100) r;nat)
- sample (r;text size)]
- (test "" (or (and (n.= +0 size)
- (&;empty? sample))
- (n.= size (&;size sample)))))
+ (<| (times +100)
+ (do @
+ [size (:: @ map (n.% +100) r;nat)
+ sample (r;text size)]
+ (test "" (or (and (n.= +0 size)
+ (&;empty? sample))
+ (n.= size (&;size sample)))))))
(def: bounded-size
(r;Random Nat)
@@ -23,98 +25,103 @@
(:: r;Monad<Random> map (|>. (n.% +20) (n.+ +1)))))
(context: "Locations"
- #seed +4670357681168475116
- [size bounded-size
- idx (:: @ map (n.% size) r;nat)
- sample (r;text size)]
- (test "" (|> sample
- (&;nth idx)
- (case> (^multi (#;Some char)
- [(&;from-code char) char]
- [[(&;index-of' char sample)
- (&;last-index-of' char sample)
- (&;index-of char idx sample)
- (&;last-index-of char idx sample)]
- [(#;Some io) (#;Some lio)
- (#;Some io') (#;Some lio')]])
- (and (n.<= idx io)
- (n.>= idx lio)
+ (<| (seed +4670357681168475116)
+ (do @
+ [size bounded-size
+ idx (:: @ map (n.% size) r;nat)
+ sample (r;text size)]
+ (test "" (|> sample
+ (&;nth idx)
+ (case> (^multi (#;Some char)
+ [(&;from-code char) char]
+ [[(&;index-of' char sample)
+ (&;last-index-of' char sample)
+ (&;index-of char idx sample)
+ (&;last-index-of char idx sample)]
+ [(#;Some io) (#;Some lio)
+ (#;Some io') (#;Some lio')]])
+ (and (n.<= idx io)
+ (n.>= idx lio)
- (n.= idx io')
- (n.>= idx lio')
+ (n.= idx io')
+ (n.>= idx lio')
- (&;contains? char sample))
+ (&;contains? char sample))
- _
- false
- ))
- ))
+ _
+ false
+ ))
+ ))))
(context: "Text functions"
- [sizeL bounded-size
- sizeR bounded-size
- sampleL (r;text sizeL)
- sampleR (r;text sizeR)
- #let [sample (&;concat (list sampleL sampleR))
- fake-sample (&;join-with " " (list sampleL sampleR))
- dup-sample (&;join-with "" (list sampleL sampleR))
- enclosed-sample (&;enclose [sampleR sampleR] sampleL)
- (^open) &;Eq<Text>]]
- (test "" (and (not (= sample fake-sample))
- (= sample dup-sample)
- (&;starts-with? sampleL sample)
- (&;ends-with? sampleR sample)
- (= enclosed-sample
- (&;enclose' sampleR sampleL))
-
- (|> (&;split sizeL sample)
- (case> (#;Right [_l _r])
- (and (= sampleL _l)
- (= sampleR _r)
- (= sample (&;concat (list _l _r))))
+ (<| (times +100)
+ (do @
+ [sizeL bounded-size
+ sizeR bounded-size
+ sampleL (r;text sizeL)
+ sampleR (r;text sizeR)
+ #let [sample (&;concat (list sampleL sampleR))
+ fake-sample (&;join-with " " (list sampleL sampleR))
+ dup-sample (&;join-with "" (list sampleL sampleR))
+ enclosed-sample (&;enclose [sampleR sampleR] sampleL)
+ (^open) &;Eq<Text>]]
+ (test "" (and (not (= sample fake-sample))
+ (= sample dup-sample)
+ (&;starts-with? sampleL sample)
+ (&;ends-with? sampleR sample)
+ (= enclosed-sample
+ (&;enclose' sampleR sampleL))
+
+ (|> (&;split sizeL sample)
+ (case> (#;Right [_l _r])
+ (and (= sampleL _l)
+ (= sampleR _r)
+ (= sample (&;concat (list _l _r))))
- _
- false))
-
- (|> [(&;clip +0 sizeL sample)
- (&;clip sizeL (&;size sample) sample)
- (&;clip' sizeL sample)
- (&;clip' +0 sample)]
- (case> [(#;Right _l) (#;Right _r) (#;Right _r') (#;Right _f)]
- (and (= sampleL _l)
- (= sampleR _r)
- (= _r _r')
- (= sample _f))
+ _
+ false))
+
+ (|> [(&;clip +0 sizeL sample)
+ (&;clip sizeL (&;size sample) sample)
+ (&;clip' sizeL sample)
+ (&;clip' +0 sample)]
+ (case> [(#;Right _l) (#;Right _r) (#;Right _r') (#;Right _f)]
+ (and (= sampleL _l)
+ (= sampleR _r)
+ (= _r _r')
+ (= sample _f))
- _
- false))
- )
- ))
+ _
+ false))
+ )
+ ))))
(context: "More text functions"
- [sizeP bounded-size
- sizeL bounded-size
- #let [## The wider unicode charset includes control characters that
- ## can make text replacement work improperly.
- ## Because of that, I restrict the charset.
- normal-char-gen (|> r;nat (:: @ map (|>. (n.% +128) (n.max +1))))]
- sep1 (r;text' normal-char-gen +1)
- sep2 (r;text' normal-char-gen +1)
- #let [part-gen (|> (r;text' normal-char-gen sizeP)
- (r;filter (. not (&;contains? sep1))))]
- parts (r;list sizeL part-gen)
- #let [sample1 (&;concat (list;interpose sep1 parts))
- sample2 (&;concat (list;interpose sep2 parts))
- (^open "&/") &;Eq<Text>]]
- ($_ seq
- (test "Can split text through a separator."
- (n.= (list;size parts)
- (list;size (&;split-all-with sep1 sample1))))
+ (<| (times +100)
+ (do @
+ [sizeP bounded-size
+ sizeL bounded-size
+ #let [## The wider unicode charset includes control characters that
+ ## can make text replacement work improperly.
+ ## Because of that, I restrict the charset.
+ normal-char-gen (|> r;nat (:: @ map (|>. (n.% +128) (n.max +1))))]
+ sep1 (r;text' normal-char-gen +1)
+ sep2 (r;text' normal-char-gen +1)
+ #let [part-gen (|> (r;text' normal-char-gen sizeP)
+ (r;filter (. not (&;contains? sep1))))]
+ parts (r;list sizeL part-gen)
+ #let [sample1 (&;concat (list;interpose sep1 parts))
+ sample2 (&;concat (list;interpose sep2 parts))
+ (^open "&/") &;Eq<Text>]]
+ ($_ seq
+ (test "Can split text through a separator."
+ (n.= (list;size parts)
+ (list;size (&;split-all-with sep1 sample1))))
- (test "Can replace occurrences of a piece of text inside a larger text."
- (&/= sample2
- (&;replace-all sep1 sep2 sample1)))
- ))
+ (test "Can replace occurrences of a piece of text inside a larger text."
+ (&/= sample2
+ (&;replace-all sep1 sep2 sample1)))
+ ))))
(context: "Other text functions"
(let [(^open "&/") &;Eq<Text>]
diff --git a/stdlib/test/test/lux/data/text/lexer.lux b/stdlib/test/test/lux/data/text/lexer.lux
index 39c171442..81422af4b 100644
--- a/stdlib/test/test/lux/data/text/lexer.lux
+++ b/stdlib/test/test/lux/data/text/lexer.lux
@@ -70,19 +70,21 @@
))
(context: "Literals"
- [size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10))))
- sample (r;text size)
- non-sample (|> (r;text size)
- (r;filter (|>. (text/= sample) not)))]
- ($_ seq
- (test "Can find literal text fragments."
- (and (|> (&;run sample
- (&;this sample))
- (case> (#;Right []) true _ false))
- (|> (&;run non-sample
- (&;this sample))
- (case> (#;Left _) true _ false))))
- ))
+ (<| (times +100)
+ (do @
+ [size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10))))
+ sample (r;text size)
+ non-sample (|> (r;text size)
+ (r;filter (|>. (text/= sample) not)))]
+ ($_ seq
+ (test "Can find literal text fragments."
+ (and (|> (&;run sample
+ (&;this sample))
+ (case> (#;Right []) true _ false))
+ (|> (&;run non-sample
+ (&;this sample))
+ (case> (#;Left _) true _ false))))
+ ))))
(context: "Custom lexers"
($_ seq
diff --git a/stdlib/test/test/lux/data/text/regex.lux b/stdlib/test/test/lux/data/text/regex.lux
index 29ec9a896..56aa34d40 100644
--- a/stdlib/test/test/lux/data/text/regex.lux
+++ b/stdlib/test/test/lux/data/text/regex.lux
@@ -267,18 +267,19 @@
))
(context: "Pattern-matching"
- #seed +8146146848425792192
- [sample1 (r;text +3)
- sample2 (r;text +3)
- sample3 (r;text +4)]
- (case (format sample1 "-" sample2 "-" sample3)
- (&;^regex "(.{3})-(.{3})-(.{4})"
- [_ match1 match2 match3])
- (test "Can pattern-match using regular-expressions."
- (and (T/= sample1 match1)
- (T/= sample2 match2)
- (T/= sample3 match3)))
-
- _
- (test "Cannot pattern-match using regular-expressions."
- false)))
+ (<| (seed +8146146848425792192)
+ (do @
+ [sample1 (r;text +3)
+ sample2 (r;text +3)
+ sample3 (r;text +4)]
+ (case (format sample1 "-" sample2 "-" sample3)
+ (&;^regex "(.{3})-(.{3})-(.{4})"
+ [_ match1 match2 match3])
+ (test "Can pattern-match using regular-expressions."
+ (and (T/= sample1 match1)
+ (T/= sample2 match2)
+ (T/= sample3 match3)))
+
+ _
+ (test "Cannot pattern-match using regular-expressions."
+ false)))))
diff --git a/stdlib/test/test/lux/host.jvm.lux b/stdlib/test/test/lux/host.jvm.lux
index ba027150a..33c9fcf79 100644
--- a/stdlib/test/test/lux/host.jvm.lux
+++ b/stdlib/test/test/lux/host.jvm.lux
@@ -53,24 +53,26 @@
([] foo [boolean String] void #throws [Exception]))
(context: "Conversions"
- [sample r;int]
- (with-expansions
- [<int-convs> (do-template [<to> <from> <message>]
- [(test <message>
- (or (|> sample <to> <from> (i.= sample))
- (let [capped-sample (|> sample <to> <from>)]
- (|> capped-sample <to> <from> (i.= capped-sample)))))]
-
- [&;l2b &;b2l "Can succesfully convert to/from byte."]
- [&;l2s &;s2l "Can succesfully convert to/from short."]
- [&;l2i &;i2l "Can succesfully convert to/from int."]
- [&;l2f &;f2l "Can succesfully convert to/from float."]
- [&;l2d &;d2l "Can succesfully convert to/from double."]
- [(<| &;i2c &;l2i) (<| &;i2l &;c2i) "Can succesfully convert to/from char."]
- )]
- ($_ seq
- <int-convs>
- )))
+ (<| (times +100)
+ (do @
+ [sample r;int]
+ (with-expansions
+ [<int-convs> (do-template [<to> <from> <message>]
+ [(test <message>
+ (or (|> sample <to> <from> (i.= sample))
+ (let [capped-sample (|> sample <to> <from>)]
+ (|> capped-sample <to> <from> (i.= capped-sample)))))]
+
+ [&;l2b &;b2l "Can succesfully convert to/from byte."]
+ [&;l2s &;s2l "Can succesfully convert to/from short."]
+ [&;l2i &;i2l "Can succesfully convert to/from int."]
+ [&;l2f &;f2l "Can succesfully convert to/from float."]
+ [&;l2d &;d2l "Can succesfully convert to/from double."]
+ [(<| &;i2c &;l2i) (<| &;i2l &;c2i) "Can succesfully convert to/from char."]
+ )]
+ ($_ seq
+ <int-convs>
+ )))))
(context: "Miscellaneous"
($_ seq
@@ -100,14 +102,16 @@
))
(context: "Arrays"
- [size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +1))))
- idx (|> r;nat (:: @ map (n.% size)))
- value r;int]
- ($_ seq
- (test "Can create arrays of some length."
- (n.= size (&;array-length (&;array Long size))))
-
- (test "Can set and get array values."
- (let [arr (&;array Long size)]
- (exec (&;array-write idx value arr)
- (i.= value (&;array-read idx arr)))))))
+ (<| (times +100)
+ (do @
+ [size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +1))))
+ idx (|> r;nat (:: @ map (n.% size)))
+ value r;int]
+ ($_ seq
+ (test "Can create arrays of some length."
+ (n.= size (&;array-length (&;array Long size))))
+
+ (test "Can set and get array values."
+ (let [arr (&;array Long size)]
+ (exec (&;array-write idx value arr)
+ (i.= value (&;array-read idx arr)))))))))
diff --git a/stdlib/test/test/lux/math.lux b/stdlib/test/test/lux/math.lux
index 701790886..a2ef96186 100644
--- a/stdlib/test/test/lux/math.lux
+++ b/stdlib/test/test/lux/math.lux
@@ -17,112 +17,124 @@
(f.< margin-of-error
(f/abs (f.- standard value))))
-## (def: margin Frac 0.0000001)
-
-## ## The JVM trigonometry functions sometimes give me funky results.
-## ## I won't be testing this, until I can figure out what's going on, or
-## ## come up with my own implementation
-## (context: "Trigonometry"
-## [angle (|> r;frac (:: @ map (f.* &;tau)))]
-## ($_ seq
-## (test "Sine and arc-sine are inverse functions."
-## (|> angle &;sin &;asin (within? margin angle)))
-
-## (test "Cosine and arc-cosine are inverse functions."
-## (|> angle &;cos &;acos (within? margin angle)))
-
-## (test "Tangent and arc-tangent are inverse functions."
-## (|> angle &;tan &;atan (within? margin angle)))
-## ))
+(def: margin Frac 0.0000001)
+
+## The JVM trigonometry functions sometimes give me funky results.
+## I won't be testing this, until I can figure out what's going on, or
+## come up with my own implementation
+(context: "Trigonometry"
+ (<| (times +100)
+ (do @
+ [angle (|> r;frac (:: @ map (f.* &;tau)))]
+ ($_ seq
+ (test "Sine and arc-sine are inverse functions."
+ (|> angle &;sin &;asin (within? margin angle)))
+
+ (test "Cosine and arc-cosine are inverse functions."
+ (|> angle &;cos &;acos (within? margin angle)))
+
+ (test "Tangent and arc-tangent are inverse functions."
+ (|> angle &;tan &;atan (within? margin angle)))
+ ))))
(context: "Roots"
- [factor (|> r;nat (:: @ map (|>. (n.% +1000)
- (n.max +1)
- nat-to-int
- int-to-frac)))
- base (|> r;frac (:: @ map (f.* factor)))]
- ($_ seq
- (test "Square-root is inverse of square."
- (|> base (&;pow 2.0) &;root2 (f.= base)))
-
- (test "Cubic-root is inverse of cube."
- (|> base (&;pow 3.0) &;root3 (f.= base)))
- ))
+ (<| (times +100)
+ (do @
+ [factor (|> r;nat (:: @ map (|>. (n.% +1000)
+ (n.max +1)
+ nat-to-int
+ int-to-frac)))
+ base (|> r;frac (:: @ map (f.* factor)))]
+ ($_ seq
+ (test "Square-root is inverse of square."
+ (|> base (&;pow 2.0) &;root2 (f.= base)))
+
+ (test "Cubic-root is inverse of cube."
+ (|> base (&;pow 3.0) &;root3 (f.= base)))
+ ))))
(context: "Rounding"
- [sample (|> r;frac (:: @ map (f.* 1000.0)))]
- ($_ seq
- (test "The ceiling will be an integer value, and will be >= the original."
- (let [ceil'd (&;ceil sample)]
- (and (|> ceil'd frac-to-int int-to-frac (f.= ceil'd))
- (f.>= sample ceil'd)
- (f.<= 1.0 (f.- sample ceil'd)))))
-
- (test "The floor will be an integer value, and will be <= the original."
- (let [floor'd (&;floor sample)]
- (and (|> floor'd frac-to-int int-to-frac (f.= floor'd))
- (f.<= sample floor'd)
- (f.<= 1.0 (f.- floor'd sample)))))
-
- (test "The round will be an integer value, and will be < or > or = the original."
- (let [round'd (&;round sample)]
- (and (|> round'd frac-to-int int-to-frac (f.= round'd))
- (f.<= 1.0 (f/abs (f.- sample round'd))))))
- ))
+ (<| (times +100)
+ (do @
+ [sample (|> r;frac (:: @ map (f.* 1000.0)))]
+ ($_ seq
+ (test "The ceiling will be an integer value, and will be >= the original."
+ (let [ceil'd (&;ceil sample)]
+ (and (|> ceil'd frac-to-int int-to-frac (f.= ceil'd))
+ (f.>= sample ceil'd)
+ (f.<= 1.0 (f.- sample ceil'd)))))
+
+ (test "The floor will be an integer value, and will be <= the original."
+ (let [floor'd (&;floor sample)]
+ (and (|> floor'd frac-to-int int-to-frac (f.= floor'd))
+ (f.<= sample floor'd)
+ (f.<= 1.0 (f.- floor'd sample)))))
+
+ (test "The round will be an integer value, and will be < or > or = the original."
+ (let [round'd (&;round sample)]
+ (and (|> round'd frac-to-int int-to-frac (f.= round'd))
+ (f.<= 1.0 (f/abs (f.- sample round'd))))))
+ ))))
(context: "Exponentials and logarithms"
- [sample (|> r;frac (:: @ map (f.* 10.0)))]
- (test "Logarithm is the inverse of exponential."
- (|> sample &;exp &;log (within? 1.0e-15 sample))))
+ (<| (times +100)
+ (do @
+ [sample (|> r;frac (:: @ map (f.* 10.0)))]
+ (test "Logarithm is the inverse of exponential."
+ (|> sample &;exp &;log (within? 1.0e-15 sample))))))
(context: "Greatest-Common-Divisor and Least-Common-Multiple"
- [#let [gen-nat (|> r;nat (:: @ map (|>. (n.% +1000) (n.max +1))))]
- x gen-nat
- y gen-nat]
- ($_ (test "GCD"
- (let [gcd (&;gcd x y)]
- (and (n.= +0 (n.% gcd x))
- (n.= +0 (n.% gcd y))
- (n.>= +1 gcd))))
-
- (test "LCM"
- (let [lcm (&;lcm x y)]
- (and (n.= +0 (n.% x lcm))
- (n.= +0 (n.% y lcm))
- (n.<= (n.* x y) lcm))))
- ))
+ (<| (times +100)
+ (do @
+ [#let [gen-nat (|> r;nat (:: @ map (|>. (n.% +1000) (n.max +1))))]
+ x gen-nat
+ y gen-nat]
+ ($_ (test "GCD"
+ (let [gcd (&;gcd x y)]
+ (and (n.= +0 (n.% gcd x))
+ (n.= +0 (n.% gcd y))
+ (n.>= +1 gcd))))
+
+ (test "LCM"
+ (let [lcm (&;lcm x y)]
+ (and (n.= +0 (n.% x lcm))
+ (n.= +0 (n.% y lcm))
+ (n.<= (n.* x y) lcm))))
+ ))))
(context: "Infix syntax"
- [x r;nat
- y r;nat
- z r;nat
- theta r;frac
- #let [top (|> x (n.max y) (n.max z))
- bottom (|> x (n.min y) (n.min z))]]
- ($_ seq
- (test "Constant values don't change."
- (n.= x
- (&;infix x)))
-
- (test "Can call binary functions."
- (n.= (&;gcd y x)
- (&;infix [x &;gcd y])))
-
- (test "Can call unary functions."
- (f.= (&;sin theta)
- (&;infix [&;sin theta])))
-
- (test "Can use regular syntax in the middle of infix code."
- (n.= (&;gcd +450 (n.* +3 +9))
- (&;infix [(n.* +3 +9) &;gcd +450])))
-
- (test "Can use non-numerical functions/macros as operators."
- (b/= (and (n.< y x) (n.< z y))
- (&;infix [[x n.< y] and [y n.< z]])))
-
- (test "Can combine boolean operations in special ways via special keywords."
- (and (b/= (and (n.< y x) (n.< z y))
- (&;infix [#and x n.< y n.< z]))
- (b/= (and (n.< y x) (n.> z y))
- (&;infix [#and x n.< y n.> z]))))
- ))
+ (<| (times +100)
+ (do @
+ [x r;nat
+ y r;nat
+ z r;nat
+ theta r;frac
+ #let [top (|> x (n.max y) (n.max z))
+ bottom (|> x (n.min y) (n.min z))]]
+ ($_ seq
+ (test "Constant values don't change."
+ (n.= x
+ (&;infix x)))
+
+ (test "Can call binary functions."
+ (n.= (&;gcd y x)
+ (&;infix [x &;gcd y])))
+
+ (test "Can call unary functions."
+ (f.= (&;sin theta)
+ (&;infix [&;sin theta])))
+
+ (test "Can use regular syntax in the middle of infix code."
+ (n.= (&;gcd +450 (n.* +3 +9))
+ (&;infix [(n.* +3 +9) &;gcd +450])))
+
+ (test "Can use non-numerical functions/macros as operators."
+ (b/= (and (n.< y x) (n.< z y))
+ (&;infix [[x n.< y] and [y n.< z]])))
+
+ (test "Can combine boolean operations in special ways via special keywords."
+ (and (b/= (and (n.< y x) (n.< z y))
+ (&;infix [#and x n.< y n.< z]))
+ (b/= (and (n.< y x) (n.> z y))
+ (&;infix [#and x n.< y n.> z]))))
+ ))))
diff --git a/stdlib/test/test/lux/math/logic/continuous.lux b/stdlib/test/test/lux/math/logic/continuous.lux
index 1c6ed01a4..5df89cfef 100644
--- a/stdlib/test/test/lux/math/logic/continuous.lux
+++ b/stdlib/test/test/lux/math/logic/continuous.lux
@@ -7,25 +7,27 @@
lux/test)
(context: "Operations"
- [left r;deg
- right r;deg]
- ($_ seq
- (test "AND is the minimum."
- (let [result (&;~and left right)]
- (and (d.<= left result)
- (d.<= right result))))
+ (<| (times +100)
+ (do @
+ [left r;deg
+ right r;deg]
+ ($_ seq
+ (test "AND is the minimum."
+ (let [result (&;~and left right)]
+ (and (d.<= left result)
+ (d.<= right result))))
- (test "OR is the maximum."
- (let [result (&;~or left right)]
- (and (d.>= left result)
- (d.>= right result))))
+ (test "OR is the maximum."
+ (let [result (&;~or left right)]
+ (and (d.>= left result)
+ (d.>= right result))))
- (test "Double negation results in the original value."
- (d.= left (&;~not (&;~not left))))
+ (test "Double negation results in the original value."
+ (d.= left (&;~not (&;~not left))))
- (test "Every value is equivalent to itself."
- (and (d.>= left
- (&;~= left left))
- (d.>= right
- (&;~= right right))))
- ))
+ (test "Every value is equivalent to itself."
+ (and (d.>= left
+ (&;~= left left))
+ (d.>= right
+ (&;~= right right))))
+ ))))
diff --git a/stdlib/test/test/lux/math/logic/fuzzy.lux b/stdlib/test/test/lux/math/logic/fuzzy.lux
index 41a8f090a..3c7ff926e 100644
--- a/stdlib/test/test/lux/math/logic/fuzzy.lux
+++ b/stdlib/test/test/lux/math/logic/fuzzy.lux
@@ -14,39 +14,41 @@
(do-template [<desc> <hash> <gen> <triangle> <lt> <lte> <gt> <gte>]
[(context: (format "[" <desc> "] " "Triangles")
- [values (r;set <hash> +3 <gen>)
- #let [[x y z] (case (set;to-list values)
- (^ (list x y z))
- [x y z]
-
- _
- (undefined))]
- sample <gen>
- #let [[bottom middle top] (case (list;sort <lt> (list x y z))
- (^ (list bottom middle top))
- [bottom middle top]
-
- _
- (undefined))
- triangle (<triangle> x y z)]]
- ($_ seq
- (test "The middle value will always have maximum membership."
- (d.= ~true (&;membership middle triangle)))
-
- (test "Boundary values will always have 0 membership."
- (and (d.= ~false (&;membership bottom triangle))
- (d.= ~false (&;membership top triangle))))
-
- (test "Values within range, will have membership > 0."
- (B/= (d.> ~false (&;membership sample triangle))
- (and (<gt> bottom sample)
- (<lt> top sample))))
-
- (test "Values outside of range, will have membership = 0."
- (B/= (d.= ~false (&;membership sample triangle))
- (or (<lte> bottom sample)
- (<gte> top sample))))
- ))]
+ (<| (times +100)
+ (do @
+ [values (r;set <hash> +3 <gen>)
+ #let [[x y z] (case (set;to-list values)
+ (^ (list x y z))
+ [x y z]
+
+ _
+ (undefined))]
+ sample <gen>
+ #let [[bottom middle top] (case (list;sort <lt> (list x y z))
+ (^ (list bottom middle top))
+ [bottom middle top]
+
+ _
+ (undefined))
+ triangle (<triangle> x y z)]]
+ ($_ seq
+ (test "The middle value will always have maximum membership."
+ (d.= ~true (&;membership middle triangle)))
+
+ (test "Boundary values will always have 0 membership."
+ (and (d.= ~false (&;membership bottom triangle))
+ (d.= ~false (&;membership top triangle))))
+
+ (test "Values within range, will have membership > 0."
+ (B/= (d.> ~false (&;membership sample triangle))
+ (and (<gt> bottom sample)
+ (<lt> top sample))))
+
+ (test "Values outside of range, will have membership = 0."
+ (B/= (d.= ~false (&;membership sample triangle))
+ (or (<lte> bottom sample)
+ (<gte> top sample))))
+ ))))]
["Frac" number;Hash<Frac> r;frac &;f.triangle f.< f.<= f.> f.>=]
["Deg" number;Hash<Deg> r;deg &;d.triangle d.< d.<= d.> d.>=]
@@ -54,56 +56,60 @@
(do-template [<desc> <hash> <gen> <trapezoid> <lt> <lte> <gt> <gte>]
[(context: (format "[" <desc> "] " "Trapezoids")
- [values (r;set <hash> +4 <gen>)
- #let [[w x y z] (case (set;to-list values)
- (^ (list w x y z))
- [w x y z]
-
- _
- (undefined))]
- sample <gen>
- #let [[bottom middle-bottom middle-top top] (case (list;sort <lt> (list w x y z))
- (^ (list bottom middle-bottom middle-top top))
- [bottom middle-bottom middle-top top]
-
- _
- (undefined))
- trapezoid (<trapezoid> w x y z)]]
- ($_ seq
- (test "The middle values will always have maximum membership."
- (and (d.= ~true (&;membership middle-bottom trapezoid))
- (d.= ~true (&;membership middle-top trapezoid))))
-
- (test "Boundary values will always have 0 membership."
- (and (d.= ~false (&;membership bottom trapezoid))
- (d.= ~false (&;membership top trapezoid))))
-
- (test "Values within inner range will have membership = 1"
- (B/= (d.= ~true (&;membership sample trapezoid))
- (and (<gte> middle-bottom sample)
- (<lte> middle-top sample))))
-
- (test "Values within range, will have membership > 0."
- (B/= (d.> ~false (&;membership sample trapezoid))
- (and (<gt> bottom sample)
- (<lt> top sample))))
-
- (test "Values outside of range, will have membership = 0."
- (B/= (d.= ~false (&;membership sample trapezoid))
- (or (<lte> bottom sample)
- (<gte> top sample))))
- ))]
+ (<| (times +100)
+ (do @
+ [values (r;set <hash> +4 <gen>)
+ #let [[w x y z] (case (set;to-list values)
+ (^ (list w x y z))
+ [w x y z]
+
+ _
+ (undefined))]
+ sample <gen>
+ #let [[bottom middle-bottom middle-top top] (case (list;sort <lt> (list w x y z))
+ (^ (list bottom middle-bottom middle-top top))
+ [bottom middle-bottom middle-top top]
+
+ _
+ (undefined))
+ trapezoid (<trapezoid> w x y z)]]
+ ($_ seq
+ (test "The middle values will always have maximum membership."
+ (and (d.= ~true (&;membership middle-bottom trapezoid))
+ (d.= ~true (&;membership middle-top trapezoid))))
+
+ (test "Boundary values will always have 0 membership."
+ (and (d.= ~false (&;membership bottom trapezoid))
+ (d.= ~false (&;membership top trapezoid))))
+
+ (test "Values within inner range will have membership = 1"
+ (B/= (d.= ~true (&;membership sample trapezoid))
+ (and (<gte> middle-bottom sample)
+ (<lte> middle-top sample))))
+
+ (test "Values within range, will have membership > 0."
+ (B/= (d.> ~false (&;membership sample trapezoid))
+ (and (<gt> bottom sample)
+ (<lt> top sample))))
+
+ (test "Values outside of range, will have membership = 0."
+ (B/= (d.= ~false (&;membership sample trapezoid))
+ (or (<lte> bottom sample)
+ (<gte> top sample))))
+ ))))]
["Frac" number;Hash<Frac> r;frac &;f.trapezoid f.< f.<= f.> f.>=]
["Deg" number;Hash<Deg> r;deg &;d.trapezoid d.< d.<= d.> d.>=]
)
(context: "Gaussian"
- [deviation (|> r;frac (r;filter (f.> 0.0)))
- center r;frac
- #let [gaussian (&;gaussian deviation center)]]
- (test "The center value will always have maximum membership."
- (d.= ~true (&;membership center gaussian))))
+ (<| (times +100)
+ (do @
+ [deviation (|> r;frac (r;filter (f.> 0.0)))
+ center r;frac
+ #let [gaussian (&;gaussian deviation center)]]
+ (test "The center value will always have maximum membership."
+ (d.= ~true (&;membership center gaussian))))))
(def: gen-triangle
(r;Random (&;Fuzzy Frac))
@@ -114,64 +120,70 @@
(wrap (&;f.triangle x y z))))
(context: "Combinators"
- [left gen-triangle
- right gen-triangle
- sample r;frac]
- ($_ seq
- (test "Union membership as as high as membership in any of its members."
- (let [combined (&;union left right)
- combined-membership (&;membership sample combined)]
- (and (d.>= (&;membership sample left)
- combined-membership)
- (d.>= (&;membership sample right)
- combined-membership))))
-
- (test "Intersection membership as as low as membership in any of its members."
- (let [combined (&;intersection left right)
- combined-membership (&;membership sample combined)]
- (and (d.<= (&;membership sample left)
- combined-membership)
- (d.<= (&;membership sample right)
- combined-membership))))
-
- (test "Complement membership is the opposite of normal membership."
- (d.= (&;membership sample left)
- (~not (&;membership sample (&;complement left)))))
-
- (test "Membership in the difference will never be higher than in the set being subtracted."
- (B/= (d.> (&;membership sample right)
- (&;membership sample left))
- (d.< (&;membership sample left)
- (&;membership sample (&;difference left right)))))
- ))
+ (<| (times +100)
+ (do @
+ [left gen-triangle
+ right gen-triangle
+ sample r;frac]
+ ($_ seq
+ (test "Union membership as as high as membership in any of its members."
+ (let [combined (&;union left right)
+ combined-membership (&;membership sample combined)]
+ (and (d.>= (&;membership sample left)
+ combined-membership)
+ (d.>= (&;membership sample right)
+ combined-membership))))
+
+ (test "Intersection membership as as low as membership in any of its members."
+ (let [combined (&;intersection left right)
+ combined-membership (&;membership sample combined)]
+ (and (d.<= (&;membership sample left)
+ combined-membership)
+ (d.<= (&;membership sample right)
+ combined-membership))))
+
+ (test "Complement membership is the opposite of normal membership."
+ (d.= (&;membership sample left)
+ (~not (&;membership sample (&;complement left)))))
+
+ (test "Membership in the difference will never be higher than in the set being subtracted."
+ (B/= (d.> (&;membership sample right)
+ (&;membership sample left))
+ (d.< (&;membership sample left)
+ (&;membership sample (&;difference left right)))))
+ ))))
(context: "From predicates and sets"
- [#let [set-10 (set;from-list number;Hash<Nat> (list;n.range +0 +10))]
- sample (|> r;nat (:: @ map (n.% +20)))]
- ($_ seq
- (test "Values that satisfy a predicate have membership = 1.
+ (<| (times +100)
+ (do @
+ [#let [set-10 (set;from-list number;Hash<Nat> (list;n.range +0 +10))]
+ sample (|> r;nat (:: @ map (n.% +20)))]
+ ($_ seq
+ (test "Values that satisfy a predicate have membership = 1.
Values that don't have membership = 0."
- (B/= (d.= ~true (&;membership sample (&;from-predicate n.even?)))
- (n.even? sample)))
+ (B/= (d.= ~true (&;membership sample (&;from-predicate n.even?)))
+ (n.even? sample)))
- (test "Values that belong to a set have membership = 1.
+ (test "Values that belong to a set have membership = 1.
Values that don't have membership = 0."
- (B/= (d.= ~true (&;membership sample (&;from-set set-10)))
- (set;member? set-10 sample)))
- ))
+ (B/= (d.= ~true (&;membership sample (&;from-set set-10)))
+ (set;member? set-10 sample)))
+ ))))
(context: "Thresholds"
- [fuzzy gen-triangle
- sample r;frac
- threshold r;deg
- #let [vip-fuzzy (&;cut threshold fuzzy)
- member? (&;to-predicate threshold fuzzy)]]
- ($_ seq
- (test "Can increase the threshold of membership of a fuzzy set."
- (B/= (d.> ~false (&;membership sample vip-fuzzy))
- (d.> threshold (&;membership sample fuzzy))))
-
- (test "Can turn fuzzy sets into predicates through a threshold."
- (B/= (member? sample)
- (d.> threshold (&;membership sample fuzzy))))
- ))
+ (<| (times +100)
+ (do @
+ [fuzzy gen-triangle
+ sample r;frac
+ threshold r;deg
+ #let [vip-fuzzy (&;cut threshold fuzzy)
+ member? (&;to-predicate threshold fuzzy)]]
+ ($_ seq
+ (test "Can increase the threshold of membership of a fuzzy set."
+ (B/= (d.> ~false (&;membership sample vip-fuzzy))
+ (d.> threshold (&;membership sample fuzzy))))
+
+ (test "Can turn fuzzy sets into predicates through a threshold."
+ (B/= (member? sample)
+ (d.> threshold (&;membership sample fuzzy))))
+ ))))
diff --git a/stdlib/test/test/lux/math/random.lux b/stdlib/test/test/lux/math/random.lux
index c98f75c20..5efacca05 100644
--- a/stdlib/test/test/lux/math/random.lux
+++ b/stdlib/test/test/lux/math/random.lux
@@ -15,40 +15,42 @@
lux/test)
(context: "Random."
- [size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10))))
- _list (r;list size r;nat)
- _sequence (r;sequence size r;nat)
- _array (r;array size r;nat)
- _queue (r;queue size r;nat)
- _stack (r;stack size r;nat)
- _set (r;set number;Hash<Nat> size r;nat)
- _dict (r;dict number;Hash<Nat> size r;nat r;nat)
- top r;nat
- filtered (|> r;nat (r;filter (n.<= top)))
- shuffle-seed r;nat
- #let [sorted (|> _sequence sequence;to-list (list;sort n.<))
- shuffled (|> sorted sequence;from-list (r;shuffle shuffle-seed))
- re-sorted (|> shuffled sequence;to-list (list;sort n.<))]]
- ($_ seq
- (test "Can produce lists."
- (n.= size (list;size _list)))
- (test "Can produce sequences."
- (n.= size (sequence;size _sequence)))
- (test "Can produce arrays."
- (n.= size (array;size _array)))
- (test "Can produce queues."
- (n.= size (queue;size _queue)))
- (test "Can produce stacks."
- (n.= size (stack;size _stack)))
- (test "Can produce sets."
- (n.= size (set;size _set)))
- (test "Can produce dicts."
- (n.= size (dict;size _dict)))
- (test "Can filter values."
- (n.<= top filtered))
- (test "Can shuffle sequences."
- (let [(^open "v/") (sequence;Eq<Sequence> number;Eq<Nat>)
- sorted (sequence;from-list sorted)]
- (and (not (v/= sorted shuffled))
- (v/= sorted (sequence;from-list re-sorted)))))
- ))
+ (<| (times +100)
+ (do @
+ [size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10))))
+ _list (r;list size r;nat)
+ _sequence (r;sequence size r;nat)
+ _array (r;array size r;nat)
+ _queue (r;queue size r;nat)
+ _stack (r;stack size r;nat)
+ _set (r;set number;Hash<Nat> size r;nat)
+ _dict (r;dict number;Hash<Nat> size r;nat r;nat)
+ top r;nat
+ filtered (|> r;nat (r;filter (n.<= top)))
+ shuffle-seed r;nat
+ #let [sorted (|> _sequence sequence;to-list (list;sort n.<))
+ shuffled (|> sorted sequence;from-list (r;shuffle shuffle-seed))
+ re-sorted (|> shuffled sequence;to-list (list;sort n.<))]]
+ ($_ seq
+ (test "Can produce lists."
+ (n.= size (list;size _list)))
+ (test "Can produce sequences."
+ (n.= size (sequence;size _sequence)))
+ (test "Can produce arrays."
+ (n.= size (array;size _array)))
+ (test "Can produce queues."
+ (n.= size (queue;size _queue)))
+ (test "Can produce stacks."
+ (n.= size (stack;size _stack)))
+ (test "Can produce sets."
+ (n.= size (set;size _set)))
+ (test "Can produce dicts."
+ (n.= size (dict;size _dict)))
+ (test "Can filter values."
+ (n.<= top filtered))
+ (test "Can shuffle sequences."
+ (let [(^open "v/") (sequence;Eq<Sequence> number;Eq<Nat>)
+ sorted (sequence;from-list sorted)]
+ (and (not (v/= sorted shuffled))
+ (v/= sorted (sequence;from-list re-sorted)))))
+ ))))
diff --git a/stdlib/test/test/lux/meta/poly/eq.lux b/stdlib/test/test/lux/meta/poly/eq.lux
index 28cc1167a..c0644a7fa 100644
--- a/stdlib/test/test/lux/meta/poly/eq.lux
+++ b/stdlib/test/test/lux/meta/poly/eq.lux
@@ -64,7 +64,9 @@
## [Tests]
(context: "Eq polytypism"
- [sample gen-record
- #let [(^open "&/") Eq<Record>]]
- (test "Every instance equals itself."
- (&/= sample sample)))
+ (<| (times +100)
+ (do @
+ [sample gen-record
+ #let [(^open "&/") Eq<Record>]]
+ (test "Every instance equals itself."
+ (&/= sample sample)))))
diff --git a/stdlib/test/test/lux/meta/type.lux b/stdlib/test/test/lux/meta/type.lux
index 062021a3c..abddcc033 100644
--- a/stdlib/test/test/lux/meta/type.lux
+++ b/stdlib/test/test/lux/meta/type.lux
@@ -45,17 +45,19 @@
## [Tests]
(context: "Types"
- [sample gen-type]
- (test "Every type is equal to itself."
- (:: &;Eq<Type> = sample sample)))
+ (<| (times +100)
+ (do @
+ [sample gen-type]
+ (test "Every type is equal to itself."
+ (:: &;Eq<Type> = sample sample)))))
(context: "Type application"
(test "Can apply quantified types (universal and existential quantification)."
(and (maybe;default false
- (do maybe;Monad<Maybe>
- [partial (&;apply (list Bool) Ann)
- full (&;apply (list Int) partial)]
- (wrap (:: &;Eq<Type> = full (#;Product Bool Int)))))
+ (do maybe;Monad<Maybe>
+ [partial (&;apply (list Bool) Ann)
+ full (&;apply (list Int) partial)]
+ (wrap (:: &;Eq<Type> = full (#;Product Bool Int)))))
(|> (&;apply (list Bool) Text)
(case> #;None true _ false)))))
@@ -79,79 +81,85 @@
(&;un-name aliased)))))))
(context: "Type construction [structs]"
- [size (|> r;nat (:: @ map (n.% +3)))
- members (|> gen-type
- (r;filter (function [type]
- (case type
- (^or (#;Sum _) (#;Product _))
- false
-
- _
- true)))
- (list;repeat size)
- (M;seq @))
- #let [(^open "&/") &;Eq<Type>
- (^open "L/") (list;Eq<List> &;Eq<Type>)]]
- (with-expansions
- [<struct-tests> (do-template [<desc> <ctor> <dtor> <unit>]
- [(test (format "Can build and tear-down " <desc> " types.")
- (let [flat (|> members <ctor> <dtor>)]
- (or (L/= members flat)
- (and (L/= (list) members)
- (L/= (list <unit>) flat)))))]
-
- ["variant" &;variant &;flatten-variant Void]
- ["tuple" &;tuple &;flatten-tuple Unit]
- )]
- ($_ seq
- <struct-tests>
- )))
+ (<| (times +100)
+ (do @
+ [size (|> r;nat (:: @ map (n.% +3)))
+ members (|> gen-type
+ (r;filter (function [type]
+ (case type
+ (^or (#;Sum _) (#;Product _))
+ false
+
+ _
+ true)))
+ (list;repeat size)
+ (M;seq @))
+ #let [(^open "&/") &;Eq<Type>
+ (^open "L/") (list;Eq<List> &;Eq<Type>)]]
+ (with-expansions
+ [<struct-tests> (do-template [<desc> <ctor> <dtor> <unit>]
+ [(test (format "Can build and tear-down " <desc> " types.")
+ (let [flat (|> members <ctor> <dtor>)]
+ (or (L/= members flat)
+ (and (L/= (list) members)
+ (L/= (list <unit>) flat)))))]
+
+ ["variant" &;variant &;flatten-variant Void]
+ ["tuple" &;tuple &;flatten-tuple Unit]
+ )]
+ ($_ seq
+ <struct-tests>
+ )))))
(context: "Type construction [parameterized]"
- [size (|> r;nat (:: @ map (n.% +3)))
- members (M;seq @ (list;repeat size gen-type))
- extra (|> gen-type
- (r;filter (function [type]
- (case type
- (^or (#;Function _) (#;Apply _))
- false
-
- _
- true))))
- #let [(^open "&/") &;Eq<Type>
- (^open "L/") (list;Eq<List> &;Eq<Type>)]]
- ($_ seq
- (test "Can build and tear-down function types."
- (let [[inputs output] (|> (&;function members extra) &;flatten-function)]
- (and (L/= members inputs)
- (&/= extra output))))
-
- (test "Can build and tear-down application types."
- (let [[tfunc tparams] (|> extra (&;application members) &;flatten-application)]
- (n.= (list;size members) (list;size tparams))))
- ))
+ (<| (times +100)
+ (do @
+ [size (|> r;nat (:: @ map (n.% +3)))
+ members (M;seq @ (list;repeat size gen-type))
+ extra (|> gen-type
+ (r;filter (function [type]
+ (case type
+ (^or (#;Function _) (#;Apply _))
+ false
+
+ _
+ true))))
+ #let [(^open "&/") &;Eq<Type>
+ (^open "L/") (list;Eq<List> &;Eq<Type>)]]
+ ($_ seq
+ (test "Can build and tear-down function types."
+ (let [[inputs output] (|> (&;function members extra) &;flatten-function)]
+ (and (L/= members inputs)
+ (&/= extra output))))
+
+ (test "Can build and tear-down application types."
+ (let [[tfunc tparams] (|> extra (&;application members) &;flatten-application)]
+ (n.= (list;size members) (list;size tparams))))
+ ))))
(context: "Type construction [higher order]"
- [size (|> r;nat (:: @ map (n.% +3)))
- extra (|> gen-type
- (r;filter (function [type]
- (case type
- (^or (#;UnivQ _) (#;ExQ _))
- false
-
- _
- true))))
- #let [(^open "&/") &;Eq<Type>]]
- (with-expansions
- [<quant-tests> (do-template [<desc> <ctor> <dtor>]
- [(test (format "Can build and tear-down " <desc> " types.")
- (let [[flat-size flat-body] (|> extra (<ctor> size) <dtor>)]
- (and (n.= size flat-size)
- (&/= extra flat-body))))]
-
- ["universally-quantified" &;univ-q &;flatten-univ-q]
- ["existentially-quantified" &;ex-q &;flatten-ex-q]
- )]
- ($_ seq
- <quant-tests>
- )))
+ (<| (times +100)
+ (do @
+ [size (|> r;nat (:: @ map (n.% +3)))
+ extra (|> gen-type
+ (r;filter (function [type]
+ (case type
+ (^or (#;UnivQ _) (#;ExQ _))
+ false
+
+ _
+ true))))
+ #let [(^open "&/") &;Eq<Type>]]
+ (with-expansions
+ [<quant-tests> (do-template [<desc> <ctor> <dtor>]
+ [(test (format "Can build and tear-down " <desc> " types.")
+ (let [[flat-size flat-body] (|> extra (<ctor> size) <dtor>)]
+ (and (n.= size flat-size)
+ (&/= extra flat-body))))]
+
+ ["universally-quantified" &;univ-q &;flatten-univ-q]
+ ["existentially-quantified" &;ex-q &;flatten-ex-q]
+ )]
+ ($_ seq
+ <quant-tests>
+ )))))
diff --git a/stdlib/test/test/lux/meta/type/auto.lux b/stdlib/test/test/lux/meta/type/auto.lux
index 6e506e9f8..278bad106 100644
--- a/stdlib/test/test/lux/meta/type/auto.lux
+++ b/stdlib/test/test/lux/meta/type/auto.lux
@@ -16,24 +16,26 @@
lux/test)
(context: "Automatic structure selection"
- [x r;nat
- y r;nat]
- ($_ seq
- (test "Can automatically select first-order structures."
- (let [(^open "L/") (list;Eq<List> number;Eq<Nat>)]
- (and (B/= (:: number;Eq<Nat> = x y)
- (::: = x y))
- (L/= (list;n.range +1 +10)
- (::: map n.inc (list;n.range +0 +9)))
- )))
-
- (test "Can automatically select second-order structures."
- (::: =
- (list;n.range +1 +10)
- (list;n.range +1 +10)))
+ (<| (times +100)
+ (do @
+ [x r;nat
+ y r;nat]
+ ($_ seq
+ (test "Can automatically select first-order structures."
+ (let [(^open "L/") (list;Eq<List> number;Eq<Nat>)]
+ (and (B/= (:: number;Eq<Nat> = x y)
+ (::: = x y))
+ (L/= (list;n.range +1 +10)
+ (::: map n.inc (list;n.range +0 +9)))
+ )))
+
+ (test "Can automatically select second-order structures."
+ (::: =
+ (list;n.range +1 +10)
+ (list;n.range +1 +10)))
- (test "Can automatically select third-order structures."
- (let [lln (::: map (list;n.range +1)
- (list;n.range +1 +10))]
- (::: = lln lln)))
- ))
+ (test "Can automatically select third-order structures."
+ (let [lln (::: map (list;n.range +1)
+ (list;n.range +1 +10))]
+ (::: = lln lln)))
+ ))))
diff --git a/stdlib/test/test/lux/meta/type/check.lux b/stdlib/test/test/lux/meta/type/check.lux
index c6ac6c9b1..253ce5939 100644
--- a/stdlib/test/test/lux/meta/type/check.lux
+++ b/stdlib/test/test/lux/meta/type/check.lux
@@ -74,14 +74,16 @@
## [Tests]
(context: "Top and Bottom"
- [sample (|> gen-type (r;filter valid-type?))]
- ($_ seq
- (test "Top is the super-type of everything."
- (@;checks? Top sample))
+ (<| (times +100)
+ (do @
+ [sample (|> gen-type (r;filter valid-type?))]
+ ($_ seq
+ (test "Top is the super-type of everything."
+ (@;checks? Top sample))
- (test "Bottom is the sub-type of everything."
- (@;checks? sample Bottom))
- ))
+ (test "Bottom is the sub-type of everything."
+ (@;checks? sample Bottom))
+ ))))
(context: "Simple type-checking."
($_ seq
@@ -120,32 +122,36 @@
))
(context: "Type application"
- [meta gen-type
- data gen-type]
- (test "Can type-check type application."
- (and (@;checks? (|> Ann (#;Apply meta) (#;Apply data))
- (type;tuple (list meta data)))
- (@;checks? (type;tuple (list meta data))
- (|> Ann (#;Apply meta) (#;Apply data))))))
+ (<| (times +100)
+ (do @
+ [meta gen-type
+ data gen-type]
+ (test "Can type-check type application."
+ (and (@;checks? (|> Ann (#;Apply meta) (#;Apply data))
+ (type;tuple (list meta data)))
+ (@;checks? (type;tuple (list meta data))
+ (|> Ann (#;Apply meta) (#;Apply data))))))))
(context: "Host types"
- [nameL gen-name
- nameR (|> gen-name (r;filter (. not (text/= nameL))))
- paramL gen-type
- paramR (|> gen-type (r;filter (|>. (@;checks? paramL) not)))]
- ($_ seq
- (test "Host types match when they have the same name and the same parameters."
- (@;checks? (#;Host nameL (list paramL))
- (#;Host nameL (list paramL))))
-
- (test "Names matter to host types."
- (not (@;checks? (#;Host nameL (list paramL))
- (#;Host nameR (list paramL)))))
-
- (test "Parameters matter to host types."
- (not (@;checks? (#;Host nameL (list paramL))
- (#;Host nameL (list paramR)))))
- ))
+ (<| (times +100)
+ (do @
+ [nameL gen-name
+ nameR (|> gen-name (r;filter (. not (text/= nameL))))
+ paramL gen-type
+ paramR (|> gen-type (r;filter (|>. (@;checks? paramL) not)))]
+ ($_ seq
+ (test "Host types match when they have the same name and the same parameters."
+ (@;checks? (#;Host nameL (list paramL))
+ (#;Host nameL (list paramL))))
+
+ (test "Names matter to host types."
+ (not (@;checks? (#;Host nameL (list paramL))
+ (#;Host nameR (list paramL)))))
+
+ (test "Parameters matter to host types."
+ (not (@;checks? (#;Host nameL (list paramL))
+ (#;Host nameL (list paramR)))))
+ ))))
(context: "Type-vars"
($_ seq
diff --git a/stdlib/test/test/lux/time/date.lux b/stdlib/test/test/lux/time/date.lux
index baac8d22c..634984bbc 100644
--- a/stdlib/test/test/lux/time/date.lux
+++ b/stdlib/test/test/lux/time/date.lux
@@ -26,31 +26,37 @@
(r/wrap #@;December))))))
(context: "(Month) Eq."
- [sample month
- #let [(^open "@/") @;Eq<Month>]]
- (test "Every value equals itself."
- (@/= sample sample)))
+ (<| (times +100)
+ (do @
+ [sample month
+ #let [(^open "@/") @;Eq<Month>]]
+ (test "Every value equals itself."
+ (@/= sample sample)))))
(context: "(Month) Order."
- [reference month
- sample month
- #let [(^open "@/") @;Order<Month>]]
- (test "Valid Order."
- (and (or (@/< reference sample)
- (@/>= reference sample))
- (or (@/> reference sample)
- (@/<= reference sample)))))
+ (<| (times +100)
+ (do @
+ [reference month
+ sample month
+ #let [(^open "@/") @;Order<Month>]]
+ (test "Valid Order."
+ (and (or (@/< reference sample)
+ (@/>= reference sample))
+ (or (@/> reference sample)
+ (@/<= reference sample)))))))
(context: "(Month) Enum."
- [sample month
- #let [(^open "@/") @;Enum<Month>]]
- (test "Valid Enum."
- (and (not (@/= (@/succ sample)
- sample))
- (not (@/= (@/pred sample)
- sample))
- (|> sample @/succ @/pred (@/= sample))
- (|> sample @/pred @/succ (@/= sample)))))
+ (<| (times +100)
+ (do @
+ [sample month
+ #let [(^open "@/") @;Enum<Month>]]
+ (test "Valid Enum."
+ (and (not (@/= (@/succ sample)
+ sample))
+ (not (@/= (@/pred sample)
+ sample))
+ (|> sample @/succ @/pred (@/= sample))
+ (|> sample @/pred @/succ (@/= sample)))))))
(def: day
(r;Random @;Day)
@@ -63,63 +69,74 @@
(r/wrap #@;Saturday))))
(context: "(Day) Eq."
- [sample day
- #let [(^open "@/") @;Eq<Day>]]
- (test "Every value equals itself."
- (@/= sample sample)))
+ (<| (times +100)
+ (do @
+ [sample day
+ #let [(^open "@/") @;Eq<Day>]]
+ (test "Every value equals itself."
+ (@/= sample sample)))))
(context: "(Day) Order."
- [reference day
- sample day
- #let [(^open "@/") @;Order<Day>]]
- (test "Valid Order."
- (and (or (@/< reference sample)
- (@/>= reference sample))
- (or (@/> reference sample)
- (@/<= reference sample)))))
+ (<| (times +100)
+ (do @
+ [reference day
+ sample day
+ #let [(^open "@/") @;Order<Day>]]
+ (test "Valid Order."
+ (and (or (@/< reference sample)
+ (@/>= reference sample))
+ (or (@/> reference sample)
+ (@/<= reference sample)))))))
(context: "(Day) Enum."
- [sample day
- #let [(^open "@/") @;Enum<Day>]]
- (test "Valid Enum."
- (and (not (@/= (@/succ sample)
- sample))
- (not (@/= (@/pred sample)
- sample))
- (|> sample @/succ @/pred (@/= sample))
- (|> sample @/pred @/succ (@/= sample)))))
+ (<| (times +100)
+ (do @
+ [sample day
+ #let [(^open "@/") @;Enum<Day>]]
+ (test "Valid Enum."
+ (and (not (@/= (@/succ sample)
+ sample))
+ (not (@/= (@/pred sample)
+ sample))
+ (|> sample @/succ @/pred (@/= sample))
+ (|> sample @/pred @/succ (@/= sample)))))))
(def: #export date
(r;Random @;Date)
(|> _instant;instant (:: r;Monad<Random> map @instant;date)))
(context: "(Date) Eq."
- [sample date
- #let [(^open "@/") @;Eq<Date>]]
- (test "Every value equals itself."
- (@/= sample sample)))
+ (<| (times +100)
+ (do @
+ [sample date
+ #let [(^open "@/") @;Eq<Date>]]
+ (test "Every value equals itself."
+ (@/= sample sample)))))
(context: "(Date) Order."
- [reference date
- sample date
- #let [(^open "@/") @;Order<Date>]]
- (test "Valid Order."
- (and (or (@/< reference sample)
- (@/>= reference sample))
- (or (@/> reference sample)
- (@/<= reference sample)))))
+ (<| (times +100)
+ (do @
+ [reference date
+ sample date
+ #let [(^open "@/") @;Order<Date>]]
+ (test "Valid Order."
+ (and (or (@/< reference sample)
+ (@/>= reference sample))
+ (or (@/> reference sample)
+ (@/<= reference sample)))))))
(context: "(Date) Codec"
- #seed +1501531301120
- [sample date
- #let [(^open "@/") @;Eq<Date>
- (^open "@/") @;Codec<Text,Date>]]
- (test "Can encode/decode dates."
- (|> sample
- @/encode
- @/decode
- (pipe;case> (#E;Success decoded)
- (@/= sample decoded)
+ (<| (seed +1501531301120)
+ (do @
+ [sample date
+ #let [(^open "@/") @;Eq<Date>
+ (^open "@/") @;Codec<Text,Date>]]
+ (test "Can encode/decode dates."
+ (|> sample
+ @/encode
+ @/decode
+ (pipe;case> (#E;Success decoded)
+ (@/= sample decoded)
- (#E;Error error)
- false))))
+ (#E;Error error)
+ false))))))
diff --git a/stdlib/test/test/lux/time/duration.lux b/stdlib/test/test/lux/time/duration.lux
index be0637ab7..ef891fcf6 100644
--- a/stdlib/test/test/lux/time/duration.lux
+++ b/stdlib/test/test/lux/time/duration.lux
@@ -12,61 +12,71 @@
(|> r;int (:: r;Monad<Random> map @;from-millis)))
(context: "Conversion."
- [millis r;int]
- (test "Can convert from/to milliseconds."
- (|> millis @;from-millis @;to-millis (i.= millis))))
+ (<| (times +100)
+ (do @
+ [millis r;int]
+ (test "Can convert from/to milliseconds."
+ (|> millis @;from-millis @;to-millis (i.= millis))))))
(context: "Equality"
- [sample duration
- #let [(^open "@/") @;Eq<Duration>]]
- (test "Every duration equals itself."
- (@/= sample sample)))
+ (<| (times +100)
+ (do @
+ [sample duration
+ #let [(^open "@/") @;Eq<Duration>]]
+ (test "Every duration equals itself."
+ (@/= sample sample)))))
(context: "Order"
- [reference duration
- sample duration
- #let [(^open "@/") @;Order<Duration>]]
- (test "Can compare times."
- (and (or (@/< reference sample)
- (@/>= reference sample))
- (or (@/> reference sample)
- (@/<= reference sample)))))
+ (<| (times +100)
+ (do @
+ [reference duration
+ sample duration
+ #let [(^open "@/") @;Order<Duration>]]
+ (test "Can compare times."
+ (and (or (@/< reference sample)
+ (@/>= reference sample))
+ (or (@/> reference sample)
+ (@/<= reference sample)))))))
(context: "Arithmetic."
- [sample (|> duration (:: @ map (@;frame @;day)))
- frame duration
- factor (|> r;int (:: @ map (|>. (i.% 10) (i.max 1))))
- #let [(^open "@/") @;Order<Duration>]]
- ($_ seq
- (test "Can scale a duration."
- (|> sample (@;scale factor) (@;query sample) (i.= factor)))
- (test "Scaling a duration by one does not change it."
- (|> sample (@;scale 1) (@/= sample)))
- (test "Merging with the empty duration changes nothing."
- (|> sample (@;merge @;empty) (@/= sample)))
- (test "Merging a duration with it's opposite yields an empty duration."
- (|> sample (@;merge (@;scale -1 sample)) (@/= @;empty)))
- (test "Can frame a duration in terms of another."
- (cond (and (@;positive? frame) (@;positive? sample))
- (|> sample (@;frame frame) (@/< frame))
+ (<| (times +100)
+ (do @
+ [sample (|> duration (:: @ map (@;frame @;day)))
+ frame duration
+ factor (|> r;int (:: @ map (|>. (i.% 10) (i.max 1))))
+ #let [(^open "@/") @;Order<Duration>]]
+ ($_ seq
+ (test "Can scale a duration."
+ (|> sample (@;scale factor) (@;query sample) (i.= factor)))
+ (test "Scaling a duration by one does not change it."
+ (|> sample (@;scale 1) (@/= sample)))
+ (test "Merging with the empty duration changes nothing."
+ (|> sample (@;merge @;empty) (@/= sample)))
+ (test "Merging a duration with it's opposite yields an empty duration."
+ (|> sample (@;merge (@;scale -1 sample)) (@/= @;empty)))
+ (test "Can frame a duration in terms of another."
+ (cond (and (@;positive? frame) (@;positive? sample))
+ (|> sample (@;frame frame) (@/< frame))
- (and (@;negative? frame) (@;negative? sample))
- (|> sample (@;frame frame) (@/> frame))
+ (and (@;negative? frame) (@;negative? sample))
+ (|> sample (@;frame frame) (@/> frame))
- (or (or (@;neutral? frame) (@;neutral? sample))
- (|> sample
- (@;frame frame)
- (@;scale -1)
- (@/< (if (@;negative? frame)
- (@;scale -1 frame)
- frame))))))))
+ (or (or (@;neutral? frame) (@;neutral? sample))
+ (|> sample
+ (@;frame frame)
+ (@;scale -1)
+ (@/< (if (@;negative? frame)
+ (@;scale -1 frame)
+ frame))))))))))
(context: "Codec"
- [sample duration
- #let [(^open "@/") @;Eq<Duration>
- (^open "@/") @;Codec<Text,Duration>]]
- (test "Can encode/decode durations."
- (E;default false
- (do E;Monad<Error>
- [decoded (|> sample @/encode @/decode)]
- (wrap (@/= sample decoded))))))
+ (<| (times +100)
+ (do @
+ [sample duration
+ #let [(^open "@/") @;Eq<Duration>
+ (^open "@/") @;Codec<Text,Duration>]]
+ (test "Can encode/decode durations."
+ (E;default false
+ (do E;Monad<Error>
+ [decoded (|> sample @/encode @/decode)]
+ (wrap (@/= sample decoded))))))))
diff --git a/stdlib/test/test/lux/time/instant.lux b/stdlib/test/test/lux/time/instant.lux
index df59f0743..e26f7397d 100644
--- a/stdlib/test/test/lux/time/instant.lux
+++ b/stdlib/test/test/lux/time/instant.lux
@@ -21,62 +21,74 @@
(|> r;int (:: r;Monad<Random> map (|>. (i.% boundary) @;from-millis))))
(context: "Conversion."
- [millis r;int]
- (test "Can convert from/to milliseconds."
- (|> millis @;from-millis @;to-millis (i.= millis))))
+ (<| (times +100)
+ (do @
+ [millis r;int]
+ (test "Can convert from/to milliseconds."
+ (|> millis @;from-millis @;to-millis (i.= millis))))))
(context: "Equality"
- [sample instant
- #let [(^open "@/") @;Eq<Instant>]]
- (test "Every instant equals itself."
- (@/= sample sample)))
+ (<| (times +100)
+ (do @
+ [sample instant
+ #let [(^open "@/") @;Eq<Instant>]]
+ (test "Every instant equals itself."
+ (@/= sample sample)))))
(context: "Order"
- [reference instant
- sample instant
- #let [(^open "@/") @;Order<Instant>]]
- (test "Can compare instants."
- (and (or (@/< reference sample)
- (@/>= reference sample))
- (or (@/> reference sample)
- (@/<= reference sample)))))
+ (<| (times +100)
+ (do @
+ [reference instant
+ sample instant
+ #let [(^open "@/") @;Order<Instant>]]
+ (test "Can compare instants."
+ (and (or (@/< reference sample)
+ (@/>= reference sample))
+ (or (@/> reference sample)
+ (@/<= reference sample)))))))
(context: "Enum"
- [sample instant
- #let [(^open "@/") @;Enum<Instant>]]
- (test "Valid Enum."
- (and (not (@/= (@/succ sample)
- sample))
- (not (@/= (@/pred sample)
- sample))
- (|> sample @/succ @/pred (@/= sample))
- (|> sample @/pred @/succ (@/= sample)))))
+ (<| (times +100)
+ (do @
+ [sample instant
+ #let [(^open "@/") @;Enum<Instant>]]
+ (test "Valid Enum."
+ (and (not (@/= (@/succ sample)
+ sample))
+ (not (@/= (@/pred sample)
+ sample))
+ (|> sample @/succ @/pred (@/= sample))
+ (|> sample @/pred @/succ (@/= sample)))))))
(context: "Arithmetic"
- [sample instant
- span _duration;duration
- #let [(^open "@/") @;Eq<Instant>
- (^open "@d/") @d;Eq<Duration>]]
- ($_ seq
- (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)))))
+ (<| (times +100)
+ (do @
+ [sample instant
+ span _duration;duration
+ #let [(^open "@/") @;Eq<Instant>
+ (^open "@d/") @d;Eq<Duration>]]
+ ($_ seq
+ (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)))))))
(context: "Codec"
- [sample instant
- #let [(^open "@/") @;Eq<Instant>
- (^open "@/") @;Codec<Text,Instant>]]
- (test "Can encode/decode instants."
- (|> sample
- @/encode
- @/decode
- (case> (#E;Success decoded)
- (@/= sample decoded)
+ (<| (times +100)
+ (do @
+ [sample instant
+ #let [(^open "@/") @;Eq<Instant>
+ (^open "@/") @;Codec<Text,Instant>]]
+ (test "Can encode/decode instants."
+ (|> sample
+ @/encode
+ @/decode
+ (case> (#E;Success decoded)
+ (@/= sample decoded)
- (#E;Error error)
- false))))
+ (#E;Error error)
+ false))))))
diff --git a/stdlib/test/test/lux/world/blob.lux b/stdlib/test/test/lux/world/blob.lux
index 5a616f3e4..d523f5823 100644
--- a/stdlib/test/test/lux/world/blob.lux
+++ b/stdlib/test/test/lux/world/blob.lux
@@ -33,75 +33,77 @@
(wrap blob))))))
(context: "Blob."
- [blob-size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +8))))
- random-blob (blob blob-size)
- #let [clean-blob (@;create blob-size)
- size (@;size clean-blob)]
- value r;nat
- idx (|> r;nat (:: @ map (n.% size)))
- [from to] (|> (r;list +2 (|> r;nat (:: @ map (n.% size))))
- (:: @ map
- (|>. (list;sort n.<)
- (pipe;case> (^ (list from to))
- [from to]
+ (<| (times +100)
+ (do @
+ [blob-size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +8))))
+ random-blob (blob blob-size)
+ #let [clean-blob (@;create blob-size)
+ size (@;size clean-blob)]
+ value r;nat
+ idx (|> r;nat (:: @ map (n.% size)))
+ [from to] (|> (r;list +2 (|> r;nat (:: @ map (n.% size))))
+ (:: @ map
+ (|>. (list;sort n.<)
+ (pipe;case> (^ (list from to))
+ [from to]
- _
- (undefined)))))
- #let [value-8 (n.% (bit;shift-left +8 +1) value)
- value-16 (n.% (bit;shift-left +16 +1) value)
- value-32 (n.% (bit;shift-left +32 +1) value)
- value-64 value
- slice-size (|> to (n.- from) n.inc)
- random-slice (E;assume (@;slice from to random-blob))]]
- ($_ seq
- (test "Has equality."
- (and (:: @;Eq<Blob> = clean-blob clean-blob)
- (:: @;Eq<Blob> =
- (E;assume (@;slice from to clean-blob))
- (E;assume (@;slice from to clean-blob)))))
- (test "Can get size of blob."
- (n.= blob-size size))
- (test "Can read/write 8-bit values."
- (succeed
- (do E;Monad<Error>
- [_ (@;write-8 idx value-8 clean-blob)
- output-8 (@;read-8 idx clean-blob)]
- (wrap (n.= value-8 output-8)))))
- (test "Can read/write 16-bit values."
- (or (n.>= size (n.+ +1 idx))
- (succeed
- (do E;Monad<Error>
- [_ (@;write-16 idx value-16 clean-blob)
- output-16 (@;read-16 idx clean-blob)]
- (wrap (n.= value-16 output-16))))))
- (test "Can read/write 32-bit values."
- (or (n.>= size (n.+ +3 idx))
- (succeed
- (do E;Monad<Error>
- [_ (@;write-32 idx value-32 clean-blob)
- output-32 (@;read-32 idx clean-blob)]
- (wrap (n.= value-32 output-32))))))
- (test "Can read/write 64-bit values."
- (or (n.>= size (n.+ +7 idx))
- (succeed
- (do E;Monad<Error>
- [_ (@;write-64 idx value-64 clean-blob)
- output-64 (@;read-64 idx clean-blob)]
- (wrap (n.= value-64 output-64))))))
- (test "Can slice blobs."
- (and (n.= slice-size (@;size random-slice))
- (loop [idx +0]
- (let [loop-recur recur]
- (if (n.< slice-size idx)
- (and (succeed
- (do E;Monad<Error>
- [reference (@;read-8 (n.+ from idx) random-blob)
- sample (@;read-8 idx random-slice)]
- (wrap (n.= reference sample))))
- (loop-recur (n.inc idx)))
- true)))))
- (test "Slicing the whole blob does not change anything."
- (:: @;Eq<Blob> =
- random-blob
- (E;assume (@;slice +0 (n.dec blob-size) random-blob))))
- ))
+ _
+ (undefined)))))
+ #let [value-8 (n.% (bit;shift-left +8 +1) value)
+ value-16 (n.% (bit;shift-left +16 +1) value)
+ value-32 (n.% (bit;shift-left +32 +1) value)
+ value-64 value
+ slice-size (|> to (n.- from) n.inc)
+ random-slice (E;assume (@;slice from to random-blob))]]
+ ($_ seq
+ (test "Has equality."
+ (and (:: @;Eq<Blob> = clean-blob clean-blob)
+ (:: @;Eq<Blob> =
+ (E;assume (@;slice from to clean-blob))
+ (E;assume (@;slice from to clean-blob)))))
+ (test "Can get size of blob."
+ (n.= blob-size size))
+ (test "Can read/write 8-bit values."
+ (succeed
+ (do E;Monad<Error>
+ [_ (@;write-8 idx value-8 clean-blob)
+ output-8 (@;read-8 idx clean-blob)]
+ (wrap (n.= value-8 output-8)))))
+ (test "Can read/write 16-bit values."
+ (or (n.>= size (n.+ +1 idx))
+ (succeed
+ (do E;Monad<Error>
+ [_ (@;write-16 idx value-16 clean-blob)
+ output-16 (@;read-16 idx clean-blob)]
+ (wrap (n.= value-16 output-16))))))
+ (test "Can read/write 32-bit values."
+ (or (n.>= size (n.+ +3 idx))
+ (succeed
+ (do E;Monad<Error>
+ [_ (@;write-32 idx value-32 clean-blob)
+ output-32 (@;read-32 idx clean-blob)]
+ (wrap (n.= value-32 output-32))))))
+ (test "Can read/write 64-bit values."
+ (or (n.>= size (n.+ +7 idx))
+ (succeed
+ (do E;Monad<Error>
+ [_ (@;write-64 idx value-64 clean-blob)
+ output-64 (@;read-64 idx clean-blob)]
+ (wrap (n.= value-64 output-64))))))
+ (test "Can slice blobs."
+ (and (n.= slice-size (@;size random-slice))
+ (loop [idx +0]
+ (let [loop-recur recur]
+ (if (n.< slice-size idx)
+ (and (succeed
+ (do E;Monad<Error>
+ [reference (@;read-8 (n.+ from idx) random-blob)
+ sample (@;read-8 idx random-slice)]
+ (wrap (n.= reference sample))))
+ (loop-recur (n.inc idx)))
+ true)))))
+ (test "Slicing the whole blob does not change anything."
+ (:: @;Eq<Blob> =
+ random-blob
+ (E;assume (@;slice +0 (n.dec blob-size) random-blob))))
+ ))))
diff --git a/stdlib/test/test/lux/world/file.lux b/stdlib/test/test/lux/world/file.lux
index 32fa33d7d..388e91235 100644
--- a/stdlib/test/test/lux/world/file.lux
+++ b/stdlib/test/test/lux/world/file.lux
@@ -20,143 +20,143 @@
(|>. (i./ 1_000) (i.* 1_000)))
(context: "File system."
- #times +1
- [file-size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10))))
- dataL (_blob;blob file-size)
- dataR (_blob;blob file-size)
- code r;nat
- last-modified (|> r;int (:: @ map (|>. (:: number;Number<Int> abs)
- truncate-millis
- d;from-millis
- i;absolute)))]
- ($_ seq
- (do P;Monad<Promise>
- [#let [file (format "temp_file_" (%n (n.+ +0 code)))]
- result (do T;Monad<Task>
- [pre (@;exists? file)
- _ (@;write dataL file)
- post (@;exists? file)
- deleted? (@;delete file)
- remains? (@;exists? file)]
- (wrap (and (not pre) post
- deleted? (not remains?))))]
- (test "Can create/delete files."
- (E;default false result)))
- (do P;Monad<Promise>
- [#let [file (format "temp_file_" (%n (n.+ +1 code)))]
- result (do T;Monad<Task>
- [_ (@;write dataL file)
- output (@;read file)
- _ (@;delete file)]
- (wrap (:: blob;Eq<Blob> = dataL output)))]
- (test "Can write/read files."
- (E;default false result)))
- (do P;Monad<Promise>
- [#let [file (format "temp_file_" (%n (n.+ +2 code)))]
- result (do T;Monad<Task>
- [_ (@;write dataL file)
- read-size (@;size file)
- _ (@;delete file)]
- (wrap (n.= file-size read-size)))]
- (test "Can read file size."
- (E;default false result)))
- (do P;Monad<Promise>
- [#let [file (format "temp_file_" (%n (n.+ +3 code)))]
- result (do T;Monad<Task>
- [_ (@;write dataL file)
- _ (@;append dataR file)
- output (@;read file)
- read-size (@;size file)
- _ (@;delete file)]
- (wrap (and (n.= (n.* +2 file-size) read-size)
- (:: blob;Eq<Blob> = dataL (E;assume (blob;slice +0 (n.dec file-size) output)))
- (:: blob;Eq<Blob> = dataR (E;assume (blob;slice file-size (n.dec read-size) output))))))]
- (test "Can append to files."
- (E;default false result)))
- (do P;Monad<Promise>
- [#let [dir (format "temp_dir_" (%n (n.+ +4 code)))]
- result (do T;Monad<Task>
- [pre (@;exists? dir)
- _ (@;make-dir dir)
- post (@;exists? dir)
- deleted? (@;delete dir)
- remains? (@;exists? dir)]
- (wrap (and (not pre) post
- deleted? (not remains?))))]
- (test "Can create/delete directories."
- (E;default false result)))
- (do P;Monad<Promise>
- [#let [file (format "temp_file_" (%n (n.+ +5 code)))
- dir (format "temp_dir_" (%n (n.+ +5 code)))]
- result (do T;Monad<Task>
- [_ (@;write dataL file)
- file-is-file (@;file? file)
- file-is-directory (@;directory? file)
- _ (@;delete file)
- _ (@;make-dir dir)
- directory-is-file (@;file? dir)
- directory-is-directory (@;directory? dir)
- _ (@;delete dir)]
- (wrap (and file-is-file (not file-is-directory)
- (not directory-is-file) directory-is-directory)))]
- (test "Can differentiate files from directories."
- (E;default false result)))
- (do P;Monad<Promise>
- [#let [file (format "temp_file_" (%n (n.+ +6 code)))
- dir (format "temp_dir_" (%n (n.+ +6 code)))]
- result (do T;Monad<Task>
- [_ (@;make-dir dir)
- #let [file' (format dir "/" file)]
- _ (@;write dataL file')
- read-size (@;size file')
- deleted-file (@;delete file')
- deleted-dir (@;delete dir)]
- (wrap (and (n.= file-size read-size)
- deleted-file
- deleted-dir)))]
- (test "Can create files inside of directories."
- (E;default false result)))
- (do P;Monad<Promise>
- [#let [file (format "temp_file_" (%n (n.+ +7 code)))
- dir (format "temp_dir_" (%n (n.+ +7 code)))]
- result (do T;Monad<Task>
- [_ (@;make-dir dir)
- #let [file' (format dir "/" file)]
- _ (@;write dataL file')
- children (@;files dir)
- _ (@;delete file')
- _ (@;delete dir)]
- (wrap (case children
- (^ (list child))
- (text;ends-with? file' child)
+ (do @
+ [file-size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10))))
+ dataL (_blob;blob file-size)
+ dataR (_blob;blob file-size)
+ code r;nat
+ last-modified (|> r;int (:: @ map (|>. (:: number;Number<Int> abs)
+ truncate-millis
+ d;from-millis
+ i;absolute)))]
+ ($_ seq
+ (wrap (do P;Monad<Promise>
+ [#let [file (format "temp_file_" (%n (n.+ +0 code)))]
+ result (do T;Monad<Task>
+ [pre (@;exists? file)
+ _ (@;write dataL file)
+ post (@;exists? file)
+ deleted? (@;delete file)
+ remains? (@;exists? file)]
+ (wrap (and (not pre) post
+ deleted? (not remains?))))]
+ (assert "Can create/delete files."
+ (E;default false result))))
+ (wrap (do P;Monad<Promise>
+ [#let [file (format "temp_file_" (%n (n.+ +1 code)))]
+ result (do T;Monad<Task>
+ [_ (@;write dataL file)
+ output (@;read file)
+ _ (@;delete file)]
+ (wrap (:: blob;Eq<Blob> = dataL output)))]
+ (assert "Can write/read files."
+ (E;default false result))))
+ (wrap (do P;Monad<Promise>
+ [#let [file (format "temp_file_" (%n (n.+ +2 code)))]
+ result (do T;Monad<Task>
+ [_ (@;write dataL file)
+ read-size (@;size file)
+ _ (@;delete file)]
+ (wrap (n.= file-size read-size)))]
+ (assert "Can read file size."
+ (E;default false result))))
+ (wrap (do P;Monad<Promise>
+ [#let [file (format "temp_file_" (%n (n.+ +3 code)))]
+ result (do T;Monad<Task>
+ [_ (@;write dataL file)
+ _ (@;append dataR file)
+ output (@;read file)
+ read-size (@;size file)
+ _ (@;delete file)]
+ (wrap (and (n.= (n.* +2 file-size) read-size)
+ (:: blob;Eq<Blob> = dataL (E;assume (blob;slice +0 (n.dec file-size) output)))
+ (:: blob;Eq<Blob> = dataR (E;assume (blob;slice file-size (n.dec read-size) output))))))]
+ (assert "Can append to files."
+ (E;default false result))))
+ (wrap (do P;Monad<Promise>
+ [#let [dir (format "temp_dir_" (%n (n.+ +4 code)))]
+ result (do T;Monad<Task>
+ [pre (@;exists? dir)
+ _ (@;make-dir dir)
+ post (@;exists? dir)
+ deleted? (@;delete dir)
+ remains? (@;exists? dir)]
+ (wrap (and (not pre) post
+ deleted? (not remains?))))]
+ (assert "Can create/delete directories."
+ (E;default false result))))
+ (wrap (do P;Monad<Promise>
+ [#let [file (format "temp_file_" (%n (n.+ +5 code)))
+ dir (format "temp_dir_" (%n (n.+ +5 code)))]
+ result (do T;Monad<Task>
+ [_ (@;write dataL file)
+ file-is-file (@;file? file)
+ file-is-directory (@;directory? file)
+ _ (@;delete file)
+ _ (@;make-dir dir)
+ directory-is-file (@;file? dir)
+ directory-is-directory (@;directory? dir)
+ _ (@;delete dir)]
+ (wrap (and file-is-file (not file-is-directory)
+ (not directory-is-file) directory-is-directory)))]
+ (assert "Can differentiate files from directories."
+ (E;default false result))))
+ (wrap (do P;Monad<Promise>
+ [#let [file (format "temp_file_" (%n (n.+ +6 code)))
+ dir (format "temp_dir_" (%n (n.+ +6 code)))]
+ result (do T;Monad<Task>
+ [_ (@;make-dir dir)
+ #let [file' (format dir "/" file)]
+ _ (@;write dataL file')
+ read-size (@;size file')
+ deleted-file (@;delete file')
+ deleted-dir (@;delete dir)]
+ (wrap (and (n.= file-size read-size)
+ deleted-file
+ deleted-dir)))]
+ (assert "Can create files inside of directories."
+ (E;default false result))))
+ (wrap (do P;Monad<Promise>
+ [#let [file (format "temp_file_" (%n (n.+ +7 code)))
+ dir (format "temp_dir_" (%n (n.+ +7 code)))]
+ result (do T;Monad<Task>
+ [_ (@;make-dir dir)
+ #let [file' (format dir "/" file)]
+ _ (@;write dataL file')
+ children (@;files dir)
+ _ (@;delete file')
+ _ (@;delete dir)]
+ (wrap (case children
+ (^ (list child))
+ (text;ends-with? file' child)
- _
- false)))]
- (test "Can list files inside a directory."
- (E;default false result)))
- (do P;Monad<Promise>
- [#let [file (format "temp_file_" (%n (n.+ +8 code)))]
- result (do T;Monad<Task>
- [_ (@;write dataL file)
- was-modified? (@;set-last-modified last-modified file)
- time-read (@;get-last-modified file)
- _ (@;delete file)]
- (wrap (and was-modified?
- (:: i;Eq<Instant> = last-modified time-read))))]
- (test "Can change the time of last modification."
- (E;default false result)))
- (do P;Monad<Promise>
- [#let [file0 (format "temp_file_" (%n (n.+ +9 code)) "0")
- file1 (format "temp_file_" (%n (n.+ +9 code)) "1")]
- result (do T;Monad<Task>
- [_ (@;write dataL file0)
- pre (@;exists? file0)
- moved? (@;move file1 file0)
- post (@;exists? file0)
- confirmed? (@;exists? file1)
- deleted? (@;delete file1)]
- (wrap (and pre moved? (not post)
- confirmed? deleted?)))]
- (test "Can move a file from one path to another."
- (E;default false result)))
- ))
+ _
+ false)))]
+ (assert "Can list files inside a directory."
+ (E;default false result))))
+ (wrap (do P;Monad<Promise>
+ [#let [file (format "temp_file_" (%n (n.+ +8 code)))]
+ result (do T;Monad<Task>
+ [_ (@;write dataL file)
+ was-modified? (@;set-last-modified last-modified file)
+ time-read (@;get-last-modified file)
+ _ (@;delete file)]
+ (wrap (and was-modified?
+ (:: i;Eq<Instant> = last-modified time-read))))]
+ (assert "Can change the time of last modification."
+ (E;default false result))))
+ (wrap (do P;Monad<Promise>
+ [#let [file0 (format "temp_file_" (%n (n.+ +9 code)) "0")
+ file1 (format "temp_file_" (%n (n.+ +9 code)) "1")]
+ result (do T;Monad<Task>
+ [_ (@;write dataL file0)
+ pre (@;exists? file0)
+ moved? (@;move file1 file0)
+ post (@;exists? file0)
+ confirmed? (@;exists? file1)
+ deleted? (@;delete file1)]
+ (wrap (and pre moved? (not post)
+ confirmed? deleted?)))]
+ (assert "Can move a file from one path to another."
+ (E;default false result))))
+ )))
diff --git a/stdlib/test/test/lux/world/net/tcp.lux b/stdlib/test/test/lux/world/net/tcp.lux
index cf390ef09..7a3c6bfc5 100644
--- a/stdlib/test/test/lux/world/net/tcp.lux
+++ b/stdlib/test/test/lux/world/net/tcp.lux
@@ -38,33 +38,33 @@
(wrap (ex;throw Empty-Channel "")))))
(context: "TCP networking."
- #times +1
- [port ;;port
- size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10))))
- from (_blob;blob size)
- to (_blob;blob size)
- #let [temp (blob;create size)]]
- ($_ seq
- (do P;Monad<Promise>
- [result (do T;Monad<Task>
- [server (@;server port)
- client (@;client localhost port)
- ####################
- _ (@;write from +0 size client)
- socket (head server)
- bytes-from (@;read temp +0 size socket)
- #let [from-worked? (and (n.= size bytes-from)
- (:: blob;Eq<Blob> = from temp))]
- ####################
- _ (@;write to +0 size socket)
- bytes-to (@;read temp +0 size client)
- #let [to-worked? (and (n.= size bytes-to)
- (:: blob;Eq<Blob> = to temp))]
- ####################
- _ (@;close client)
- _ (T;from-promise (P;future (frp;close server)))]
- (wrap (and from-worked?
- to-worked?)))]
- (test "Can communicate between client and server."
- (E;default false result)))
- ))
+ (do @
+ [port ;;port
+ size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10))))
+ from (_blob;blob size)
+ to (_blob;blob size)
+ #let [temp (blob;create size)]]
+ ($_ seq
+ (wrap (do P;Monad<Promise>
+ [result (do T;Monad<Task>
+ [server (@;server port)
+ client (@;client localhost port)
+ ####################
+ _ (@;write from +0 size client)
+ socket (head server)
+ bytes-from (@;read temp +0 size socket)
+ #let [from-worked? (and (n.= size bytes-from)
+ (:: blob;Eq<Blob> = from temp))]
+ ####################
+ _ (@;write to +0 size socket)
+ bytes-to (@;read temp +0 size client)
+ #let [to-worked? (and (n.= size bytes-to)
+ (:: blob;Eq<Blob> = to temp))]
+ ####################
+ _ (@;close client)
+ _ (T;from-promise (P;future (frp;close server)))]
+ (wrap (and from-worked?
+ to-worked?)))]
+ (assert "Can communicate between client and server."
+ (E;default false result))))
+ )))
diff --git a/stdlib/test/test/lux/world/net/udp.lux b/stdlib/test/test/lux/world/net/udp.lux
index 6bd43351e..ee0a89b14 100644
--- a/stdlib/test/test/lux/world/net/udp.lux
+++ b/stdlib/test/test/lux/world/net/udp.lux
@@ -38,33 +38,33 @@
(wrap (ex;throw Empty-Channel "")))))
(context: "UDP networking."
- #times +1
- [port ;;port
- size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10))))
- from (_blob;blob size)
- to (_blob;blob size)
- #let [temp (blob;create size)]]
- ($_ seq
- (do P;Monad<Promise>
- [result (do T;Monad<Task>
- [server (@;server port)
- client (@;client [])
- ####################
- _ (@;write localhost port from +0 size client)
- [bytes-from from-address from-port] (@;read temp +0 size server)
- #let [from-worked? (and (n.= size bytes-from)
- (:: blob;Eq<Blob> = from temp))]
- ####################
- _ (@;write from-address from-port to +0 size server)
- [bytes-to to-address to-port] (@;read temp +0 size client)
- #let [to-worked? (and (n.= size bytes-to)
- (:: blob;Eq<Blob> = to temp)
- (n.= port to-port))]
- ####################
- _ (@;close client)
- _ (@;close server)]
- (wrap (and from-worked?
- to-worked?)))]
- (test "Can communicate between client and server."
- (E;default false result)))
- ))
+ (do @
+ [port ;;port
+ size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10))))
+ from (_blob;blob size)
+ to (_blob;blob size)
+ #let [temp (blob;create size)]]
+ ($_ seq
+ (wrap (do P;Monad<Promise>
+ [result (do T;Monad<Task>
+ [server (@;server port)
+ client (@;client [])
+ ####################
+ _ (@;write localhost port from +0 size client)
+ [bytes-from from-address from-port] (@;read temp +0 size server)
+ #let [from-worked? (and (n.= size bytes-from)
+ (:: blob;Eq<Blob> = from temp))]
+ ####################
+ _ (@;write from-address from-port to +0 size server)
+ [bytes-to to-address to-port] (@;read temp +0 size client)
+ #let [to-worked? (and (n.= size bytes-to)
+ (:: blob;Eq<Blob> = to temp)
+ (n.= port to-port))]
+ ####################
+ _ (@;close client)
+ _ (@;close server)]
+ (wrap (and from-worked?
+ to-worked?)))]
+ (assert "Can communicate between client and server."
+ (E;default false result))))
+ )))