diff options
Diffstat (limited to '')
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)))) + ))) |