From e9368bc5f75345c81bd7ded21e07a4436641821a Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Fri, 20 Oct 2017 19:09:34 -0400
Subject: - Replaced the "#seed" and "#times" options for "seed" and "times"
test combinators.
---
stdlib/source/lux/data/number/complex.lux | 3 -
stdlib/source/lux/test.lux | 309 ++++++++----------
stdlib/test/test/lux.lux | 186 ++++++-----
stdlib/test/test/lux/cli.lux | 82 ++---
stdlib/test/test/lux/concurrency/actor.lux | 30 +-
stdlib/test/test/lux/concurrency/atom.lux | 36 ++-
stdlib/test/test/lux/concurrency/frp.lux | 202 ++++++------
stdlib/test/test/lux/concurrency/promise.lux | 80 ++---
stdlib/test/test/lux/concurrency/stm.lux | 75 ++---
stdlib/test/test/lux/control/cont.lux | 110 +++----
stdlib/test/test/lux/control/exception.lux | 58 ++--
stdlib/test/test/lux/control/interval.lux | 320 ++++++++++---------
stdlib/test/test/lux/control/state.lux | 168 +++++-----
stdlib/test/test/lux/data/bit.lux | 118 +++----
stdlib/test/test/lux/data/bool.lux | 42 +--
stdlib/test/test/lux/data/coll/array.lux | 218 +++++++------
stdlib/test/test/lux/data/coll/dict.lux | 210 ++++++------
stdlib/test/test/lux/data/coll/list.lux | 368 +++++++++++-----------
stdlib/test/test/lux/data/coll/ordered/dict.lux | 122 +++----
stdlib/test/test/lux/data/coll/ordered/set.lux | 150 ++++-----
stdlib/test/test/lux/data/coll/priority-queue.lux | 54 ++--
stdlib/test/test/lux/data/coll/queue.lux | 72 +++--
stdlib/test/test/lux/data/coll/sequence.lux | 102 +++---
stdlib/test/test/lux/data/coll/set.lux | 94 +++---
stdlib/test/test/lux/data/coll/stack.lux | 46 +--
stdlib/test/test/lux/data/coll/stream.lux | 156 ++++-----
stdlib/test/test/lux/data/coll/tree/rose.lux | 30 +-
stdlib/test/test/lux/data/coll/tree/zipper.lux | 170 +++++-----
stdlib/test/test/lux/data/color.lux | 102 +++---
stdlib/test/test/lux/data/format/json.lux | 54 ++--
stdlib/test/test/lux/data/format/xml.lux | 108 ++++---
stdlib/test/test/lux/data/ident.lux | 72 +++--
stdlib/test/test/lux/data/lazy.lux | 86 ++---
stdlib/test/test/lux/data/number.lux | 132 ++++----
stdlib/test/test/lux/data/number/complex.lux | 297 ++++++++---------
stdlib/test/test/lux/data/number/ratio.lux | 136 ++++----
stdlib/test/test/lux/data/text.lux | 181 ++++++-----
stdlib/test/test/lux/data/text/lexer.lux | 28 +-
stdlib/test/test/lux/data/text/regex.lux | 31 +-
stdlib/test/test/lux/host.jvm.lux | 62 ++--
stdlib/test/test/lux/math.lux | 210 ++++++------
stdlib/test/test/lux/math/logic/continuous.lux | 40 +--
stdlib/test/test/lux/math/logic/fuzzy.lux | 274 ++++++++--------
stdlib/test/test/lux/math/random.lux | 76 ++---
stdlib/test/test/lux/meta/poly/eq.lux | 10 +-
stdlib/test/test/lux/meta/type.lux | 166 +++++-----
stdlib/test/test/lux/meta/type/auto.lux | 42 +--
stdlib/test/test/lux/meta/type/check.lux | 68 ++--
stdlib/test/test/lux/time/date.lux | 149 +++++----
stdlib/test/test/lux/time/duration.lux | 106 ++++---
stdlib/test/test/lux/time/instant.lux | 108 ++++---
stdlib/test/test/lux/world/blob.lux | 144 ++++-----
stdlib/test/test/lux/world/file.lux | 278 ++++++++--------
stdlib/test/test/lux/world/net/tcp.lux | 60 ++--
stdlib/test/test/lux/world/net/udp.lux | 60 ++--
55 files changed, 3446 insertions(+), 3245 deletions(-)
(limited to 'stdlib')
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 with-gensyms]
(meta ["s" syntax #+ syntax: Syntax]
[code])
- (control ["M" monad #+ do Monad]
+ (control [monad #+ do Monad]
["p" parser])
(concurrency [promise #+ Promise Monad])
- (data (coll [list "L/" Monad Fold])
+ (data (coll [list "list/" Monad Fold])
[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 (Monad r;Random) r;Monad)
+
(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 wrap [failure (format " [Error] " (%t message))]))
+ (|> [failure (format " [Error] " message)]
+ (:: Monad wrap)
+ (:: r;Monad 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 wrap [success (format "[Success] " message)])
(:: Monad 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 wrap (assert message condition)))
+
(def: #hidden (run' tests)
(-> (List [Text (IO Test) Text]) (Promise Counters))
(do Monad
[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
- [test random-test
- next-seed r;nat]
- (wrap [next-seed test])))]
- (do Monad
- [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
- [[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
+ [[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
- [_ (s;this (' #seed))]
- s;nat)
- (do p;Monad
- [_ (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
+ [now instant;now
+ #let [seed (|> now instant;to-millis int-to-nat)]]
+ (io (do r;Monad
+ [instance (case (_lux_proc ["lux" "try"] [test])
+ (#e;Success test)
+ test
+
+ (#e;Error error)
+ (fail error))]
+ (wrap (do Monad
+ [[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 rand-gen)
- y (:: @ map rand-gen)]
- (test ""
- (and (|> x (- y) (+ y) (= x))
- (|> x (+ y) (- y) (= x)))))
+ (do @
+ [x (:: @ map rand-gen)
+ y (:: @ map 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 rand-gen)
- y (:: @ map rand-gen)]
- (test ""
- (and (|> x (- y) (+ y) (= x))
- (|> x (+ y) (- y) (= x)))))
+ (<| (times +1234)
+ (do @
+ [x (:: @ map rand-gen)
+ y (:: @ map 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 rand-gen)
- y (:: @ map rand-gen)]
- (test ""
- (and (|> x (- y) (+ y) (= x))
- (|> x (+ y) (- y) (= x)))))
+ (<| (seed +987654321)
+ (do @
+ [x (:: @ map rand-gen)
+ y (:: @ map 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
- [(~@ 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 [] (~ test))))))))))
(def: (exported-tests module-name)
(-> Text (Meta (List [Text Text Text])))
(do Monad
[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 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
[(~' #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
- [[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
+ [left left
+ right right]
+ (wrap (do Monad
+ [[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> %x ]
[(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 rand-gen)
- y (:: @ map rand-gen)
- #let [x (* x)
- y (* y)]]
- (test ""
- (and (|> x (- y) (+ y) (= x))
- (|> x (+ y) (- y) (= x)))))
+ (<| (times +100)
+ (do @
+ [x (:: @ map rand-gen)
+ y (:: @ map rand-gen)
+ #let [x (* x)
+ y (* 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 rand-gen)
- y (|> rand-gen
- (:: @ map )
- (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 rand-gen)
+ y (|> rand-gen
+ (:: @ map )
+ (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 -> <- = %a %z]
[(context: (format "[" category "] " "Numeric conversions")
- [value rand-gen
- #let [value ( value)]]
- (test ""
- (|> value -> <- (= value))))]
+ (<| (times +100)
+ (do @
+ [value rand-gen
+ #let [value ( 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
- 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
+ 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
- [result (do T;Monad
- [#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
+ [result (do T;Monad
+ [#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
- [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
- [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
- [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
- [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
+ [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
+ [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
+ [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
+ [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
- [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
- [elems (&;consume (&;distinct number;Eq (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
- [elems (&;consume (&;once (:: @ wrap 12345)))]
- (test "Can convert a promise into a single-value channel."
- (case elems
- (^ (list 12345))
- true
-
- _
- false)))
-
- (do P;Monad
- [elems (&;consume (:: &;Functor 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
- [elems (&;consume (let [(^open) &;Applicative]
- (apply (wrap i.inc) (wrap 12345))))]
- (test "Applicative works over all channel values."
- (case elems
- (^ (list 12346))
- true
-
- _
- false)))
-
- (do P;Monad
- [elems (&;consume (do &;Monad
- [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
+ [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
+ [elems (&;consume (&;distinct number;Eq (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
+ [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
+ [elems (&;consume (:: &;Functor 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
+ [elems (&;consume (let [(^open) &;Applicative]
+ (apply (wrap i.inc) (wrap 12345))))]
+ (assert "Applicative works over all channel values."
+ (case elems
+ (^ (list 12346))
+ true
+
+ _
+ false))))
+
+ (wrap (do P;Monad
+ [elems (&;consume (do &;Monad
+ [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
- [running? (&;future (io true))]
- (test "Can run IO actions in separate threads."
- running?))
+ (wrap (do &;Monad
+ [running? (&;future (io true))]
+ (assert "Can run IO actions in separate threads."
+ running?)))
- (do &;Monad
- [_ (&;wait +500)]
- (test "Can wait for a specified amount of time."
- true))
+ (wrap (do &;Monad
+ [_ (&;wait +500)]
+ (assert "Can wait for a specified amount of time."
+ true)))
- (do &;Monad
- [[left right] (&;seq (&;future (io true))
- (&;future (io false)))]
- (test "Can combine promises sequentially."
- (and left (not right))))
+ (wrap (do &;Monad
+ [[left right] (&;seq (&;future (io true))
+ (&;future (io false)))]
+ (assert "Can combine promises sequentially."
+ (and left (not right)))))
- (do &;Monad
- [?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
+ [?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
- [?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
+ [?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
- [?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
+ [?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
- [#let [_var (&;var 0)
- changes (io;run (&;follow _var))]
- output1 (&;commit (&;read _var))
- output2 (&;commit (do &;Monad
- [_ (&;write 5 _var)]
- (&;read _var)))
- output3 (&;commit (do &;Monad
- [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
- [_ (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
+ [#let [_var (&;var 0)
+ changes (io;run (&;follow _var))]
+ output1 (&;commit (&;read _var))
+ output2 (&;commit (do &;Monad
+ [_ (&;write 5 _var)]
+ (&;read _var)))
+ output3 (&;commit (do &;Monad
+ [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
+ [_ (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]
- 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]
+ 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
- [func (wrap n.inc)
- arg (wrap sample)]
- (wrap (func arg))))))
+ (test "Can use monad."
+ (n.= (n.inc sample) (&;run (do &;Monad
+ [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
- [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
+ [value (&;call/cc
+ (function [k]
+ (do @
+ [temp (k sample)]
+ ## If this code where to run,
+ ## the output would be
+ ## (n.* +4 sample)
+ (k temp))))]
+ (wrap (n.* +2 value))))))
- (test "Can use the current-continuation to build a time machine."
- (n.= (n.+ +100 sample)
- (&;run (do &;Monad
- [[restart [output idx]] (&;portal [sample +0])]
- (if (n.< +10 idx)
- (restart [(n.+ +10 output) (n.inc idx)])
- (wrap output))))))
+ (test "Can use the current-continuation to build a time machine."
+ (n.= (n.+ +100 sample)
+ (&;run (do &;Monad
+ [[restart [output idx]] (&;portal [sample +0])]
+ (if (n.< +10 idx)
+ (restart [(n.+ +10 output) (n.inc idx)])
+ (wrap output))))))
- (test "Can use delimited continuations with shifting."
- (let [(^open "&/") &;Monad
- (^open "L/") (list;Eq number;Eq)
- 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
+ (^open "L/") (list;Eq number;Eq)
+ visit (: (-> (List Nat)
+ (&;Cont (List Nat) (List Nat)))
+ (function visit [xs]
+ (case xs
+ #;Nil
+ (&/wrap #;Nil)
- (#;Cons x xs')
- (do &;Monad
- [output (&;shift (function [k]
- (do @
- [tail (k xs')]
- (wrap (#;Cons x tail)))))]
- (visit output)))))]
- (L/= elems
- (&;run (&;reset (visit elems))))
- ))
- ))
+ (#;Cons x xs')
+ (do &;Monad
+ [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]]
- ($_ seq
- (test "Every interval is equal to itself."
- (and (let [self (&;between number;Enum bottom top)]
- (&/= self self))
- (let [self (&;between number;Enum top bottom)]
- (&/= self self))
- (let [self (&;singleton number;Enum bottom)]
- (&/= self self))))))
+ (<| (times +100)
+ (do @
+ [bottom r;int
+ top r;int
+ #let [(^open "&/") &;Eq]]
+ ($_ seq
+ (test "Every interval is equal to itself."
+ (and (let [self (&;between number;Enum bottom top)]
+ (&/= self self))
+ (let [self (&;between number;Enum top bottom)]
+ (&/= self self))
+ (let [self (&;singleton number;Enum bottom)]
+ (&/= self self))))))))
(context: "Boundaries"
- [bottom r;int
- top r;int
- #let [interval (&;between number;Enum 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 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]]
- ($_ 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]]
+ ($_ 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]]
- ($_ 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]]
+ ($_ 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]]
- ($_ 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]]
+ ($_ 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 +3 r;int)
- (:: @ map (|>. S;to-list
- (L;sort i.<)
- (case> (^ (list b t1 t2))
- [b t1 t2]
-
- _
- (undefined)))))
- #let [left (&;singleton number;Enum l)
- right (&;singleton number;Enum 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 +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 t1 t2)
- int-right (&;between number;Enum 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 b t2)
- (&;between number;Enum b t1)))
- (test "Can check if 2 intervals finish together."
- (&;finishes? (&;between number;Enum b t2)
- (&;between number;Enum t1 t2)))
- ))
-
-(context: "Nesting & overlap"
- [some-interval gen-interval
- [x0 x1 x2 x3] (|> (r;set number;Hash +4 r;int)
+ (<| (times +100)
+ (do @
+ [[l m r] (|> (r;set number;Hash +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 x1 x2)
- large-inner (&;between number;Enum 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 x0 x2)
- right-inner (&;between number;Enum 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 x2 x1)
- large-outer (&;between number;Enum 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 x0 x1)
- right-inner (&;between number;Enum x2 x3)
- outer (&;between number;Enum x0 x3)]
- (test "Inners can be nested inside outers."
- (and (&;nested? outer left-inner)
- (&;nested? outer right-inner))))
- (let [left-inner (&;between number;Enum x0 x2)
- right-inner (&;between number;Enum x1 x3)
- outer (&;between number;Enum x1 x2)]
- (test "Inners can overlap outers."
- (and (&;overlaps? outer left-inner)
- (&;overlaps? outer right-inner))))
- ))
+ (undefined)))))
+ #let [left (&;singleton number;Enum l)
+ right (&;singleton number;Enum 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 +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 t1 t2)
+ int-right (&;between number;Enum 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 b t2)
+ (&;between number;Enum b t1)))
+ (test "Can check if 2 intervals finish together."
+ (&;finishes? (&;between number;Enum b t2)
+ (&;between number;Enum t1 t2)))
+ ))))
+
+(context: "Nesting & overlap"
+ (<| (times +100)
+ (do @
+ [some-interval gen-interval
+ [x0 x1 x2 x3] (|> (r;set number;Hash +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 x1 x2)
+ large-inner (&;between number;Enum 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 x0 x2)
+ right-inner (&;between number;Enum 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 x2 x1)
+ large-outer (&;between number;Enum 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 x0 x1)
+ right-inner (&;between number;Enum x2 x3)
+ outer (&;between number;Enum x0 x3)]
+ (test "Inners can be nested inside outers."
+ (and (&;nested? outer left-inner)
+ (&;nested? outer right-inner))))
+ (let [left-inner (&;between number;Enum x0 x2)
+ right-inner (&;between number;Enum x1 x3)
+ outer (&;between number;Enum 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
- [_ (&;put value)]
- &;get)))
- (test "Can update the state."
- (with-conditions [state (n.* value state)]
- (do &;Monad
- [_ (&;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
+ [_ (&;put value)]
+ &;get)))
+ (test "Can update the state."
+ (with-conditions [state (n.* value state)]
+ (do &;Monad
+ [_ (&;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 map n.inc &;get)))
- (test "Can use applicative."
- (let [(^open "&/") &;Applicative]
- (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
- [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 map n.inc &;get)))
+ (test "Can use applicative."
+ (let [(^open "&/") &;Applicative]
+ (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
+ [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]
- (test "Can add state functionality to any monad."
- (|> (: (&;State' io;IO Nat Nat)
- (do (&;StateT io;Monad)
- [a (&;lift io;Monad (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]
+ (test "Can add state functionality to any monad."
+ (|> (: (&;State' io;IO Nat Nat)
+ (do (&;StateT io;Monad)
+ [a (&;lift io;Monad (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 &;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 &;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 identity))
- (:: Or@Monoid compose value (not value))
- (:: And@Monoid identity)
- (not (:: And@Monoid compose value (not value)))
-
- (:: Eq = value (not (not value)))
- (not (:: Eq = value (not value)))
+ (not (:: Or@Monoid identity))
+ (:: Or@Monoid compose value (not value))
+ (:: And@Monoid identity)
+ (not (:: And@Monoid compose value (not value)))
+
+ (:: Eq = value (not (not value)))
+ (not (:: Eq = value (not value)))
- (not (:: Eq = value ((complement id) value)))
- (:: Eq = value ((complement not) value))
+ (not (:: Eq = value ((complement id) value)))
+ (:: Eq = value ((complement not) value))
- (case (|> value
- (:: Codec encode)
- (:: Codec decode))
- (#;Right dec-value)
- (:: Eq = value dec-value)
+ (case (|> value
+ (:: Codec encode)
+ (:: Codec decode))
+ (#;Right dec-value)
+ (:: Eq = 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 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 number;Eq) = 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 number;Eq) = original copy)
- (not (is original copy)))))
- (test "Array folding should go over all values."
- (exec (:: @;Fold fold
- (function [x idx]
- (exec (@;write idx x manual-copy)
- (n.inc idx)))
- +0
- original)
- (:: (@;Eq number;Eq) = original manual-copy)))
- (test "Transformations between (full) arrays and lists shouldn't cause lose or change any values."
- (|> original
- @;to-list @;from-list
- (:: (@;Eq number;Eq) = 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 number;Eq) = 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 number;Eq) = original copy)
+ (not (is original copy)))))
+ (test "Array folding should go over all values."
+ (exec (:: @;Fold fold
+ (function [x idx]
+ (exec (@;write idx x manual-copy)
+ (n.inc idx)))
+ +0
+ original)
+ (:: (@;Eq number;Eq) = original manual-copy)))
+ (test "Transformations between (full) arrays and lists shouldn't cause lose or change any values."
+ (|> original
+ @;to-list @;from-list
+ (:: (@;Eq number;Eq) = 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
- (^open) (@;Eq number;Eq