diff options
Diffstat (limited to 'stdlib')
63 files changed, 2896 insertions, 2896 deletions
diff --git a/stdlib/source/lux/test.lux b/stdlib/source/lux/test.lux index b104df4f9..ab64ee86e 100644 --- a/stdlib/source/lux/test.lux +++ b/stdlib/source/lux/test.lux @@ -38,7 +38,7 @@ (All [a] (-> Text Test)) (:: Monad<Promise> wrap (#E;Error message))) -(def: #export (assert message condition) +(def: #export (test message condition) {#;doc "Check that a condition is true, and fail with the given message otherwise."} (-> Text Bool Test) (if condition @@ -160,65 +160,65 @@ output (#E;Error error) - (assert error false))) + (test error false))) -(syntax: #export (test: description [body test^]) +(syntax: #export (context: description [body test^]) {#;doc (doc "Macro for definint tests." - (test: "Simple macros and constructs" + (context: "Simple macros and constructs" ($_ seq - (assert "Can write easy loops for iterative programming." - (i.= 1000 - (loop [counter 0 - value 1] - (if (i.< 3 counter) - (recur (i.inc counter) (i.* 10 value)) - value)))) - - (assert "Can create lists easily through macros." - (and (case (list 1 2 3) - (#;Cons 1 (#;Cons 2 (#;Cons 3 #;Nil))) - true - - _ - false) - - (case (list& 1 2 3 (list 4 5 6)) - (#;Cons 1 (#;Cons 2 (#;Cons 3 (#;Cons 4 (#;Cons 5 (#;Cons 6 #;Nil)))))) - true - - _ - false))) - - (assert "Can have defaults for Maybe values." - (and (is "yolo" (default "yolo" - #;None)) - - (is "lol" (default "yolo" - (#;Some "lol"))))) + (test "Can write easy loops for iterative programming." + (i.= 1000 + (loop [counter 0 + value 1] + (if (i.< 3 counter) + (recur (i.inc counter) (i.* 10 value)) + value)))) + + (test "Can create lists easily through macros." + (and (case (list 1 2 3) + (#;Cons 1 (#;Cons 2 (#;Cons 3 #;Nil))) + true + + _ + false) + + (case (list& 1 2 3 (list 4 5 6)) + (#;Cons 1 (#;Cons 2 (#;Cons 3 (#;Cons 4 (#;Cons 5 (#;Cons 6 #;Nil)))))) + true + + _ + false))) + + (test "Can have defaults for Maybe values." + (and (is "yolo" (default "yolo" + #;None)) + + (is "lol" (default "yolo" + (#;Some "lol"))))) )) "Also works with random generation of values for property-based testing." - (test: "Addition & Substraction" + (context: "Addition & Substraction" [x (:: @ map <prep> rand-gen) y (:: @ map <prep> rand-gen)] - (assert "" - (and (|> x (- y) (+ y) (= x)) - (|> x (+ y) (- y) (= x))))) + (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:" - (test: "Addition & Substraction" + (context: "Addition & Substraction" #times +1234 [x (:: @ map <prep> rand-gen) y (:: @ map <prep> rand-gen)] - (assert "" - (and (|> x (- y) (+ y) (= x)) - (|> x (+ y) (- y) (= x))))) + (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." - (test: "Addition & Substraction" + (context: "Addition & Substraction" #seed +987654321 [x (:: @ map <prep> rand-gen) y (:: @ map <prep> rand-gen)] - (assert "" - (and (|> x (- y) (+ y) (= x)) - (|> x (+ y) (- y) (= x))))) + (test "" + (and (|> x (- y) (+ y) (= x)) + (|> x (+ y) (- y) (= x))))) )} (let [body (case body (#Property config bindings body) diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux index fd69b1e22..a43609668 100644 --- a/stdlib/test/test/lux.lux +++ b/stdlib/test/test/lux.lux @@ -10,62 +10,62 @@ [macro] (macro ["s" syntax #+ syntax:]))) -(test: "Value identity." +(context: "Value identity." [size (|> R;nat (:: @ map (|>. (n.% +100) (n.max +10)))) x (R;text size) y (R;text size)] ($_ seq - (assert "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 "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)))) - (assert "Values created separately can't be identical." - (not (is x y))) + (test "Values created separately can't be identical." + (not (is x y))) )) (do-template [category rand-gen inc dec even? odd? = < >] - [(test: (format "[" category "] " "Moving up-down or down-up should result in same value.") + [(context: (format "[" category "] " "Moving up-down or down-up should result in same value.") [value rand-gen] - (assert "" (and (|> value inc dec (= value)) - (|> value dec inc (= value))))) + (test "" (and (|> value inc dec (= value)) + (|> value dec inc (= value))))) - (test: (format "[" category "] " "(x+1) > x && (x-1) < x") + (context: (format "[" category "] " "(x+1) > x && (x-1) < x") [value rand-gen] - (assert "" (and (|> value inc (> value)) - (|> value dec (< value))))) + (test "" (and (|> value inc (> value)) + (|> value dec (< value))))) - (test: (format "[" category "] " "Every odd/even number is surrounded by two of the other kind.") + (context: (format "[" category "] " "Every odd/even number is surrounded by two of the other kind.") [value rand-gen] - (assert "" - (if (even? value) - (and (|> value inc odd?) - (|> value dec odd?)) - (and (|> value inc even?) - (|> value dec even?)))))] + (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.>] ) (do-template [category rand-gen = < > <= >= min max] - [(test: (format "[" category "] " "The symmetry of numerical comparisons.") + [(context: (format "[" category "] " "The symmetry of numerical comparisons.") [x rand-gen y rand-gen] - (assert "" - (or (= x y) - (if (< y x) - (> x y) - (< x y))))) + (test "" + (or (= x y) + (if (< y x) + (> x y) + (< x y))))) - (test: (format "[" category "] " "Minimums and maximums.") + (context: (format "[" category "] " "Minimums and maximums.") [x rand-gen y rand-gen] - (assert "" - (and (and (<= x (min x y)) - (<= y (min x y))) - (and (>= x (max x y)) - (>= y (max x y))) - )))] + (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] @@ -74,46 +74,46 @@ ) (do-template [category rand-gen = + - * / <%> > <0> <1> <factor> %x <cap> <prep>] - [(test: (format "[" category "] " "Additive identity") + [(context: (format "[" category "] " "Additive identity") [x rand-gen] - (assert "" - (and (|> x (+ <0>) (= x)) - (|> x (- <0>) (= x))))) + (test "" + (and (|> x (+ <0>) (= x)) + (|> x (- <0>) (= x))))) - (test: (format "[" category "] " "Addition & Substraction") + (context: (format "[" category "] " "Addition & Substraction") [x (:: @ map <prep> rand-gen) y (:: @ map <prep> rand-gen) #let [x (* <factor> x) y (* <factor> y)]] - (assert "" - (and (|> x (- y) (+ y) (= x)) - (|> x (+ y) (- y) (= x))))) + (test "" + (and (|> x (- y) (+ y) (= x)) + (|> x (+ y) (- y) (= x))))) - (test: (format "[" category "] " "Multiplicative identity") + (context: (format "[" category "] " "Multiplicative identity") [x rand-gen] - (assert "" - ## Skip this test for Deg - ## because Deg division loses the last - ## 32 bits of precision. - (or (T/= "Deg" category) - (and (|> x (* <1>) (= x)) - (|> x (/ <1>) (= x)))))) - - (test: (format "[" category "] " "Multiplication & Division") + (test "" + ## Skip this test for Deg + ## because Deg division loses the last + ## 32 bits of precision. + (or (T/= "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)]] - (assert "" - ## Skip this test for Deg - ## because Deg division loses the last - ## 32 bits of precision. - (or (T/= "Deg" category) - (or (> x' y) - (|> x' (/ y) (* y) (= x')))) - ))] + (test "" + ## Skip this test for Deg + ## because Deg division loses the last + ## 32 bits of precision. + (or (T/= "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] @@ -122,11 +122,11 @@ ) (do-template [category rand-gen -> <- = <cap> %a %z] - [(test: (format "[" category "] " "Numeric conversions") + [(context: (format "[" category "] " "Numeric conversions") [value rand-gen #let [value (<cap> value)]] - (assert "" - (|> value -> <- (= value))))] + (test "" + (|> value -> <- (= value))))] ["Int->Nat" R;int int-to-nat nat-to-int i.= (i.% 1000000) %i %n] ["Nat->Int" R;nat nat-to-int int-to-nat n.= (n.% +1000000) %n %i] @@ -135,45 +135,45 @@ ## [R;real real-to-deg deg-to-real r.= (r.% 1.0) %r %f] ) -(test: "Simple macros and constructs" +(context: "Simple macros and constructs" ($_ seq - (assert "Can write easy loops for iterative programming." - (i.= 1000 - (loop [counter 0 - value 1] - (if (i.< 3 counter) - (recur (i.inc counter) (i.* 10 value)) - value)))) - - (assert "Can create lists easily through macros." - (and (case (list 1 2 3) - (#;Cons 1 (#;Cons 2 (#;Cons 3 #;Nil))) - true - - _ - false) - - (case (list& 1 2 3 (list 4 5 6)) - (#;Cons 1 (#;Cons 2 (#;Cons 3 (#;Cons 4 (#;Cons 5 (#;Cons 6 #;Nil)))))) - true - - _ - false))) - - (assert "Can have defaults for Maybe values." - (and (is "yolo" (default "yolo" - #;None)) - - (is "lol" (default "yolo" - (#;Some "lol"))))) + (test "Can write easy loops for iterative programming." + (i.= 1000 + (loop [counter 0 + value 1] + (if (i.< 3 counter) + (recur (i.inc counter) (i.* 10 value)) + value)))) + + (test "Can create lists easily through macros." + (and (case (list 1 2 3) + (#;Cons 1 (#;Cons 2 (#;Cons 3 #;Nil))) + true + + _ + false) + + (case (list& 1 2 3 (list 4 5 6)) + (#;Cons 1 (#;Cons 2 (#;Cons 3 (#;Cons 4 (#;Cons 5 (#;Cons 6 #;Nil)))))) + true + + _ + false))) + + (test "Can have defaults for Maybe values." + (and (is "yolo" (default "yolo" + #;None)) + + (is "lol" (default "yolo" + (#;Some "lol"))))) )) (template: (hypotenuse x y) (i.+ (i.* x x) (i.* y y))) -(test: "Templates" +(context: "Templates" [x R;int y R;int] - (assert "Template application is a stand-in for the templated code." - (i.= (i.+ (i.* x x) (i.* y y)) - (hypotenuse x y)))) + (test "Template application is a stand-in for the templated code." + (i.= (i.+ (i.* x x) (i.* y y)) + (hypotenuse x y)))) diff --git a/stdlib/test/test/lux/cli.lux b/stdlib/test/test/lux/cli.lux index b8ed6ca0c..b19a9d345 100644 --- a/stdlib/test/test/lux/cli.lux +++ b/stdlib/test/test/lux/cli.lux @@ -13,82 +13,82 @@ ["R" math/random]) lux/test) -(test: "CLI" +(context: "CLI" [num-args (|> R;nat (:: @ map (n.% +10))) #let [(^open "Nat/") number;Codec<Text,Nat> gen-arg (:: @ map Nat/encode R;nat)] option-name (R;text +5) args (R;list num-args gen-arg)] ($_ seq - (assert "Can read any argument." - (|> (&;run &;any args) - (case> (#;Left _) - (n.= +0 num-args) - - (#;Right arg) - (and (not (n.= +0 num-args)) - (Text/= arg (default (undefined) - (list;head args))))))) + (test "Can read any argument." + (|> (&;run &;any args) + (case> (#;Left _) + (n.= +0 num-args) + + (#;Right arg) + (and (not (n.= +0 num-args)) + (Text/= arg (default (undefined) + (list;head args))))))) - (assert "Can safely fail parsing an argument." - (|> (&;run (&;opt &;any) args) - (case> (#;Right (#;Some arg)) - (and (not (n.= +0 num-args)) - (Text/= arg (default (undefined) - (list;head args)))) + (test "Can safely fail parsing an argument." + (|> (&;run (&;opt &;any) args) + (case> (#;Right (#;Some arg)) + (and (not (n.= +0 num-args)) + (Text/= arg (default (undefined) + (list;head args)))) - (#;Right #;None) - (n.= +0 num-args) + (#;Right #;None) + (n.= +0 num-args) - _ - false))) + _ + false))) - (assert "Can read multiple arguments." - (and (|> (&;run (&;some &;any) args) - (case> (#;Left _) - false - - (#;Right args') - (n.= num-args (list;size args')))) - (|> (&;run (&;many &;any) args) - (case> (#;Left _) - (n.= +0 num-args) - - (#;Right args') - (n.= num-args (list;size args')))))) + (test "Can read multiple arguments." + (and (|> (&;run (&;some &;any) args) + (case> (#;Left _) + false + + (#;Right args') + (n.= num-args (list;size args')))) + (|> (&;run (&;many &;any) args) + (case> (#;Left _) + (n.= +0 num-args) + + (#;Right args') + (n.= num-args (list;size args')))))) - (assert "Can use custom token parsers." - (|> (&;run (&;parse Nat/decode) args) - (case> (#;Left _) - (n.= +0 num-args) - - (#;Right parsed) - (Text/= (Nat/encode parsed) - (default (undefined) - (list;head args)))))) + (test "Can use custom token parsers." + (|> (&;run (&;parse Nat/decode) args) + (case> (#;Left _) + (n.= +0 num-args) + + (#;Right parsed) + (Text/= (Nat/encode parsed) + (default (undefined) + (list;head args)))))) - (assert "Can obtain option values." - (and (|> (&;run (&;option (list option-name)) (list& option-name args)) - (case> (#;Left _) - (n.= +0 num-args) - - (#;Right value) - (Text/= value (default (undefined) - (list;head args))))) - (|> (&;run (&;option (list option-name)) args) - (case> (#;Left _) true (#;Right _) false)))) + (test "Can obtain option values." + (and (|> (&;run (&;option (list option-name)) (list& option-name args)) + (case> (#;Left _) + (n.= +0 num-args) + + (#;Right value) + (Text/= value (default (undefined) + (list;head args))))) + (|> (&;run (&;option (list option-name)) args) + (case> (#;Left _) true (#;Right _) false)))) - (assert "Can check flags." - (and (|> (&;run (&;flag (list option-name)) (list& option-name args)) - (case> (#;Right true) true _ false)) - (|> (&;run (&;flag (list option-name)) args) - (case> (#;Right false) true _ false)))) + (test "Can check flags." + (and (|> (&;run (&;flag (list option-name)) (list& option-name args)) + (case> (#;Right true) true _ false)) + (|> (&;run (&;flag (list option-name)) args) + (case> (#;Right false) true _ false)))) - (assert "Can query if there are any more inputs." - (and (|> (&;run &;end args) - (case> (#;Right []) (n.= +0 num-args) - _ (n.> +0 num-args))) - (|> (&;run (&;not &;end) args) - (case> (#;Right []) (n.> +0 num-args) - _ (n.= +0 num-args))))) + (test "Can query if there are any more inputs." + (and (|> (&;run &;end args) + (case> (#;Right []) (n.= +0 num-args) + _ (n.> +0 num-args))) + (|> (&;run (&;not &;end) args) + (case> (#;Right []) (n.> +0 num-args) + _ (n.= +0 num-args))))) )) diff --git a/stdlib/test/test/lux/concurrency/actor.lux b/stdlib/test/test/lux/concurrency/actor.lux index a92c2c376..a8f6ed7fb 100644 --- a/stdlib/test/test/lux/concurrency/actor.lux +++ b/stdlib/test/test/lux/concurrency/actor.lux @@ -20,7 +20,7 @@ (stop: (wrap []))) -(test: "Actors" +(context: "Actors" (let [counter-proc (: (&;Behavior Int (Promise Int)) [(function [self output state] (let [state' (i.inc state)] @@ -28,22 +28,22 @@ (Promise/wrap (#;Right state'))))) (function [?error state] (Promise/wrap []))])] ($_ seq - (assert "Can check where an actor is alive." - (let [counter (: (&;Actor Int (Promise Int)) - (io;run (&;spawn 0 counter-proc)))] - (&;alive? counter))) + (test "Can check where an actor is alive." + (let [counter (: (&;Actor Int (Promise Int)) + (io;run (&;spawn 0 counter-proc)))] + (&;alive? counter))) - (assert "Can poison/kill actors." - (let [counter (: (&;Actor Int (Promise Int)) - (io;run (&;spawn 0 counter-proc)))] - (and (io;run (&;poison counter)) - (not (&;alive? counter))))) + (test "Can poison/kill actors." + (let [counter (: (&;Actor Int (Promise Int)) + (io;run (&;spawn 0 counter-proc)))] + (and (io;run (&;poison counter)) + (not (&;alive? counter))))) - (assert "Can't poison an already poisoned actor." - (let [counter (: (&;Actor Int (Promise Int)) - (io;run (&;spawn 0 counter-proc)))] - (and (io;run (&;poison counter)) - (not (io;run (&;poison counter)))))) + (test "Can't poison an already poisoned actor." + (let [counter (: (&;Actor Int (Promise Int)) + (io;run (&;spawn 0 counter-proc)))] + (and (io;run (&;poison counter)) + (not (io;run (&;poison counter)))))) (do Monad<Promise> [#let [counter (: (&;Actor Int (Promise Int)) @@ -57,10 +57,10 @@ =1 output-1 =2 output-2 =3 output-3] - (assert "Can send messages to actors." - (and (i.= 1 =1) - (i.= 2 =2) - (i.= 3 =3)))) + (test "Can send messages to actors." + (and (i.= 1 =1) + (i.= 2 =2) + (i.= 3 =3)))) (do Monad<Promise> [#let [adder (: Adder @@ -69,11 +69,11 @@ t2 (add! 2 adder) t3 (add! 3 adder) #let [_ (io;run (&;poison adder))]] - (assert "Can use custom-defined actors." - (case [t1 t2 t3] - [[0 1] [1 3] [3 6]] - true + (test "Can use custom-defined actors." + (case [t1 t2 t3] + [[0 1] [1 3] [3 6]] + true - _ - false))) + _ + false))) ))) diff --git a/stdlib/test/test/lux/concurrency/atom.lux b/stdlib/test/test/lux/concurrency/atom.lux index 84deafa07..e3f30902b 100644 --- a/stdlib/test/test/lux/concurrency/atom.lux +++ b/stdlib/test/test/lux/concurrency/atom.lux @@ -9,24 +9,24 @@ ["R" math/random]) lux/test) -(test: "Atoms" +(context: "Atoms" [value R;nat swap-value R;nat set-value R;nat #let [box (&;atom value)]] ($_ seq - (assert "Can obtain the value of an atom." - (n.= value (io;run (&;get box)))) + (test "Can obtain the value of an atom." + (n.= value (io;run (&;get box)))) - (assert "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))))) - (assert "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))))) - (assert "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 245428f38..2d9a45167 100644 --- a/stdlib/test/test/lux/concurrency/frp.lux +++ b/stdlib/test/test/lux/concurrency/frp.lux @@ -17,108 +17,108 @@ _ (&;close _chan)] (wrap _chan))))) -(test: "FRP" +(context: "FRP" ($_ seq (do Monad<Promise> [elems (&;consume (List->Chan (list 0 1 2 3 4 5)))] - (assert "Can consume a chan into a list." - (case elems - (^ (list 0 1 2 3 4 5)) - true + (test "Can consume a chan into a list." + (case elems + (^ (list 0 1 2 3 4 5)) + true - _ - false))) + _ + false))) (do Monad<Promise> [elems (&;consume (let [input (List->Chan (list 0 1 2 3 4 5)) output (: (&;Chan Int) (&;chan))] (exec (&;pipe input output) output)))] - (assert "Can pipe one channel into another." - (case elems - (^ (list 0 1 2 3 4 5)) - true + (test "Can pipe one channel into another." + (case elems + (^ (list 0 1 2 3 4 5)) + true - _ - false))) + _ + false))) (do Monad<Promise> [elems (&;consume (&;filter i.even? (List->Chan (list 0 1 2 3 4 5))))] - (assert "Can filter a channel's elements." - (case elems - (^ (list 0 2 4)) - true + (test "Can filter a channel's elements." + (case elems + (^ (list 0 2 4)) + true - _ - false))) + _ + false))) (do Monad<Promise> [elems (&;consume (&;merge (list (List->Chan (list 0 1 2 3 4 5)) (List->Chan (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 + (test "Can merge channels." + (case elems + (^ (list 0 1 2 3 4 5 0 -1 -2 -3 -4 -5)) + true - _ - false))) + _ + false))) (do Monad<Promise> [output (&;fold (function [base input] (Promise/wrap (i.+ input base))) 0 (List->Chan (list 0 1 2 3 4 5)))] - (assert "Can fold over a channel." - (i.= 15 output))) + (test "Can fold over a channel." + (i.= 15 output))) (do Monad<Promise> [elems (&;consume (&;distinct number;Eq<Int> (List->Chan (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 + (test "Can avoid immediate repetition in the channel." + (case elems + (^ (list 0 1 2 3 4 5)) + true - _ - false))) + _ + false))) (do Monad<Promise> [elems (&;consume (&;once (:: promise;Monad<Promise> wrap 12345)))] - (assert "Can convert a promise into a single-value channel." - (case elems - (^ (list 12345)) - true + (test "Can convert a promise into a single-value channel." + (case elems + (^ (list 12345)) + true - _ - false))) + _ + false))) (do Monad<Promise> [elems (&;consume (:: &;Functor<Chan> map i.inc (List->Chan (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 + (test "Functor goes over every element in a channel." + (case elems + (^ (list 1 2 3 4 5 6)) + true - _ - false))) + _ + false))) (do Monad<Promise> [elems (&;consume (let [(^open) &;Applicative<Chan>] (apply (wrap i.inc) (wrap 12345))))] - (assert "Applicative works over all channel values." - (case elems - (^ (list 12346)) - true + (test "Applicative works over all channel values." + (case elems + (^ (list 12346)) + true - _ - false))) + _ + false))) (do Monad<Promise> [elems (&;consume (do &;Monad<Chan> [f (wrap i.inc) a (wrap 12345)] (wrap (f a))))] - (assert "Monad works over all channel values." - (case elems - (^ (list 12346)) - true + (test "Monad works over all channel values." + (case elems + (^ (list 12346)) + true - _ - false))) + _ + false))) )) diff --git a/stdlib/test/test/lux/concurrency/promise.lux b/stdlib/test/test/lux/concurrency/promise.lux index 8c4e623e4..30802085b 100644 --- a/stdlib/test/test/lux/concurrency/promise.lux +++ b/stdlib/test/test/lux/concurrency/promise.lux @@ -9,63 +9,63 @@ ["R" math/random]) lux/test) -(test: "Promises" +(context: "Promises" ($_ seq (do &;Monad<Promise> [running? (&;future (io true))] - (assert "Can run IO actions in separate threads." - running?)) + (test "Can run IO actions in separate threads." + running?)) (do &;Monad<Promise> [_ (&;wait +500)] - (assert "Can wait for a specified amount of time." - true)) + (test "Can wait for a specified amount of time." + true)) (do &;Monad<Promise> [[left right] (&;seq (&;future (io true)) (&;future (io false)))] - (assert "Can combine promises sequentially." - (and left (not right)))) + (test "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))] - (assert "Can combine promises alternatively." - (case [?left ?right] - [(#;Left true) (#;Right false)] - true + (test "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))] - (assert "Can combine promises alternatively [Part 2]." - (and ?left (not ?right)))) + (test "Can combine promises alternatively [Part 2]." + (and ?left (not ?right)))) - (assert "Can poll a promise for its value." - (and (|> (&;poll (:: &;Monad<Promise> wrap true)) - (case> (#;Some true) true _ false)) - (|> (&;poll (&;delay +200 true)) - (case> #;None true _ false)))) + (test "Can poll a promise for its value." + (and (|> (&;poll (:: &;Monad<Promise> wrap true)) + (case> (#;Some true) true _ false)) + (|> (&;poll (&;delay +200 true)) + (case> #;None true _ false)))) - (assert "Cant re-resolve a resolved promise." - (and (not (io;run (&;resolve false (:: &;Monad<Promise> wrap true)))) - (io;run (&;resolve true (: (&;Promise Bool) (&;promise)))))) + (test "Cant re-resolve a resolved promise." + (and (not (io;run (&;resolve false (:: &;Monad<Promise> wrap true)))) + (io;run (&;resolve true (: (&;Promise Bool) (&;promise)))))) (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 + (test "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 c1c8144ae..8471eb67a 100644 --- a/stdlib/test/test/lux/concurrency/stm.lux +++ b/stdlib/test/test/lux/concurrency/stm.lux @@ -12,7 +12,7 @@ (def: iterations/processes Int 100) -(test: "STM" +(context: "STM" (do promise;Monad<Promise> [#let [_var (&;var 0) changes (io;run (&;follow _var))] @@ -29,17 +29,17 @@ ?c2+changes' changes' #let [[c2 changes'] (default [-1 changes] ?c2+changes')]] ($_ seq - (assert "Can read STM vars." - (i.= 0 output1)) + (test "Can read STM vars." + (i.= 0 output1)) - (assert "Can write STM vars." - (i.= 5 output2)) + (test "Can write STM vars." + (i.= 5 output2)) - (assert "Can update STM vars." - (i.= 15 output3)) + (test "Can update STM vars." + (i.= 15 output3)) - (assert "Can follow all the changes to STM vars." - (and (i.= 5 c1) (i.= 15 c2))) + (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> @@ -49,7 +49,7 @@ (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)))) + (test "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 133629e45..b053e4d38 100644 --- a/stdlib/test/test/lux/control/cont.lux +++ b/stdlib/test/test/lux/control/cont.lux @@ -11,65 +11,65 @@ ["R" math/random]) lux/test) -(test: "Continuations" +(context: "Continuations" [sample R;nat #let [(^open "&/") &;Monad<Cont>] elems (R;list +3 R;nat)] ($_ seq - (assert "Can run continuations to compute their values." - (n.= sample (&;run (&/wrap sample)))) + (test "Can run continuations to compute their values." + (n.= sample (&;run (&/wrap sample)))) - (assert "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))))) - (assert "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))))) - (assert "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)))))) - (assert "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)))))) - (assert "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)))))) - (assert "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/effect.lux b/stdlib/test/test/lux/control/effect.lux index abbdca56a..65a7646ca 100644 --- a/stdlib/test/test/lux/control/effect.lux +++ b/stdlib/test/test/lux/control/effect.lux @@ -45,7 +45,7 @@ Handler<EffA,IO> Handler<EffB,IO> Handler<EffC,IO>)) ## [Tests] -(test: "Algebraic effects" +(context: "Algebraic effects" (with-expansions [<single-effect-tests> (do-template [<op> <op-size> <field> <field-value>] [(io;run (with-handler Handler<EffABC,IO> @@ -60,13 +60,13 @@ [opA +10 fieldA +10] [opB +4 fieldB +20] [opC +2 fieldC +30])] - (assert "Can handle effects using handlers." - (and <single-effect-tests> + (test "Can handle effects using handlers." + (and <single-effect-tests> - (n.= +60 (io;run (with-handler Handler<EffABC,IO> - (doE Functor<EffABC> - [a (lift fieldA) - b (lift fieldB) - c (lift fieldC)] - (wrap ($_ n.+ a b c)))))) - )))) + (n.= +60 (io;run (with-handler Handler<EffABC,IO> + (doE Functor<EffABC> + [a (lift fieldA) + b (lift fieldB) + c (lift fieldC)] + (wrap ($_ n.+ a b c)))))) + )))) diff --git a/stdlib/test/test/lux/control/exception.lux b/stdlib/test/test/lux/control/exception.lux index bef3ae4cd..d8c4ff9c2 100644 --- a/stdlib/test/test/lux/control/exception.lux +++ b/stdlib/test/test/lux/control/exception.lux @@ -16,7 +16,7 @@ (exception: Unknown-Exception) -(test: "Exceptions" +(context: "Exceptions" [should-throw? R;bool which? R;bool should-catch? R;bool @@ -43,5 +43,5 @@ (&;catch Some-Exception (function [ex] some-val)) (&;catch Another-Exception (function [ex] another-val)) (&;otherwise (function [ex] otherwise-val)))]] - (assert "Catch and otherwhise handlers can properly handle the flow of exception-handling." - (n.= expected actual))) + (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 b4c48a541..79ec0ed5e 100644 --- a/stdlib/test/test/lux/control/interval.lux +++ b/stdlib/test/test/lux/control/interval.lux @@ -11,34 +11,34 @@ ["S" coll/set] ["L" coll/list]))) -(test: "Equality." +(context: "Equality." [bottom R;int top R;int #let [(^open "&/") &;Eq<Interval>]] ($_ seq - (assert "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)))))) - -(test: "Boundaries" + (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 - (assert "Every boundary value belongs to it's interval." - (and (&;within? interval bottom) - (&;within? interval top))) - (assert "Every interval starts with its bottom." - (&;starts-with? bottom interval)) - (assert "Every interval ends with its top." - (&;ends-with? top interval)) - (assert "The boundary values border the interval." - (and (&;borders? interval bottom) - (&;borders? interval top))) + (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) @@ -78,7 +78,7 @@ gen-outer gen-singleton)) -(test: "Unions" +(context: "Unions" [some-interval gen-interval left-inner gen-inner right-inner gen-inner @@ -88,17 +88,17 @@ right-outer gen-outer #let [(^open "&/") &;Eq<Interval>]] ($_ seq - (assert "The union of an interval to itself yields the same interval." - (&/= some-interval (&;union some-interval some-interval))) - (assert "The union of 2 inner intervals is another inner interval." - (&;inner? (&;union left-inner right-inner))) - (assert "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)))) + (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)))) )) -(test: "Intersections" +(context: "Intersections" [some-interval gen-interval left-inner gen-inner right-inner gen-inner @@ -108,27 +108,27 @@ right-outer gen-outer #let [(^open "&/") &;Eq<Interval>]] ($_ seq - (assert "The intersection of an interval to itself yields the same interval." - (&/= some-interval (&;intersection some-interval some-interval))) - (assert "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)))) - (assert "The intersection of 2 outer intervals is another outer interval." - (&;outer? (&;intersection left-outer right-outer))) + (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))) )) -(test: "Complement" +(context: "Complement" [some-interval gen-interval #let [(^open "&/") &;Eq<Interval>]] ($_ seq - (assert "The complement of a complement is the same as the original." - (&/= some-interval (|> some-interval &;complement &;complement))) - (assert "The complement of an interval does not overlap it." - (not (&;overlaps? some-interval (&;complement some-interval)))) + (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)))) )) -(test: "Positioning/location" +(context: "Positioning/location" [[l m r] (|> (R;set number;Hash<Int> +3 R;int) (:: @ map (|>. S;to-list (L;sort i.<) @@ -140,15 +140,15 @@ #let [left (&;singleton number;Enum<Int> l) right (&;singleton number;Enum<Int> r)]] ($_ seq - (assert "'precedes?' and 'succeeds?' are symetric." - (and (&;precedes? right left) - (&;succeeds? left right))) - (assert "Can check if an interval is before or after some element." - (and (&;before? m left) - (&;after? m right))) + (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))) )) -(test: "Touching intervals" +(context: "Touching intervals" [[b t1 t2] (|> (R;set number;Hash<Int> +3 R;int) (:: @ map (|>. S;to-list (L;sort i.<) @@ -160,19 +160,19 @@ #let [int-left (&;between number;Enum<Int> t1 t2) int-right (&;between number;Enum<Int> b t1)]] ($_ seq - (assert "An interval meets another if it's top is the other's bottom." - (&;meets? int-left int-right)) - (assert "Two intervals touch one another if any one meets the other." - (&;touches? int-left int-right)) - (assert "Can check if 2 intervals start together." - (&;starts? (&;between number;Enum<Int> b t2) - (&;between number;Enum<Int> b t1))) - (assert "Can check if 2 intervals finish together." - (&;finishes? (&;between number;Enum<Int> b t2) - (&;between number;Enum<Int> t1 t2))) + (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))) )) -(test: "Nesting & overlap" +(context: "Nesting & overlap" [some-interval gen-interval [x0 x1 x2 x3] (|> (R;set number;Hash<Int> +4 R;int) (:: @ map (|>. S;to-list @@ -183,35 +183,35 @@ _ (undefined)))))] ($_ seq - (assert "Every interval is nested into itself." - (&;nested? some-interval some-interval)) - (assert "No interval overlaps with itself." - (not (&;overlaps? some-interval some-interval))) + (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)] - (assert "Inner intervals can be nested inside one another." - (and (&;nested? large-inner small-inner) - (not (&;nested? small-inner large-inner))))) + (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)] - (assert "Inner intervals can overlap one another." - (and (&;overlaps? left-inner right-inner) - (&;overlaps? right-inner left-inner)))) + (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)] - (assert "Outer intervals can be nested inside one another." - (and (&;nested? small-outer large-outer) - (not (&;nested? large-outer small-outer))))) + (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)] - (assert "Inners can be nested inside outers." - (and (&;nested? outer left-inner) - (&;nested? outer right-inner)))) + (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)] - (assert "Inners can overlap outers." - (and (&;overlaps? outer left-inner) - (&;overlaps? outer right-inner)))) + (test "Inners can overlap outers." + (and (&;overlaps? outer left-inner) + (&;overlaps? outer right-inner)))) )) diff --git a/stdlib/test/test/lux/control/pipe.lux b/stdlib/test/test/lux/control/pipe.lux index 4687a5635..ca80e8c1b 100644 --- a/stdlib/test/test/lux/control/pipe.lux +++ b/stdlib/test/test/lux/control/pipe.lux @@ -11,64 +11,64 @@ ["R" math/random]) lux/test) -(test: "Pipes" +(context: "Pipes" ($_ seq - (assert "Can dismiss previous pipeline results and begin a new line." - (|> 20 - (i.* 3) - (i.+ 4) - (_> 0 i.inc) - (i.= 1))) + (test "Can dismiss previous pipeline results and begin a new line." + (|> 20 + (i.* 3) + (i.+ 4) + (_> 0 i.inc) + (i.= 1))) - (assert "Can give names to piped values within a pipeline's scope." - (and (|> 5 - (@> [(i.+ @ @)]) - (i.= 10)) - (|> 5 - (@> X [(i.+ X X)]) - (i.= 10)))) + (test "Can give names to piped values within a pipeline's scope." + (and (|> 5 + (@> [(i.+ @ @)]) + (i.= 10)) + (|> 5 + (@> X [(i.+ X X)]) + (i.= 10)))) - (assert "Can do branching in pipelines." - (and (|> 5 - (?> [i.even?] [(i.* 2)] - [i.odd?] [(i.* 3)] - [(_> -1)]) - (i.= 15)) - (|> 4 - (?> [i.even?] [(i.* 2)] - [i.odd?] [(i.* 3)]) - (i.= 8)) - (|> 5 - (?> [i.even?] [(i.* 2)] - [(_> -1)]) - (i.= -1)))) + (test "Can do branching in pipelines." + (and (|> 5 + (?> [i.even?] [(i.* 2)] + [i.odd?] [(i.* 3)] + [(_> -1)]) + (i.= 15)) + (|> 4 + (?> [i.even?] [(i.* 2)] + [i.odd?] [(i.* 3)]) + (i.= 8)) + (|> 5 + (?> [i.even?] [(i.* 2)] + [(_> -1)]) + (i.= -1)))) - (assert "Can loop within pipelines." - (|> 1 - (!> [(i.< 10)] - [i.inc]) - (i.= 10))) + (test "Can loop within pipelines." + (|> 1 + (!> [(i.< 10)] + [i.inc]) + (i.= 10))) - (assert "Can use monads within pipelines." - (|> 5 - (%> Monad<Identity> - [(i.* 3)] - [(i.+ 4)] - [i.inc]) - (i.= 20))) + (test "Can use monads within pipelines." + (|> 5 + (%> Monad<Identity> + [(i.* 3)] + [(i.+ 4)] + [i.inc]) + (i.= 20))) - (assert "Can pattern-match against piped values." - (|> 5 - (case> 0 "zero" - 1 "one" - 2 "two" - 3 "three" - 4 "four" - 5 "five" - 6 "six" - 7 "seven" - 8 "eight" - 9 "nine" - _ "???") - (T/= "five"))) + (test "Can pattern-match against piped values." + (|> 5 + (case> 0 "zero" + 1 "one" + 2 "two" + 3 "three" + 4 "four" + 5 "five" + 6 "six" + 7 "seven" + 8 "eight" + 9 "nine" + _ "???") + (T/= "five"))) )) diff --git a/stdlib/test/test/lux/control/reader.lux b/stdlib/test/test/lux/control/reader.lux index 85b5edf8b..f7aa8630f 100644 --- a/stdlib/test/test/lux/control/reader.lux +++ b/stdlib/test/test/lux/control/reader.lux @@ -9,29 +9,29 @@ [number])) lux/test) -(test: "Readers" +(context: "Readers" ($_ seq - (assert "" (i.= 123 (&;run 123 &;ask))) - (assert "" (i.= 246 (&;run 123 (&;local (i.* 2) &;ask)))) - (assert "" (i.= 134 (&;run 123 (:: &;Functor<Reader> map i.inc (i.+ 10))))) - (assert "" (i.= 10 (&;run 123 (:: &;Applicative<Reader> wrap 10)))) - (assert "" (i.= 30 (&;run 123 (let [(^open "&/") &;Applicative<Reader>] - (&/apply (&/wrap (i.+ 10)) (&/wrap 20)))))) - (assert "" (i.= 30 (&;run 123 (do &;Monad<Reader> - [f (wrap i.+) - x (wrap 10) - y (wrap 20)] - (wrap (f x y)))))))) + (test "" (i.= 123 (&;run 123 &;ask))) + (test "" (i.= 246 (&;run 123 (&;local (i.* 2) &;ask)))) + (test "" (i.= 134 (&;run 123 (:: &;Functor<Reader> map i.inc (i.+ 10))))) + (test "" (i.= 10 (&;run 123 (:: &;Applicative<Reader> wrap 10)))) + (test "" (i.= 30 (&;run 123 (let [(^open "&/") &;Applicative<Reader>] + (&/apply (&/wrap (i.+ 10)) (&/wrap 20)))))) + (test "" (i.= 30 (&;run 123 (do &;Monad<Reader> + [f (wrap i.+) + x (wrap 10) + y (wrap 20)] + (wrap (f x y)))))))) -(test: "Monad transformer" +(context: "Monad transformer" (let [(^open "io/") io;Monad<IO>] - (assert "Can add reader functionality to any monad." - (|> (do (&;ReaderT io;Monad<IO>) - [a (&;lift-reader (io/wrap 123)) - b (wrap 456)] - (wrap (i.+ a b))) - (&;run "") - io;run - (case> 579 true - _ false))) + (test "Can add reader functionality to any monad." + (|> (do (&;ReaderT io;Monad<IO>) + [a (&;lift-reader (io/wrap 123)) + b (wrap 456)] + (wrap (i.+ a b))) + (&;run "") + io;run + (case> 579 true + _ false))) )) diff --git a/stdlib/test/test/lux/control/state.lux b/stdlib/test/test/lux/control/state.lux index de1560f48..d789010ea 100644 --- a/stdlib/test/test/lux/control/state.lux +++ b/stdlib/test/test/lux/control/state.lux @@ -18,91 +18,91 @@ product;right (n.= output))) -(test: "Basics" +(context: "Basics" [state R;nat value R;nat] ($_ seq - (assert "Can get the state as a value." - (with-conditions [state state] - &;get)) - (assert "Can replace the state." - (with-conditions [state value] - (do &;Monad<State> - [_ (&;put value)] - &;get))) - (assert "Can update the state." - (with-conditions [state (n.* value state)] - (do &;Monad<State> - [_ (&;update (n.* value))] - &;get))) - (assert "Can use the state." - (with-conditions [state (n.inc state)] - (&;use n.inc))) - (assert "Can use a temporary (local) state." - (with-conditions [state (n.* value state)] - (&;local (n.* value) - &;get))) + (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))) )) -(test: "Structures" +(context: "Structures" [state R;nat value R;nat] ($_ seq - (assert "Can use functor." - (with-conditions [state (n.inc state)] - (:: &;Functor<State> map n.inc &;get))) - (assert "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)))))) - (assert "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)))))) + (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)))))) )) -(test: "Monad transformer" +(context: "Monad transformer" [state R;nat left R;nat right R;nat] (let [lift (&;lift-state io;Monad<IO>) (^open "io/") io;Monad<IO>] - (assert "Can add state functionality to any monad." - (|> (: (&;State' io;IO Nat Nat) - (do (&;StateT io;Monad<IO>) - [a (lift (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'))))) + (test "Can add state functionality to any monad." + (|> (: (&;State' io;IO Nat Nat) + (do (&;StateT io;Monad<IO>) + [a (lift (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'))))) )) -(test: "Loops" +(context: "Loops" [limit (|> R;nat (:: @ map (n.% +10))) #let [condition (do &;Monad<State> [state &;get] (wrap (n.< limit state)))]] ($_ seq - (assert "'while' will only execute if the condition is true." - (|> (&;while condition (&;update n.inc)) - (&;run +0) - (case> [state' output'] - (n.= limit state')))) - (assert "'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')))))) + (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/control/thunk.lux b/stdlib/test/test/lux/control/thunk.lux index cc8ca653d..506c675a1 100644 --- a/stdlib/test/test/lux/control/thunk.lux +++ b/stdlib/test/test/lux/control/thunk.lux @@ -6,18 +6,18 @@ ["R" math/random]) lux/test) -(test: "Thunks" +(context: "Thunks" [left R;nat right R;nat #let [thunk (&;freeze (n.* left right)) expected (n.* left right)]] ($_ seq - (assert "Thunking does not alter the expected value." - (n.= expected - (&;thaw thunk))) - (assert "Thunks only evaluate once." - (and (not (is expected - (&;thaw thunk))) - (is (&;thaw thunk) - (&;thaw thunk)))) + (test "Thunking does not alter the expected value." + (n.= expected + (&;thaw thunk))) + (test "Thunks only evaluate once." + (and (not (is expected + (&;thaw thunk))) + (is (&;thaw thunk) + (&;thaw thunk)))) )) diff --git a/stdlib/test/test/lux/data/bit.lux b/stdlib/test/test/lux/data/bit.lux index fe04806cd..789eaa88f 100644 --- a/stdlib/test/test/lux/data/bit.lux +++ b/stdlib/test/test/lux/data/bit.lux @@ -7,63 +7,63 @@ ["R" math/random]) lux/test) -(test: "Bitwise operations." +(context: "Bitwise operations." [pattern R;nat idx (:: @ map (n.% &;width) R;nat)] ($_ seq - (assert "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))))) - (assert "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)))) + (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)))))) - (assert "The negation of a bit pattern should have a complementary bit count." - (n.= &;width - (n.+ (&;count pattern) - (&;count (&;not pattern))))) - (assert "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)))) - (assert "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)))) - (assert "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)))) - (assert "Shift right respect the sign of ints." - (let [value (nat-to-int pattern)] - (if (i.< 0 value) - (i.< 0 (&;shift-right idx value)) - (i.>= 0 (&;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 (&;shift-right idx value)) + (i.>= 0 (&;shift-right idx value))))) )) diff --git a/stdlib/test/test/lux/data/bool.lux b/stdlib/test/test/lux/data/bool.lux index 51e499779..13203a5a3 100644 --- a/stdlib/test/test/lux/data/bool.lux +++ b/stdlib/test/test/lux/data/bool.lux @@ -6,28 +6,28 @@ ["R" math/random]) lux/test) -(test: "Boolean operations." +(context: "Boolean operations." [value R;bool] - (assert "" (and (not (and value (not value))) - (or value (not value)) + (test "" (and (not (and value (not value))) + (or value (not value)) - (not (:: Or@Monoid<Bool> unit)) - (:: Or@Monoid<Bool> append value (not value)) - (:: And@Monoid<Bool> unit) - (not (:: And@Monoid<Bool> append value (not value))) - - (:: Eq<Bool> = value (not (not value))) - (not (:: Eq<Bool> = value (not value))) + (not (:: Or@Monoid<Bool> unit)) + (:: Or@Monoid<Bool> append value (not value)) + (:: And@Monoid<Bool> unit) + (not (:: And@Monoid<Bool> append 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/char.lux b/stdlib/test/test/lux/data/char.lux index dd3c0c2da..e0f790905 100644 --- a/stdlib/test/test/lux/data/char.lux +++ b/stdlib/test/test/lux/data/char.lux @@ -9,40 +9,40 @@ ["R" math/random]) lux/test) -(test: "Char operations" +(context: "Char operations" [value R;char other R;char] ($_ seq - (assert "Can compare characterss for equality." - (:: Eq<Char> = value value)) + (test "Can compare characterss for equality." + (:: Eq<Char> = value value)) - (assert "Can go back-and-forth into numeric codes." - (|> value code char (:: Eq<Char> = value))) + (test "Can go back-and-forth into numeric codes." + (|> value code char (:: Eq<Char> = value))) - (assert "Can encode/decode as text." - (and (|> value - (:: Codec<Text,Char> encode) - (:: Codec<Text,Char> decode) - (case> (#;Right dec-value) - (:: Eq<Char> = value dec-value) + (test "Can encode/decode as text." + (and (|> value + (:: Codec<Text,Char> encode) + (:: Codec<Text,Char> decode) + (case> (#;Right dec-value) + (:: Eq<Char> = value dec-value) - (#;Left _) - false)) - (|> value as-text - (text;nth +0) (default (undefined)) - (:: Eq<Char> = value)))) + (#;Left _) + false)) + (|> value as-text + (text;nth +0) (default (undefined)) + (:: Eq<Char> = value)))) - (assert "Characters have an ordering relationship." - (if (:: Order<Char> < other value) - (:: Order<Char> > value other) - (:: Order<Char> >= other value))) + (test "Characters have an ordering relationship." + (if (:: Order<Char> < other value) + (:: Order<Char> > value other) + (:: Order<Char> >= other value))) )) -(test: "Special cases" - (assert "Can test whether a char is white-space." - (and (space? #" ") - (space? #"\n") - (space? #"\t") - (space? #"\r") - (space? #"\f") - (not (space? #"a"))))) +(context: "Special cases" + (test "Can test whether a char is white-space." + (and (space? #" ") + (space? #"\n") + (space? #"\t") + (space? #"\r") + (space? #"\f") + (not (space? #"a"))))) diff --git a/stdlib/test/test/lux/data/coll/array.lux b/stdlib/test/test/lux/data/coll/array.lux index 6006cf021..97ecedadb 100644 --- a/stdlib/test/test/lux/data/coll/array.lux +++ b/stdlib/test/test/lux/data/coll/array.lux @@ -14,7 +14,7 @@ (|> R;nat (:: R;Monad<Random> map (|>. (n.% +100) (n.+ +1))))) -(test: "Arrays and their copies" +(context: "Arrays and their copies" [size bounded-size original (R;array size R;nat) #let [clone (&;clone original) @@ -23,30 +23,30 @@ manual-copy (: (&;Array Nat) (&;new size))]] ($_ seq - (assert "Size function must correctly return size of array." - (n.= size (&;size original))) - (assert "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)))) - (assert "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))))) - (assert "Array folding should go over all values." - (exec (:: &;Fold<Array> fold - (function [x idx] - (exec (&;put idx x manual-copy) - (n.inc idx))) - +0 - original) - (:: (&;Eq<Array> number;Eq<Nat>) = original manual-copy))) - (assert "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))) + (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 (&;put 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))) )) -(test: "Array mutation" +(context: "Array mutation" [size bounded-size idx (:: @ map (n.% size) R;nat) array (|> (R;array size R;nat) @@ -54,59 +54,59 @@ #let [value (default (undefined) (&;get idx array))]] ($_ seq - (assert "Shouldn't be able to find a value in an unoccupied cell." - (case (&;get idx (&;remove idx array)) - (#;Some _) false - #;None true)) - (assert "You should be able to access values put into the array." - (case (&;get idx (&;put idx value array)) - (#;Some value') (n.= value' value) - #;None false)) - (assert "All cells should be occupied on a full array." - (and (n.= size (&;occupied array)) - (n.= +0 (&;vacant array)))) - (assert "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)))))) + (test "Shouldn't be able to find a value in an unoccupied cell." + (case (&;get idx (&;remove idx array)) + (#;Some _) false + #;None true)) + (test "You should be able to access values put into the array." + (case (&;get idx (&;put 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)))))) )) -(test: "Finding values." +(context: "Finding values." [size bounded-size array (|> (R;array size R;nat) (R;filter (|>. &;to-list (list;any? n.even?))))] ($_ seq - (assert "Can find values inside arrays." - (|> (&;find n.even? array) - (case> (#;Some _) true - #;None false))) - (assert "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))))) + (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))))) -(test: "Functor" +(context: "Functor" [size bounded-size array (R;array size R;nat)] (let [(^open) &;Functor<Array> (^open) (&;Eq<Array> number;Eq<Nat>)] ($_ seq - (assert "Functor shouldn't alter original array." - (let [copy (map id array)] - (and (= array copy) - (not (is array copy))))) - (assert "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))))))) + (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))))))) -(test: "Monoid" +(context: "Monoid" [sizeL bounded-size sizeR bounded-size left (R;array sizeL R;nat) @@ -115,16 +115,16 @@ (^open) (&;Eq<Array> number;Eq<Nat>) fusion (append left right)]] ($_ seq - (assert "Appending two arrays should produce a new one twice as large." - (n.= (n.+ sizeL sizeR) (&;size fusion))) - (assert "First elements of fused array should equal the first array." - (|> (: (&;Array Nat) - (&;new sizeL)) - (&;copy sizeL +0 fusion +0) - (= left))) - (assert "Last elements of fused array should equal the second array." - (|> (: (&;Array Nat) - (&;new sizeR)) - (&;copy sizeR sizeL fusion +0) - (= right))) + (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 ee54f9204..0153e8049 100644 --- a/stdlib/test/test/lux/data/coll/dict.lux +++ b/stdlib/test/test/lux/data/coll/dict.lux @@ -12,7 +12,7 @@ ["R" math/random]) lux/test) -(test: "Dictionaries." +(context: "Dictionaries." [#let [capped-nat (:: R;Monad<Random> map (n.% +100) R;nat)] size capped-nat dict (R;dict char;Hash<Char> size R;char capped-nat) @@ -21,110 +21,110 @@ test-val (|> R;nat (R;filter (function [val] (not (list;member? number;Eq<Nat> (&;values dict) val)))))] ($_ seq - (assert "Size function should correctly represent Dict size." - (n.= size (&;size dict))) + (test "Size function should correctly represent Dict size." + (n.= size (&;size dict))) - (assert "Dicts of size 0 should be considered empty." - (if (n.= +0 size) - (&;empty? dict) - (not (&;empty? dict)))) + (test "Dicts of size 0 should be considered empty." + (if (n.= +0 size) + (&;empty? dict) + (not (&;empty? dict)))) - (assert "The functions 'entries', 'keys' and 'values' should be synchronized." - (:: (list;Eq<List> (eq;conj char;Eq<Char> number;Eq<Nat>)) = - (&;entries dict) - (list;zip2 (&;keys dict) - (&;values dict)))) + (test "The functions 'entries', 'keys' and 'values' should be synchronized." + (:: (list;Eq<List> (eq;conj char;Eq<Char> number;Eq<Nat>)) = + (&;entries dict) + (list;zip2 (&;keys dict) + (&;values dict)))) - (assert "Dict should be able to recognize it's own keys." - (list;every? (function [key] (&;contains? key dict)) - (&;keys dict))) + (test "Dict should be able to recognize it's own keys." + (list;every? (function [key] (&;contains? key dict)) + (&;keys dict))) - (assert "Should be able to get every key." - (list;every? (function [key] (case (&;get key dict) - (#;Some _) true - _ false)) - (&;keys dict))) + (test "Should be able to get every key." + (list;every? (function [key] (case (&;get key dict) + (#;Some _) true + _ false)) + (&;keys dict))) - (assert "Shouldn't be able to access non-existant keys." - (case (&;get non-key dict) - (#;Some _) false - _ true)) + (test "Shouldn't be able to access non-existant keys." + (case (&;get non-key dict) + (#;Some _) false + _ true)) - (assert "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)) - (assert "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)) - (assert "Shouldn't be able to put~ an existing key." - (or (n.= +0 size) - (let [first-key (|> dict &;keys list;head (default (undefined)))] - (case (&;get first-key (&;put~ first-key test-val dict)) - (#;Some v) (not (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 (default (undefined)))] + (case (&;get first-key (&;put~ first-key test-val dict)) + (#;Some v) (not (n.= test-val v)) + _ true)))) - (assert "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 "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)))))) - (assert "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) + (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))) + _ + false))) - (assert "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 "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))))) - (assert "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 char;Hash<Char>) (= 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 char;Hash<Char>) (= dict))))) - (assert "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)))) - (assert "If you merge, and the second dict has overlapping keys, it should overwrite yours." - (let [dict' (|> dict &;entries - (List/map (function [[k v]] [k (n.inc v)])) - (&;from-list char;Hash<Char>)) - (^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 + (List/map (function [[k v]] [k (n.inc v)])) + (&;from-list char;Hash<Char>)) + (^open) (&;Eq<Dict> number;Eq<Nat>)] + (= dict' (&;merge dict' dict)))) - (assert "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))))) - (assert "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))) - (assert "Should be able to re-bind existing values to different keys." - (or (n.= +0 size) - (let [first-key (|> dict &;keys list;head (default (undefined))) - rebound (&;re-bind first-key non-key dict)] - (and (n.= (&;size dict) (&;size rebound)) - (&;contains? non-key rebound) - (not (&;contains? first-key rebound)) - (n.= (default (undefined) - (&;get first-key dict)) - (default (undefined) - (&;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 (default (undefined))) + rebound (&;re-bind first-key non-key dict)] + (and (n.= (&;size dict) (&;size rebound)) + (&;contains? non-key rebound) + (not (&;contains? first-key rebound)) + (n.= (default (undefined) + (&;get first-key dict)) + (default (undefined) + (&;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 0840b11e3..7e91ed06c 100644 --- a/stdlib/test/test/lux/data/coll/list.lux +++ b/stdlib/test/test/lux/data/coll/list.lux @@ -16,7 +16,7 @@ (|> R;nat (:: R;Monad<Random> map (|>. (n.% +100) (n.+ +10))))) -(test: "Lists: Part 1" +(context: "Lists: Part 1" [size bounded-size idx (:: @ map (n.% size) R;nat) sample (R;list size R;nat) @@ -26,42 +26,42 @@ #let [(^open) (&;Eq<List> number;Eq<Nat>) (^open "&/") &;Functor<List>]] ($_ seq - (assert "The size function should correctly portray the size of the list." - (n.= size (&;size sample))) + (test "The size function should correctly portray the size of the list." + (n.= size (&;size sample))) - (assert "The repeat function should produce as many elements as asked of it." - (n.= size (&;size (&;repeat size [])))) + (test "The repeat function should produce as many elements as asked of it." + (n.= size (&;size (&;repeat size [])))) - (assert "Reversing a list does not change it's size." - (n.= (&;size sample) - (&;size (&;reverse sample)))) + (test "Reversing a list does not change it's size." + (n.= (&;size sample) + (&;size (&;reverse sample)))) - (assert "Reversing a list twice results in the original list." - (= sample - (&;reverse (&;reverse sample)))) - - (assert "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)))))) - - (assert "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))) - - (assert "Any element of the list can be considered its member." - (let [elem (default (undefined) - (&;nth idx sample))] - (&;member? number;Eq<Nat> sample elem))) + (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 (default (undefined) + (&;nth idx sample))] + (&;member? number;Eq<Nat> sample elem))) )) -(test: "Lists: Part 2" +(context: "Lists: Part 2" [size bounded-size idx (:: @ map (n.% size) R;nat) sample (R;list size R;nat) @@ -71,60 +71,60 @@ #let [(^open) (&;Eq<List> number;Eq<Nat>) (^open "&/") &;Functor<List>]] ($_ seq - (assert "Appending the head and the tail should yield the original list." - (let [head (default (undefined) - (&;head sample)) - tail (default (undefined) - (&;tail sample))] - (= sample - (#;Cons head tail)))) - - (assert "Appending the inits and the last should yield the original list." - (let [(^open) &;Monoid<List> - inits (default (undefined) - (&;inits sample)) - last (default (undefined) - (&;last sample))] - (= sample - (append inits (list last))))) - - (assert "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)))) - - (assert "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 - (append left right)) - (= sample - (append left' right')) - (= sample - (append (&;take idx sample) - (&;drop idx sample))) - (= sample - (append (&;take-while n.even? sample) - (&;drop-while n.even? sample))) - ))) - - (assert "Segmenting the list in pairs should yield as many elements as N/2." - (n.= (n./ +2 size) - (&;size (&;as-pairs sample)))) - - (assert "Sorting a list shouldn't change it's size." - (n.= (&;size sample) - (&;size (&;sort n.< sample)))) - - (assert "Sorting a list with one order should yield the reverse of sorting it with the opposite order." - (= (&;sort n.< sample) - (&;reverse (&;sort n.> sample)))) + (test "Appending the head and the tail should yield the original list." + (let [head (default (undefined) + (&;head sample)) + tail (default (undefined) + (&;tail sample))] + (= sample + (#;Cons head tail)))) + + (test "Appending the inits and the last should yield the original list." + (let [(^open) &;Monoid<List> + inits (default (undefined) + (&;inits sample)) + last (default (undefined) + (&;last sample))] + (= sample + (append 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 + (append left right)) + (= sample + (append left' right')) + (= sample + (append (&;take idx sample) + (&;drop idx sample))) + (= sample + (append (&;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)))) )) -(test: "Lists: Part 3" +(context: "Lists: Part 3" [size bounded-size idx (:: @ map (n.% size) R;nat) sample (R;list size R;nat) @@ -134,88 +134,88 @@ #let [(^open) (&;Eq<List> number;Eq<Nat>) (^open "&/") &;Functor<List>]] ($_ seq - (assert "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 "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)))) - (assert "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 "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)))))) - (assert "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))) - ))) - - (assert "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)))))) - - (assert "List append is a monoid." - (let [(^open) &;Monoid<List>] - (and (= sample (append unit sample)) - (= sample (append sample unit)) - (let [[left right] (&;split size (append sample other-sample))] - (and (= sample left) - (= other-sample right)))))) - - (assert "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))))) - - (assert "List concatenation is a monad." - (let [(^open) &;Monad<List> - (^open) &;Monoid<List>] - (= (append sample other-sample) - (join (list sample other-sample))))) - - (assert "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)))) - - (assert "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))) - - (assert "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))))) + (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 (append unit sample)) + (= sample (append sample unit)) + (let [[left right] (&;split size (append 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>] + (= (append 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))))) )) -(test: "Monad transformer" +(context: "Monad transformer" (let [lift (&;lift-list io;Monad<IO>) (^open "io/") io;Monad<IO>] - (assert "Can add list functionality to any monad." - (|> (io;run (do (&;ListT io;Monad<IO>) - [a (lift (io/wrap 123)) - b (wrap 456)] - (wrap (i.+ a b)))) - (case> (^ (list 579)) true - _ false))) + (test "Can add list functionality to any monad." + (|> (io;run (do (&;ListT io;Monad<IO>) + [a (lift (io/wrap 123)) + b (wrap 456)] + (wrap (i.+ a b)))) + (case> (^ (list 579)) true + _ false))) )) diff --git a/stdlib/test/test/lux/data/coll/ordered.lux b/stdlib/test/test/lux/data/coll/ordered.lux index c1f5c9944..0ee02dea6 100644 --- a/stdlib/test/test/lux/data/coll/ordered.lux +++ b/stdlib/test/test/lux/data/coll/ordered.lux @@ -15,7 +15,7 @@ (|> R;nat (:: R;Monad<Random> map (n.% +100)))) -(test: "Sets" +(context: "Sets" [sizeL gen-nat sizeR gen-nat setL (|> (R;set number;Hash<Nat> sizeL gen-nat) @@ -24,44 +24,44 @@ (:: @ map (|>. S;to-list (&;from-list number;Order<Nat>)))) #let [(^open "&/") &;Eq<Set>]] ($_ seq - (assert "I can query the size of a set." - (n.= sizeL (&;size setL))) + (test "I can query the size of a set." + (n.= sizeL (&;size setL))) - (assert "Converting sets to/from lists can't change their values." - (|> setL - &;to-list (&;from-list number;Order<Nat>) - (&/= setL))) + (test "Converting sets to/from lists can't change their values." + (|> setL + &;to-list (&;from-list number;Order<Nat>) + (&/= setL))) - (assert "Order is preserved." - (let [listL (&;to-list setL) - (^open "L/") (list;Eq<List> number;Eq<Nat>)] - (L/= listL - (list;sort n.< listL)))) + (test "Order is preserved." + (let [listL (&;to-list setL) + (^open "L/") (list;Eq<List> number;Eq<Nat>)] + (L/= listL + (list;sort n.< listL)))) - (assert "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 sub-set of the union of itself with another." + (let [setLR (&;union setL setR)] + (and (&;sub? setLR setL) + (&;sub? setLR setR)))) - (assert "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 "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)))) - (assert "Union with the empty set leaves a set unchanged." - (&/= setL - (&;union (&;new number;Order<Nat>) - setL))) + (test "Union with the empty set leaves a set unchanged." + (&/= setL + (&;union (&;new number;Order<Nat>) + setL))) - (assert "Intersection with the empty set results in the empty set." - (let [empty-set (&;new number;Order<Nat>)] - (&/= empty-set - (&;intersection empty-set 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)))) - (assert "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 "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))))) - (assert "Every member of a set must be identifiable." - (list;every? (&;member? setL) (&;to-list setL))) + (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 f82216f54..fede1766a 100644 --- a/stdlib/test/test/lux/data/coll/priority-queue.lux +++ b/stdlib/test/test/lux/data/coll/priority-queue.lux @@ -18,32 +18,32 @@ &;empty inputs))) -(test: "Queues" +(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 - (assert "I can query the size of a queue (and empty queues have size 0)." - (n.= size (&;size sample))) + (test "I can query the size of a queue (and empty queues have size 0)." + (n.= size (&;size sample))) - (assert "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)))))) - (assert "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 - (default (undefined) (&;peek sample))) - (not (&;member? number;Eq<Nat> - (&;pop sample) - (default (undefined) (&;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 + (default (undefined) (&;peek sample))) + (not (&;member? number;Eq<Nat> + (&;pop sample) + (default (undefined) (&;peek sample)))))))) )) diff --git a/stdlib/test/test/lux/data/coll/queue.lux b/stdlib/test/test/lux/data/coll/queue.lux index 44123f8e3..1fdcbd25a 100644 --- a/stdlib/test/test/lux/data/coll/queue.lux +++ b/stdlib/test/test/lux/data/coll/queue.lux @@ -7,43 +7,43 @@ ["R" math/random]) lux/test) -(test: "Queues" +(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 - (assert "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 "I can query the size of a queue (and empty queues have size 0)." + (if (n.= +0 size) + (&;empty? sample) + (n.= size (&;size sample)))) - (assert "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)))))) - (assert "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)))) - (assert "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)) - (assert "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/seq.lux b/stdlib/test/test/lux/data/coll/seq.lux index a111ecb0e..f6d221180 100644 --- a/stdlib/test/test/lux/data/coll/seq.lux +++ b/stdlib/test/test/lux/data/coll/seq.lux @@ -19,7 +19,7 @@ (|> R;nat (:: R;Monad<Random> map (|>. (n.% +100) (n.+ +10) (n.max +1))))) -(test: "Seqs: Part 1" +(context: "Seqs: Part 1" [size bounded-size idx (:: @ map (n.% size) R;nat) sample (|> (R;list size R;nat) @@ -27,75 +27,75 @@ extra R;nat #let [(^open "&/") (&;Eq<Seq> number;Eq<Nat>)]] ($_ seq - (assert "Can convert to/from list." - (|> sample - &;to-list &;from-list - (&/= sample))) + (test "Can convert to/from list." + (|> sample + &;to-list &;from-list + (&/= sample))) - (assert "The size function should correctly portray the size of the seq." - (n.= size (&;size sample))) + (test "The size function should correctly portray the size of the seq." + (n.= size (&;size sample))) - (assert "Reversing a seq does not change it's size." - (n.= (&;size sample) - (&;size (&;reverse sample)))) + (test "Reversing a seq does not change it's size." + (n.= (&;size sample) + (&;size (&;reverse sample)))) - (assert "Reversing a seq twice results in the original seq." - (&/= sample - (&;reverse (&;reverse sample)))) + (test "Reversing a seq twice results in the original seq." + (&/= sample + (&;reverse (&;reverse sample)))) - (assert "If every element in a list satisfies a predicate, there can't be any that satisfy its complement." - (if (&;every? n.even? sample) - (not (&;any? (bool;complement n.even?) sample)) - (&;any? (bool;complement n.even?) sample))) + (test "If every element in a list satisfies a predicate, there can't be any that satisfy its complement." + (if (&;every? n.even? sample) + (not (&;any? (bool;complement n.even?) sample)) + (&;any? (bool;complement n.even?) sample))) - (assert "Any element of the list can be considered its member." - (and (&;member? number;Eq<Nat> - (&;prepend extra sample) - extra) - (&;member? number;Eq<Nat> - (&;append extra sample) - extra))) + (test "Any element of the list can be considered its member." + (and (&;member? number;Eq<Nat> + (&;prepend extra sample) + extra) + (&;member? number;Eq<Nat> + (&;append extra sample) + extra))) - (assert "Can do random access to seq elements." - (and (|> (&;prepend extra sample) - (&;nth +0) - (case> (#;Some reference) - (n.= reference extra) + (test "Can do random access to seq elements." + (and (|> (&;prepend extra sample) + (&;nth +0) + (case> (#;Some reference) + (n.= reference extra) - _ - false)) - (|> (&;append extra sample) - (&;nth size) - (case> (#;Some reference) - (n.= reference extra) + _ + false)) + (|> (&;append extra sample) + (&;nth size) + (case> (#;Some reference) + (n.= reference extra) - _ - false)))) + _ + false)))) )) -(test: "Seqs: Part 2" +(context: "Seqs: Part 2" [size bounded-size sample (|> (R;list size R;nat) (:: @ map &;from-list)) #let [(^open "&/") (&;Eq<Seq> number;Eq<Nat>) (^open "&/") &;Functor<Seq>]] ($_ seq - (assert "Functor should go over every element of the seq." - (let [there (&/map n.inc sample) - back-again (&/map n.dec there)] - (and (not (&/= sample there)) - (&/= sample back-again)))) + (test "Functor should go over every element of the seq." + (let [there (&/map n.inc sample) + back-again (&/map n.dec there)] + (and (not (&/= sample there)) + (&/= sample back-again)))) - (assert "Sorting a seq shouldn't change it's size." - (n.= (&;size sample) - (&;size (&;sort n.< sample)))) + (test "Sorting a seq shouldn't change it's size." + (n.= (&;size sample) + (&;size (&;sort n.< sample)))) - (assert "Sorting a seq with one order should yield the reverse of sorting it with the opposite order." - (&/= (&;sort n.< sample) - (&;reverse (&;sort n.> sample)))) + (test "Sorting a seq with one order should yield the reverse of sorting it with the opposite order." + (&/= (&;sort n.< sample) + (&;reverse (&;sort n.> sample)))) )) -(test: "Seqs: Part 3" +(context: "Seqs: Part 3" [size bounded-size idx (:: @ map (n.% size) R;nat) sample (|> (R;list size R;nat) @@ -107,23 +107,23 @@ #let [(^open "&/") (&;Eq<Seq> number;Eq<Nat>) (^open "&/") &;Monad<Seq>]] ($_ seq - (assert "Applicative allows you to create singleton seqs, and apply seqs of functions to seqs of values." - (and (&/= (&;seq elem) (&/wrap elem)) - (&/= (&/map n.inc sample) - (&/apply (&/wrap n.inc) sample)))) + (test "Applicative allows you to create singleton seqs, and apply seqs of functions to seqs of values." + (and (&/= (&;seq elem) (&/wrap elem)) + (&/= (&/map n.inc sample) + (&/apply (&/wrap n.inc) sample)))) - (assert "Seq concatenation is a monad." - (&/= (&;concat sample other-sample) - (&/join (&;seq sample other-sample)))) + (test "Seq concatenation is a monad." + (&/= (&;concat sample other-sample) + (&/join (&;seq sample other-sample)))) - (assert "You can find any value that satisfies some criterium, if such values exist in the seq." - (case (&;find n.even? sample) - (#;Some found) - (and (n.even? found) - (&;any? n.even? sample) - (not (&;every? (bool;complement n.even?) sample))) + (test "You can find any value that satisfies some criterium, if such values exist in the seq." + (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)))) + #;None + (and (not (&;any? n.even? sample)) + (&;every? (bool;complement n.even?) sample)))) )) diff --git a/stdlib/test/test/lux/data/coll/set.lux b/stdlib/test/test/lux/data/coll/set.lux index a91813675..23f23121a 100644 --- a/stdlib/test/test/lux/data/coll/set.lux +++ b/stdlib/test/test/lux/data/coll/set.lux @@ -13,7 +13,7 @@ (|> R;nat (:: R;Monad<Random> map (n.% +100)))) -(test: "Sets" +(context: "Sets" [sizeL gen-nat sizeR gen-nat setL (R;set number;Hash<Nat> sizeL gen-nat) @@ -22,41 +22,41 @@ (R;filter (. not (&;member? setL)))) #let [(^open "&/") &;Eq<Set>]] ($_ seq - (assert "I can query the size of a set." - (and (n.= sizeL (&;size setL)) - (n.= sizeR (&;size setR)))) - - (assert "Converting sets to/from lists can't change their values." - (|> setL - &;to-list (&;from-list number;Hash<Nat>) - (&/= setL))) - - (assert "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)))) - - (assert "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)))) - - (assert "Union with the empty set leaves a set unchanged." - (&/= setL - (&;union (&;new number;Hash<Nat>) - setL))) - - (assert "Intersection with the empty set results in the empty set." - (let [empty-set (&;new number;Hash<Nat>)] - (&/= empty-set - (&;intersection empty-set setL)))) - - (assert "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))))) - - (assert "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)))) + (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 6d26c569d..78921b83a 100644 --- a/stdlib/test/test/lux/data/coll/stack.lux +++ b/stdlib/test/test/lux/data/coll/stack.lux @@ -13,30 +13,30 @@ (|> R;nat (:: R;Monad<Random> map (n.% +100)))) -(test: "Stacks" +(context: "Stacks" [size gen-nat sample (R;stack size gen-nat) new-top gen-nat] ($_ seq - (assert "Can query the size of a stack." - (n.= size (&;size sample))) + (test "Can query the size of a stack." + (n.= size (&;size sample))) - (assert "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)))) - (assert "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'))) + )) - (assert "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 (default (undefined)) - (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 (default (undefined)) + (is new-top)))) )) diff --git a/stdlib/test/test/lux/data/coll/stream.lux b/stdlib/test/test/lux/data/coll/stream.lux index f68ae60f3..e12293fa7 100644 --- a/stdlib/test/test/lux/data/coll/stream.lux +++ b/stdlib/test/test/lux/data/coll/stream.lux @@ -12,7 +12,7 @@ ["R" math/random]) lux/test) -(test: "Streams" +(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)))) @@ -23,77 +23,77 @@ sample0 (&;iterate n.inc +0) sample1 (&;iterate n.inc offset)]] ($_ seq - (assert "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 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...))))) + )) - (assert "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)))) - (assert "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))))) - (assert "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)))))) - (assert "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))))) - (assert "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))))))) - (assert "'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))))) - (assert "Can cycle over the same elements as an infinite stream." - (|> (&;cycle cycle-seed) - (default (undefined)) - (&;nth cycle-sample-idx) - (n.= (default (undefined) - (list;nth (n.% size cycle-sample-idx) - cycle-seed))))) + (test "Can cycle over the same elements as an infinite stream." + (|> (&;cycle cycle-seed) + (default (undefined)) + (&;nth cycle-sample-idx) + (n.= (default (undefined) + (list;nth (n.% size cycle-sample-idx) + cycle-seed))))) )) diff --git a/stdlib/test/test/lux/data/coll/tree/rose.lux b/stdlib/test/test/lux/data/coll/tree/rose.lux index a4839c2a5..2933452f6 100644 --- a/stdlib/test/test/lux/data/coll/tree/rose.lux +++ b/stdlib/test/test/lux/data/coll/tree/rose.lux @@ -13,7 +13,7 @@ (|> R;nat (:: R;Monad<Random> map (n.% +100)))) -(test: "Trees" +(context: "Trees" [leaf (:: @ map &;leaf R;nat) branchS gen-nat branchV R;nat @@ -22,13 +22,13 @@ #let [(^open "&/") (&;Eq<Tree> number;Eq<Nat>) (^open "List/") (list;Eq<List> number;Eq<Nat>)]] ($_ seq - (assert "Can compare trees for equality." - (and (&/= leaf leaf) - (&/= branch branch) - (not (&/= leaf branch)) - (not (&/= leaf (&;branch branchV (List/map &;leaf (list;reverse branchC))))))) + (test "Can compare trees for equality." + (and (&/= leaf leaf) + (&/= branch branch) + (not (&/= leaf branch)) + (not (&/= leaf (&;branch branchV (List/map &;leaf (list;reverse branchC))))))) - (assert "Can flatten a tree to get all the nodes as a flat tree." - (List/= (list& branchV branchC) - (&;flatten branch))) + (test "Can flatten a tree to get all the nodes as a flat tree." + (List/= (list& branchV branchC) + (&;flatten branch))) )) diff --git a/stdlib/test/test/lux/data/coll/tree/zipper.lux b/stdlib/test/test/lux/data/coll/tree/zipper.lux index a6799d302..38dd55b99 100644 --- a/stdlib/test/test/lux/data/coll/tree/zipper.lux +++ b/stdlib/test/test/lux/data/coll/tree/zipper.lux @@ -28,7 +28,7 @@ zipper (recur (&;next zipper))))) -(test: "Zippers" +(context: "Zippers" [sample gen-tree new-val R;nat pre-val R;nat @@ -36,87 +36,87 @@ #let [(^open "Tree/") (rose;Eq<Tree> number;Eq<Nat>) (^open "List/") (list;Eq<List> number;Eq<Nat>)]] ($_ seq - (assert "Trees can be converted to/from zippers." - (|> sample - &;from-tree &;to-tree - (Tree/= sample))) + (test "Trees can be converted to/from zippers." + (|> sample + &;from-tree &;to-tree + (Tree/= sample))) - (assert "Creating a zipper gives you a root node." - (|> sample &;from-tree &;root?)) + (test "Creating a zipper gives you a root node." + (|> sample &;from-tree &;root?)) - (assert "Can move down inside branches. Can move up from lower nodes." - (let [zipper (&;from-tree sample)] - (if (&;branch? zipper) - (let [child (|> zipper &;down)] - (and (not (Tree/= sample (&;to-tree child))) - (|> child &;parent (default (undefined)) (is zipper)) - (|> child &;up (is zipper) not) - (|> child &;root (is zipper) not))) - (and (&;leaf? zipper) - (|> zipper (&;prepend-child new-val) &;branch?))))) + (test "Can move down inside branches. Can move up from lower nodes." + (let [zipper (&;from-tree sample)] + (if (&;branch? zipper) + (let [child (|> zipper &;down)] + (and (not (Tree/= sample (&;to-tree child))) + (|> child &;parent (default (undefined)) (is zipper)) + (|> child &;up (is zipper) not) + (|> child &;root (is zipper) not))) + (and (&;leaf? zipper) + (|> zipper (&;prepend-child new-val) &;branch?))))) - (assert "Can prepend and append children." - (let [zipper (&;from-tree 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 (&;from-tree 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))) - (assert "Can insert children around a node (unless it's root)." - (let [zipper (&;from-tree sample)] - (if (&;branch? zipper) - (let [mid-val (|> zipper &;down &;value) - zipper (|> zipper - &;down - (&;insert-left pre-val) - (default (undefined)) - (&;insert-right post-val) - (default (undefined)) - &;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 insert children around a node (unless it's root)." + (let [zipper (&;from-tree sample)] + (if (&;branch? zipper) + (let [mid-val (|> zipper &;down &;value) + zipper (|> zipper + &;down + (&;insert-left pre-val) + (default (undefined)) + (&;insert-right post-val) + (default (undefined)) + &;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)))))) - (assert "Can set and update the value of a node." - (|> sample &;from-tree (&;set new-val) &;value (n.= new-val))) + (test "Can set and update the value of a node." + (|> sample &;from-tree (&;set new-val) &;value (n.= new-val))) - (assert "Zipper traversal follows the outline of the tree depth-first." - (List/= (rose;flatten sample) - (loop [zipper (&;from-tree sample)] - (if (&;end? zipper) - (list (&;value zipper)) - (#;Cons (&;value zipper) - (recur (&;next zipper))))))) + (test "Zipper traversal follows the outline of the tree depth-first." + (List/= (rose;flatten sample) + (loop [zipper (&;from-tree sample)] + (if (&;end? zipper) + (list (&;value zipper)) + (#;Cons (&;value zipper) + (recur (&;next zipper))))))) - (assert "Backwards zipper traversal yield reverse tree flatten." - (List/= (list;reverse (rose;flatten sample)) - (loop [zipper (to-end (&;from-tree sample))] - (if (&;root? zipper) - (list (&;value zipper)) - (#;Cons (&;value zipper) - (recur (&;prev zipper))))))) + (test "Backwards zipper traversal yield reverse tree flatten." + (List/= (list;reverse (rose;flatten sample)) + (loop [zipper (to-end (&;from-tree sample))] + (if (&;root? zipper) + (list (&;value zipper)) + (#;Cons (&;value zipper) + (recur (&;prev zipper))))))) - (assert "Can remove nodes (except root nodes)." - (let [zipper (&;from-tree 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 (&;from-tree 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/coll/vector.lux b/stdlib/test/test/lux/data/coll/vector.lux index 6ad6934db..2816c904e 100644 --- a/stdlib/test/test/lux/data/coll/vector.lux +++ b/stdlib/test/test/lux/data/coll/vector.lux @@ -10,7 +10,7 @@ ["R" math/random]) lux/test) -(test: "Vectors" +(context: "Vectors" [size (|> R;nat (:: @ map (|>. (n.% +100) (n.max +1)))) idx (|> R;nat (:: @ map (n.% size))) sample (R;vector size R;nat) @@ -21,51 +21,51 @@ (^open "&/") &;Fold<Vector> (^open "&/") &;Monoid<Vector>]] ($_ seq - (assert "Can query size of vector." - (if (&;empty? sample) - (and (n.= +0 size) - (n.= +0 (&;size sample))) - (n.= size (&;size sample)))) + (test "Can query size of vector." + (if (&;empty? sample) + (and (n.= +0 size) + (n.= +0 (&;size sample))) + (n.= size (&;size sample)))) - (assert "Can add and remove elements to vectors." - (and (n.= (n.inc size) (&;size (&;add non-member sample))) - (n.= (n.dec size) (&;size (&;pop sample))))) + (test "Can add and remove elements to vectors." + (and (n.= (n.inc size) (&;size (&;add non-member sample))) + (n.= (n.dec size) (&;size (&;pop sample))))) - (assert "Can put and get elements into vectors." - (|> sample - (&;put idx non-member) - (&;nth idx) - (default (undefined)) - (is non-member))) + (test "Can put and get elements into vectors." + (|> sample + (&;put idx non-member) + (&;nth idx) + (default (undefined)) + (is non-member))) - (assert "Can update elements of vectors." - (|> sample - (&;put idx non-member) (&;update idx n.inc) - (&;nth idx) (default (undefined)) - (n.= (n.inc non-member)))) + (test "Can update elements of vectors." + (|> sample + (&;put idx non-member) (&;update idx n.inc) + (&;nth idx) (default (undefined)) + (n.= (n.inc non-member)))) - (assert "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))) - (assert "Can identify members of a vector." - (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 vector." + (and (not (&;member? number;Eq<Nat> sample non-member)) + (&;member? number;Eq<Nat> (&;add non-member sample) non-member))) - (assert "Can fold over elements of vector." - (n.= (List/fold n.+ +0 (&;to-list sample)) - (&/fold n.+ +0 sample))) + (test "Can fold over elements of vector." + (n.= (List/fold n.+ +0 (&;to-list sample)) + (&/fold n.+ +0 sample))) - (assert "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 "Functor goes over every element." + (let [there (&/map n.inc sample) + back-again (&/map n.dec there)] + (and (not (&/= sample there)) + (&/= sample back-again)))) - (assert "Applicative allows you to create singleton vectors, and apply vectors of functions to vectors of values." - (and (&/= (&;vector non-member) (&/wrap non-member)) - (&/= (&/map n.inc sample) (&/apply (&/wrap n.inc) sample)))) + (test "Applicative allows you to create singleton vectors, and apply vectors of functions to vectors of values." + (and (&/= (&;vector non-member) (&/wrap non-member)) + (&/= (&/map n.inc sample) (&/apply (&/wrap n.inc) sample)))) - (assert "Vector concatenation is a monad." - (&/= (&/append sample other-sample) - (&/join (&;vector sample other-sample)))) + (test "Vector concatenation is a monad." + (&/= (&/append sample other-sample) + (&/join (&;vector sample other-sample)))) )) diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux index 88e4603d8..e133ef87d 100644 --- a/stdlib/test/test/lux/data/format/json.lux +++ b/stdlib/test/test/lux/data/format/json.lux @@ -38,21 +38,21 @@ (r;dict text;Hash<Text> size (r;text size) gen-json) ))))) -(test: "JSON" +(context: "JSON" [sample gen-json #let [(^open "&/") &;Eq<JSON> (^open "&/") &;Codec<Text,JSON>]] ($_ seq - (assert "Every JSON is equal to itself." - (&/= sample sample)) + (test "Every JSON is equal to itself." + (&/= sample sample)) - (assert "Can encode/decode JSON." - (|> sample &/encode &/decode - (case> (#;Right result) - (&/= sample result) + (test "Can encode/decode JSON." + (|> sample &/encode &/decode + (case> (#;Right result) + (&/= sample result) - (#;Left _) - false))) + (#;Left _) + false))) )) (type: Variant @@ -125,14 +125,14 @@ (:: (d;Eq<Dict> i.=) = (get@ #dict recL) (get@ #dict recR)) )))) -(test: "Polytypism" +(context: "Polytypism" [sample gen-record #let [(^open "&/") Eq<Record> (^open "&/") Codec<JSON,Record>]] - (assert "Can encode/decode arbitrary types." - (|> sample &/encode &/decode - (case> (#;Right result) - (&/= sample result) + (test "Can encode/decode arbitrary types." + (|> sample &/encode &/decode + (case> (#;Right result) + (&/= sample result) - (#;Left _) - false)))) + (#;Left _) + false)))) diff --git a/stdlib/test/test/lux/data/format/xml.lux b/stdlib/test/test/lux/data/format/xml.lux index 16c586d63..414f19941 100644 --- a/stdlib/test/test/lux/data/format/xml.lux +++ b/stdlib/test/test/lux/data/format/xml.lux @@ -48,19 +48,19 @@ (R;dict ident;Hash<Ident> size xml-identifier^ (xml-text^ +0 +10)) (R;list size gen-xml))))))) -(test: "XML" +(context: "XML" [sample gen-xml #let [(^open "&/") &;Eq<XML> (^open "&/") &;Codec<Text,XML>]] ($_ seq - (assert "Every XML is equal to itself." - (&/= sample sample)) + (test "Every XML is equal to itself." + (&/= sample sample)) - (assert "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))) )) diff --git a/stdlib/test/test/lux/data/ident.lux b/stdlib/test/test/lux/data/ident.lux index 07aaf8d0a..060007607 100644 --- a/stdlib/test/test/lux/data/ident.lux +++ b/stdlib/test/test/lux/data/ident.lux @@ -13,7 +13,7 @@ (-> Nat (R;Random Text)) (|> (R;text size) (R;filter (. not (text;contains? ";"))))) -(test: "Idents" +(context: "Idents" [## First Ident sizeM1 (|> R;nat (:: @ map (n.% +100))) sizeN1 (|> R;nat (:: @ map (|>. (n.% +100) (n.max +1)))) @@ -29,41 +29,41 @@ #let [(^open "&/") &;Eq<Ident> (^open "&/") &;Codec<Text,Ident>]] ($_ seq - (assert "Can get the module & name parts of an ident." - (and (is module1 (&;module ident1)) - (is name1 (&;name ident1)))) + (test "Can get the module & name parts of an ident." + (and (is module1 (&;module ident1)) + (is name1 (&;name ident1)))) - (assert "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)))))) - (assert "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))) - (assert "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)) )) -(test: "Ident-related macros." +(context: "Ident-related macros." (let [(^open "&/") &;Eq<Ident>] ($_ seq - (assert "Can obtain Ident from symbol." - (and (&/= ["lux" "yolo"] (ident-for ;yolo)) - (&/= ["test/lux/data/ident" "yolo"] (ident-for ;;yolo)) - (&/= ["" "yolo"] (ident-for yolo)) - (&/= ["lux/test" "yolo"] (ident-for lux/test;yolo)))) + (test "Can obtain Ident from symbol." + (and (&/= ["lux" "yolo"] (ident-for ;yolo)) + (&/= ["test/lux/data/ident" "yolo"] (ident-for ;;yolo)) + (&/= ["" "yolo"] (ident-for yolo)) + (&/= ["lux/test" "yolo"] (ident-for lux/test;yolo)))) - (assert "Can obtain Ident from tag." - (and (&/= ["lux" "yolo"] (ident-for #;yolo)) - (&/= ["test/lux/data/ident" "yolo"] (ident-for #;;yolo)) - (&/= ["" "yolo"] (ident-for #yolo)) - (&/= ["lux/test" "yolo"] (ident-for #lux/test;yolo))))))) + (test "Can obtain Ident from tag." + (and (&/= ["lux" "yolo"] (ident-for #;yolo)) + (&/= ["test/lux/data/ident" "yolo"] (ident-for #;;yolo)) + (&/= ["" "yolo"] (ident-for #yolo)) + (&/= ["lux/test" "yolo"] (ident-for #lux/test;yolo))))))) diff --git a/stdlib/test/test/lux/data/identity.lux b/stdlib/test/test/lux/data/identity.lux index 227072da2..5995f1ae2 100644 --- a/stdlib/test/test/lux/data/identity.lux +++ b/stdlib/test/test/lux/data/identity.lux @@ -7,29 +7,29 @@ [text "Text/" Monoid<Text> Eq<Text>])) lux/test) -(test: "Identity" +(context: "Identity" (let [(^open "&/") &;Monad<Identity> (^open "&/") &;CoMonad<Identity>] ($_ seq - (assert "Functor does not affect values." - (Text/= "yololol" (&/map (Text/append "yolo") "lol"))) + (test "Functor does not affect values." + (Text/= "yololol" (&/map (Text/append "yolo") "lol"))) - (assert "Applicative does not affect values." - (and (Text/= "yolo" (&/wrap "yolo")) - (Text/= "yololol" (&/apply (&/wrap (Text/append "yolo")) (&/wrap "lol"))))) + (test "Applicative does not affect values." + (and (Text/= "yolo" (&/wrap "yolo")) + (Text/= "yololol" (&/apply (&/wrap (Text/append "yolo")) (&/wrap "lol"))))) - (assert "Monad does not affect values." - (Text/= "yololol" (do &;Monad<Identity> - [f (wrap Text/append) - a (wrap "yolo") - b (wrap "lol")] - (wrap (f a b))))) + (test "Monad does not affect values." + (Text/= "yololol" (do &;Monad<Identity> + [f (wrap Text/append) + a (wrap "yolo") + b (wrap "lol")] + (wrap (f a b))))) - (assert "CoMonad does not affect values." - (and (Text/= "yololol" (&/unwrap "yololol")) - (Text/= "yololol" (be &;CoMonad<Identity> - [f Text/append - a "yolo" - b "lol"] - (f a b))))) + (test "CoMonad does not affect values." + (and (Text/= "yololol" (&/unwrap "yololol")) + (Text/= "yololol" (be &;CoMonad<Identity> + [f Text/append + a "yolo" + b "lol"] + (f a b))))) ))) diff --git a/stdlib/test/test/lux/data/log.lux b/stdlib/test/test/lux/data/log.lux index ea174fc6b..959d1a65f 100644 --- a/stdlib/test/test/lux/data/log.lux +++ b/stdlib/test/test/lux/data/log.lux @@ -9,35 +9,35 @@ [product])) lux/test) -(test: "Logs" +(context: "Logs" (let [(^open "&/") (&;Monad<Log> text;Monoid<Text>)] ($_ seq - (assert "Functor respects Log." - (i.= 11 (product;right (&/map i.inc ["" 10])))) + (test "Functor respects Log." + (i.= 11 (product;right (&/map i.inc ["" 10])))) - (assert "Applicative respects Log." - (and (i.= 20 (product;right (&/wrap 20))) - (i.= 30 (product;right (&/apply (&/wrap (i.+ 10)) (&/wrap 20)))))) + (test "Applicative respects Log." + (and (i.= 20 (product;right (&/wrap 20))) + (i.= 30 (product;right (&/apply (&/wrap (i.+ 10)) (&/wrap 20)))))) - (assert "Monad respects Log." - (i.= 30 (product;right (do (&;Monad<Log> text;Monoid<Text>) - [f (wrap i.+) - a (wrap 10) - b (wrap 20)] - (wrap (f a b)))))) + (test "Monad respects Log." + (i.= 30 (product;right (do (&;Monad<Log> text;Monoid<Text>) + [f (wrap i.+) + a (wrap 10) + b (wrap 20)] + (wrap (f a b)))))) - (assert "Can log any value." - (Text/= "YOLO" (product;left (&;log "YOLO")))) + (test "Can log any value." + (Text/= "YOLO" (product;left (&;log "YOLO")))) ))) -(test: "Monad transformer" +(context: "Monad transformer" (let [lift (&;lift-log text;Monoid<Text> io;Monad<IO>) (^open "io/") io;Monad<IO>] - (assert "Can add log functionality to any monad." - (|> (io;run (do (&;LogT text;Monoid<Text> io;Monad<IO>) - [a (lift (io/wrap 123)) - b (wrap 456)] - (wrap (i.+ a b)))) - (case> ["" 579] true - _ false))) + (test "Can add log functionality to any monad." + (|> (io;run (do (&;LogT text;Monoid<Text> io;Monad<IO>) + [a (lift (io/wrap 123)) + b (wrap 456)] + (wrap (i.+ a b)))) + (case> ["" 579] true + _ false))) )) diff --git a/stdlib/test/test/lux/data/maybe.lux b/stdlib/test/test/lux/data/maybe.lux index 8cfb4c38f..85ce7be83 100644 --- a/stdlib/test/test/lux/data/maybe.lux +++ b/stdlib/test/test/lux/data/maybe.lux @@ -8,49 +8,49 @@ [number])) lux/test) -(test: "Maybe" +(context: "Maybe" (let [(^open "&/") &;Monoid<Maybe> (^open "&/") &;Monad<Maybe> (^open "Maybe/") (&;Eq<Maybe> text;Eq<Text>)] ($_ seq - (assert "Can compare Maybe values." - (and (Maybe/= #;None #;None) - (Maybe/= (#;Some "yolo") (#;Some "yolo")) - (not (Maybe/= (#;Some "yolo") (#;Some "lol"))) - (not (Maybe/= (#;Some "yolo") #;None)))) + (test "Can compare Maybe values." + (and (Maybe/= #;None #;None) + (Maybe/= (#;Some "yolo") (#;Some "yolo")) + (not (Maybe/= (#;Some "yolo") (#;Some "lol"))) + (not (Maybe/= (#;Some "yolo") #;None)))) - (assert "Monoid respects Maybe." - (and (Maybe/= #;None &/unit) - (Maybe/= (#;Some "yolo") (&/append (#;Some "yolo") (#;Some "lol"))) - (Maybe/= (#;Some "yolo") (&/append (#;Some "yolo") #;None)) - (Maybe/= (#;Some "lol") (&/append #;None (#;Some "lol"))) - (Maybe/= #;None (: (Maybe Text) (&/append #;None #;None))))) + (test "Monoid respects Maybe." + (and (Maybe/= #;None &/unit) + (Maybe/= (#;Some "yolo") (&/append (#;Some "yolo") (#;Some "lol"))) + (Maybe/= (#;Some "yolo") (&/append (#;Some "yolo") #;None)) + (Maybe/= (#;Some "lol") (&/append #;None (#;Some "lol"))) + (Maybe/= #;None (: (Maybe Text) (&/append #;None #;None))))) - (assert "Functor respects Maybe." - (and (Maybe/= #;None (&/map (Text/append "yolo") #;None)) - (Maybe/= (#;Some "yololol") (&/map (Text/append "yolo") (#;Some "lol"))))) + (test "Functor respects Maybe." + (and (Maybe/= #;None (&/map (Text/append "yolo") #;None)) + (Maybe/= (#;Some "yololol") (&/map (Text/append "yolo") (#;Some "lol"))))) - (assert "Applicative respects Maybe." - (and (Maybe/= (#;Some "yolo") (&/wrap "yolo")) - (Maybe/= (#;Some "yololol") - (&/apply (&/wrap (Text/append "yolo")) (&/wrap "lol"))))) + (test "Applicative respects Maybe." + (and (Maybe/= (#;Some "yolo") (&/wrap "yolo")) + (Maybe/= (#;Some "yololol") + (&/apply (&/wrap (Text/append "yolo")) (&/wrap "lol"))))) - (assert "Monad respects Maybe." - (Maybe/= (#;Some "yololol") - (do &;Monad<Maybe> - [f (wrap Text/append) - a (wrap "yolo") - b (wrap "lol")] - (wrap (f a b))))) + (test "Monad respects Maybe." + (Maybe/= (#;Some "yololol") + (do &;Monad<Maybe> + [f (wrap Text/append) + a (wrap "yolo") + b (wrap "lol")] + (wrap (f a b))))) ))) -(test: "Monad transformer" +(context: "Monad transformer" (let [lift (&;lift-maybe io;Monad<IO>) (^open "io/") io;Monad<IO>] - (assert "Can add maybe functionality to any monad." - (|> (io;run (do (&;MaybeT io;Monad<IO>) - [a (lift (io/wrap 123)) - b (wrap 456)] - (wrap (i.+ a b)))) - (case> (#;Some 579) true - _ false))))) + (test "Can add maybe functionality to any monad." + (|> (io;run (do (&;MaybeT io;Monad<IO>) + [a (lift (io/wrap 123)) + b (wrap 456)] + (wrap (i.+ a b)))) + (case> (#;Some 579) true + _ false))))) diff --git a/stdlib/test/test/lux/data/number.lux b/stdlib/test/test/lux/data/number.lux index 378731fbf..5e8f9a384 100644 --- a/stdlib/test/test/lux/data/number.lux +++ b/stdlib/test/test/lux/data/number.lux @@ -10,13 +10,13 @@ lux/test) (do-template [category rand-gen <Eq> <Order>] - [(test: (format "[" category "] " "Eq & Order") + [(context: (format "[" category "] " "Eq & Order") [x rand-gen y rand-gen] - (assert "" (and (:: <Eq> = x x) - (or (:: <Eq> = x y) - (:: <Order> < y x) - (:: <Order> > y x)))))] + (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>] @@ -25,19 +25,19 @@ ) (do-template [category rand-gen <Number> <Order>] - [(test: (format "[" category "] " "Number") + [(context: (format "[" category "] " "Number") [x rand-gen #let [(^open) <Number> (^open) <Order>]] - (assert "" (and (>= x (abs x)) - ## abs(0.0) == 0.0 && negate(abs(0.0)) == -0.0 - (or (Text/= "Real" 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)))))))] + (test "" (and (>= x (abs x)) + ## abs(0.0) == 0.0 && negate(abs(0.0)) == -0.0 + (or (Text/= "Real" 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>] @@ -46,32 +46,32 @@ ) (do-template [category rand-gen <Enum> <Number> <Order>] - [(test: (format "[" category "] " "Enum") + [(context: (format "[" category "] " "Enum") [x rand-gen] - (assert "" (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))) - ))))] + (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>] ) (do-template [category rand-gen <Number> <Order> <Interval> <test>] - [(test: (format "[" category "] " "Interval") + [(context: (format "[" category "] " "Interval") [x (|> rand-gen (R;filter <test>)) #let [(^open) <Number> (^open) <Order>]] - (assert "" (and (<= x (:: <Interval> bottom)) - (>= x (:: <Interval> top)))))] + (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)] @@ -81,15 +81,15 @@ ) (do-template [category rand-gen <Number> <Order> <Monoid> <cap> <test>] - [(test: (format "[" category "] " "Monoid") + [(context: (format "[" category "] " "Monoid") [x (|> rand-gen (:: @ map (|>. (:: <Number> abs) <cap>)) (R;filter <test>)) #let [(^open) <Number> (^open) <Order> (^open) <Monoid>]] - (assert "Appending to unit doesn't change the value." - (and (= x (append unit x)) - (= x (append x unit)) - (= unit (append unit unit)))))] + (test "Appending to unit doesn't change the value." + (and (= x (append unit x)) + (= x (append x unit)) + (= unit (append unit unit)))))] ["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)] @@ -110,17 +110,17 @@ ) (do-template [<category> <rand-gen> <Eq> <Codec>] - [(test: (format "[" <category> "] " "Alternative formats") + [(context: (format "[" <category> "] " "Alternative formats") [x <rand-gen>] - (assert "Can encode/decode values." - (|> x - (:: <Codec> encode) - (:: <Codec> decode) - (case> (#;Right x') - (:: <Eq> = x x') + (test "Can encode/decode values." + (|> x + (:: <Codec> encode) + (:: <Codec> decode) + (case> (#;Right x') + (:: <Eq> = x x') - (#;Left _) - false))))] + (#;Left _) + false))))] ["Nat/Binary" R;nat Eq<Nat> Binary@Codec<Text,Nat>] ["Nat/Octal" R;nat Eq<Nat> Octal@Codec<Text,Nat>] @@ -143,9 +143,9 @@ ["Real/Hex" R;real Eq<Real> Hex@Codec<Text,Real>] ) -(test: "Can convert real values to/from their bit patterns." +(context: "Can convert real values to/from their bit patterns." [raw R;real factor (|> R;nat (:: @ map (|>. (n.% +1000) (n.max +1)))) #let [sample (|> factor nat-to-int int-to-real (r.* raw))]] - (assert "Can convert real values to/from their bit patterns." - (|> sample real-to-bits bits-to-real (r.= sample)))) + (test "Can convert real values to/from their bit patterns." + (|> sample real-to-bits bits-to-real (r.= sample)))) diff --git a/stdlib/test/test/lux/data/number/complex.lux b/stdlib/test/test/lux/data/number/complex.lux index 9555c031e..ad5401270 100644 --- a/stdlib/test/test/lux/data/number/complex.lux +++ b/stdlib/test/test/lux/data/number/complex.lux @@ -43,157 +43,157 @@ imaginary gen-dim] (wrap (&;complex real imaginary)))) -(test: "Construction" +(context: "Construction" [real gen-dim imaginary gen-dim] ($_ seq - (assert "Can build and tear apart complex numbers" - (let [r+i (&;complex real imaginary)] - (and (r.= real (get@ #&;real r+i)) - (r.= imaginary (get@ #&;imaginary r+i))))) - - (assert "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)))) + (test "Can build and tear apart complex numbers" + (let [r+i (&;complex real imaginary)] + (and (r.= real (get@ #&;real r+i)) + (r.= 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)))) )) -(test: "Absolute value" +(context: "Absolute value" [real gen-dim imaginary gen-dim] ($_ seq - (assert "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 (r.>= (r/abs real) abs) - (r.>= (r/abs imaginary) abs)))) - - (assert "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)))))) - - (assert "The absolute value of a complex number involving an infinity on either dimension, results in an infinite value." - (and (r.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex number;positive-infinity imaginary)))) - (r.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex real number;positive-infinity)))) - (r.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex number;negative-infinity imaginary)))) - (r.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex real number;negative-infinity)))))) + (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 (r.>= (r/abs real) abs) + (r.>= (r/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 (r.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex number;positive-infinity imaginary)))) + (r.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex real number;positive-infinity)))) + (r.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex number;negative-infinity imaginary)))) + (r.= number;positive-infinity (get@ #&;real (&;c.abs (&;complex real number;negative-infinity)))))) )) -(test: "Addidion, substraction, multiplication and division" +(context: "Addidion, substraction, multiplication and division" [x gen-complex y gen-complex factor gen-dim] ($_ seq - (assert "Adding 2 complex numbers is the same as adding their parts." - (let [z (&;c.+ y x)] - (and (&;c.= z - (&;complex (r.+ (get@ #&;real y) - (get@ #&;real x)) - (r.+ (get@ #&;imaginary y) - (get@ #&;imaginary x))))))) - - (assert "Subtracting 2 complex numbers is the same as adding their parts." - (let [z (&;c.- y x)] - (and (&;c.= z - (&;complex (r.- (get@ #&;real y) - (get@ #&;real x)) - (r.- (get@ #&;imaginary y) - (get@ #&;imaginary x))))))) - - (assert "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)))) - - (assert "Division is the inverse of multiplication." - (|> x (&;c.* y) (&;c./ y) (within? margin-of-error x))) - - (assert "Scalar division is the inverse of scalar multiplication." - (|> x (&;c.*' factor) (&;c./' factor) (within? margin-of-error x))) - - (assert "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))))) + (test "Adding 2 complex numbers is the same as adding their parts." + (let [z (&;c.+ y x)] + (and (&;c.= z + (&;complex (r.+ (get@ #&;real y) + (get@ #&;real x)) + (r.+ (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 (r.- (get@ #&;real y) + (get@ #&;real x)) + (r.- (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))))) )) -(test: "Conjugate, reciprocal, signum, negation" +(context: "Conjugate, reciprocal, signum, negation" [x gen-complex] ($_ seq - (assert "Conjugate has same real part as original, and opposite of imaginary part." - (let [cx (&;conjugate x)] - (and (r.= (get@ #&;real x) - (get@ #&;real cx)) - (r.= (r/negate (get@ #&;imaginary x)) - (get@ #&;imaginary cx))))) - - (assert "The reciprocal functions is its own inverse." - (|> x &;reciprocal &;reciprocal (within? margin-of-error x))) - - (assert "x*(x^-1) = 1" - (|> x (&;c.* (&;reciprocal x)) (within? margin-of-error &;one))) - - (assert "Absolute value of signum is always root2(2), 1 or 0." - (let [signum-abs (|> x &;c.signum &;c.abs (get@ #&;real))] - (or (r.= 0.0 signum-abs) - (r.= 1.0 signum-abs) - (r.= (math;root2 2.0) signum-abs)))) - - (assert "Negation is its own inverse." - (let [there (&;c.negate x) - back-again (&;c.negate there)] - (and (not (&;c.= there x)) - (&;c.= back-again x)))) - - (assert "Negation doesn't change the absolute value." - (r.= (get@ #&;real (&;c.abs x)) - (get@ #&;real (&;c.abs (&;c.negate x))))) + (test "Conjugate has same real part as original, and opposite of imaginary part." + (let [cx (&;conjugate x)] + (and (r.= (get@ #&;real x) + (get@ #&;real cx)) + (r.= (r/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 (r.= 0.0 signum-abs) + (r.= 1.0 signum-abs) + (r.= (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." + (r.= (get@ #&;real (&;c.abs x)) + (get@ #&;real (&;c.abs (&;c.negate x))))) )) ## ## Don't know how to test complex trigonometry properly. -## (test: "Trigonometry" +## (context: "Trigonometry" ## [x gen-complex] ## ($_ seq -## (assert "Arc-sine is the inverse of sine." -## (|> x &;sin &;asin (within? margin-of-error x))) +## (test "Arc-sine is the inverse of sine." +## (|> x &;sin &;asin (within? margin-of-error x))) -## (assert "Arc-cosine is the inverse of cosine." -## (|> x &;cos &;acos (within? margin-of-error x))) +## (test "Arc-cosine is the inverse of cosine." +## (|> x &;cos &;acos (within? margin-of-error x))) -## (assert "Arc-tangent is the inverse of tangent." -## (|> x &;tan &;atan (within? margin-of-error x)))) +## (test "Arc-tangent is the inverse of tangent." +## (|> x &;tan &;atan (within? margin-of-error x)))) ## ) -(test: "Power 2 and exponential/logarithm" +(context: "Power 2 and exponential/logarithm" [x gen-complex] ($_ seq - (assert "Square root is inverse of power 2.0" - (|> x (&;pow' 2.0) &;root2 (within? margin-of-error x))) + (test "Square root is inverse of power 2.0" + (|> x (&;pow' 2.0) &;root2 (within? margin-of-error x))) - (assert "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))) )) -(test: "Complex roots" +(context: "Complex roots" [sample gen-complex degree (|> R;nat (:: @ map (|>. (n.max +1) (n.% +5))))] - (assert "Can calculate the N roots for any complex number." - (|> sample - (&;nth-roots degree) - (List/map (&;pow' (|> degree nat-to-int int-to-real))) - (list;every? (within? margin-of-error sample))))) + (test "Can calculate the N roots for any complex number." + (|> sample + (&;nth-roots degree) + (List/map (&;pow' (|> degree nat-to-int int-to-real))) + (list;every? (within? margin-of-error sample))))) -(test: "Codec" +(context: "Codec" [sample gen-complex #let [(^open "c/") &;Codec<Text,Complex>]] - (assert "Can encode/decode complex numbers." - (|> sample c/encode c/decode - (case> (#;Right output) - (&;c.= sample output) + (test "Can encode/decode complex numbers." + (|> sample c/encode c/decode + (case> (#;Right output) + (&;c.= sample output) - _ - false)))) + _ + false)))) diff --git a/stdlib/test/test/lux/data/number/ratio.lux b/stdlib/test/test/lux/data/number/ratio.lux index 7ae36e573..31a3407bf 100644 --- a/stdlib/test/test/lux/data/number/ratio.lux +++ b/stdlib/test/test/lux/data/number/ratio.lux @@ -26,81 +26,81 @@ (R;filter (. not (n.= numerator))))] (wrap (&;ratio numerator denominator)))) -(test: "Normalization" +(context: "Normalization" [denom1 gen-part denom2 gen-part sample gen-ratio] ($_ seq - (assert "All zeroes are the same." - (&;q.= (&;ratio +0 denom1) - (&;ratio +0 denom2))) + (test "All zeroes are the same." + (&;q.= (&;ratio +0 denom1) + (&;ratio +0 denom2))) - (assert "All ratios are built normalized." - (|> sample &;normalize (&;q.= sample))) + (test "All ratios are built normalized." + (|> sample &;normalize (&;q.= sample))) )) -(test: "Arithmetic" +(context: "Arithmetic" [x gen-ratio y gen-ratio #let [min (&;q.min x y) max (&;q.max x y)]] ($_ seq - (assert "Addition and subtraction are opposites." - (and (|> max (&;q.- min) (&;q.+ min) (&;q.= max)) - (|> max (&;q.+ min) (&;q.- min) (&;q.= max)))) + (test "Addition and subtraction are opposites." + (and (|> max (&;q.- min) (&;q.+ min) (&;q.= max)) + (|> max (&;q.+ min) (&;q.- min) (&;q.= max)))) - (assert "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)))) - (assert "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))) - (assert "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))) - (assert "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))))) )) -(test: "Negation, absolute value and signum" +(context: "Negation, absolute value and signum" [sample gen-ratio] ($_ seq - (assert "Negation is it's own inverse." - (let [there (&/negate sample) - back-again (&/negate there)] - (and (not (&;q.= there sample)) - (&;q.= back-again sample)))) + (test "Negation is it's own inverse." + (let [there (&/negate sample) + back-again (&/negate there)] + (and (not (&;q.= there sample)) + (&;q.= back-again sample)))) - (assert "All ratios are already at their absolute value." - (|> sample &/abs (&;q.= sample))) + (test "All ratios are already at their absolute value." + (|> sample &/abs (&;q.= sample))) - (assert "Signum is the identity." - (|> sample (&;q.* (&/signum sample)) (&;q.= sample))) + (test "Signum is the identity." + (|> sample (&;q.* (&/signum sample)) (&;q.= sample))) )) -(test: "Order" +(context: "Order" [x gen-ratio y gen-ratio] ($_ seq - (assert "Can compare ratios." - (and (or (&;q.<= y x) - (&;q.> y x)) - (or (&;q.>= y x) - (&;q.< y x)))) + (test "Can compare ratios." + (and (or (&;q.<= y x) + (&;q.> y x)) + (or (&;q.>= y x) + (&;q.< y x)))) )) -(test: "Codec" +(context: "Codec" [sample gen-ratio #let [(^open "&/") &;Codec<Text,Ratio>]] - (assert "Can encode/decode ratios." - (|> sample &/encode &/decode - (case> (#;Right output) - (&;q.= sample output) - - _ - false)))) + (test "Can encode/decode ratios." + (|> sample &/encode &/decode + (case> (#;Right output) + (&;q.= sample output) + + _ + false)))) diff --git a/stdlib/test/test/lux/data/product.lux b/stdlib/test/test/lux/data/product.lux index 00337ebfb..53340c072 100644 --- a/stdlib/test/test/lux/data/product.lux +++ b/stdlib/test/test/lux/data/product.lux @@ -7,14 +7,14 @@ [number])) lux/test) -(test: "Products" +(context: "Products" ($_ seq - (assert "Can access the sides of a pair." - (and (i.= 1 (left [1 2])) - (i.= 2 (right [1 2])))) + (test "Can access the sides of a pair." + (and (i.= 1 (left [1 2])) + (i.= 2 (right [1 2])))) - (assert "Can swap the sides of a pair." - (let [[_left _right] (swap [1 2])] - (and (i.= 2 _left) - (i.= 1 _right)))) + (test "Can swap the sides of a pair." + (let [[_left _right] (swap [1 2])] + (and (i.= 2 _left) + (i.= 1 _right)))) )) diff --git a/stdlib/test/test/lux/data/result.lux b/stdlib/test/test/lux/data/result.lux index aee931279..485f56a13 100644 --- a/stdlib/test/test/lux/data/result.lux +++ b/stdlib/test/test/lux/data/result.lux @@ -7,50 +7,50 @@ ["&" result])) lux/test) -(test: "Results" +(context: "Results" (let [(^open "&/") &;Monad<Result>] ($_ seq - (assert "Functor correctly handles both cases." - (and (|> (: (&;Result Int) (#&;Success 10)) - (&/map i.inc) - (case> (#&;Success 11) true _ false)) + (test "Functor correctly handles both cases." + (and (|> (: (&;Result Int) (#&;Success 10)) + (&/map i.inc) + (case> (#&;Success 11) true _ false)) - (|> (: (&;Result Int) (#&;Error "YOLO")) - (&/map i.inc) - (case> (#&;Error "YOLO") true _ false)) - )) + (|> (: (&;Result Int) (#&;Error "YOLO")) + (&/map i.inc) + (case> (#&;Error "YOLO") true _ false)) + )) - (assert "Applicative correctly handles both cases." - (and (|> (&/wrap 20) - (case> (#&;Success 20) true _ false)) - (|> (&/apply (&/wrap i.inc) (&/wrap 10)) - (case> (#&;Success 11) true _ false)) - (|> (&/apply (&/wrap i.inc) (#&;Error "YOLO")) - (case> (#&;Error "YOLO") true _ false)))) + (test "Applicative correctly handles both cases." + (and (|> (&/wrap 20) + (case> (#&;Success 20) true _ false)) + (|> (&/apply (&/wrap i.inc) (&/wrap 10)) + (case> (#&;Success 11) true _ false)) + (|> (&/apply (&/wrap i.inc) (#&;Error "YOLO")) + (case> (#&;Error "YOLO") true _ false)))) - (assert "Monad correctly handles both cases." - (and (|> (do &;Monad<Result> - [f (wrap i.+) - a (wrap 10) - b (wrap 20)] - (wrap (f a b))) - (case> (#&;Success 30) true _ false)) - (|> (do &;Monad<Result> - [f (wrap i.+) - a (#&;Error "YOLO") - b (wrap 20)] - (wrap (f a b))) - (case> (#&;Error "YOLO") true _ false)) - )) + (test "Monad correctly handles both cases." + (and (|> (do &;Monad<Result> + [f (wrap i.+) + a (wrap 10) + b (wrap 20)] + (wrap (f a b))) + (case> (#&;Success 30) true _ false)) + (|> (do &;Monad<Result> + [f (wrap i.+) + a (#&;Error "YOLO") + b (wrap 20)] + (wrap (f a b))) + (case> (#&;Error "YOLO") true _ false)) + )) ))) -(test: "Monad transformer" +(context: "Monad transformer" (let [lift (&;lift-result io;Monad<IO>) (^open "io/") io;Monad<IO>] - (assert "Can add result functionality to any monad." - (|> (io;run (do (&;ResultT io;Monad<IO>) - [a (lift (io/wrap 123)) - b (wrap 456)] - (wrap (i.+ a b)))) - (case> (#&;Success 579) true - _ false))))) + (test "Can add result functionality to any monad." + (|> (io;run (do (&;ResultT io;Monad<IO>) + [a (lift (io/wrap 123)) + b (wrap 456)] + (wrap (i.+ a b)))) + (case> (#&;Success 579) true + _ false))))) diff --git a/stdlib/test/test/lux/data/sum.lux b/stdlib/test/test/lux/data/sum.lux index 6e88e6b07..26f30f4e4 100644 --- a/stdlib/test/test/lux/data/sum.lux +++ b/stdlib/test/test/lux/data/sum.lux @@ -9,29 +9,29 @@ (coll [list]))) lux/test) -(test: "Sum operations" +(context: "Sum operations" (let [(^open "List/") (list;Eq<List> text;Eq<Text>)] ($_ seq - (assert "Can inject values into Either." - (and (|> (left "Hello") (case> (+0 "Hello") true _ false)) - (|> (right "World") (case> (+1 "World") true _ false)))) + (test "Can inject values into Either." + (and (|> (left "Hello") (case> (+0 "Hello") true _ false)) + (|> (right "World") (case> (+1 "World") true _ false)))) - (assert "Can discriminate eithers based on their cases." - (let [[_lefts _rights] (partition (: (List (| Text Text)) - (list (+0 "0") (+1 "1") (+0 "2"))))] - (and (List/= _lefts - (lefts (: (List (| Text Text)) - (list (+0 "0") (+1 "1") (+0 "2"))))) + (test "Can discriminate eithers based on their cases." + (let [[_lefts _rights] (partition (: (List (| Text Text)) + (list (+0 "0") (+1 "1") (+0 "2"))))] + (and (List/= _lefts + (lefts (: (List (| Text Text)) + (list (+0 "0") (+1 "1") (+0 "2"))))) - (List/= _rights - (rights (: (List (| Text Text)) - (list (+0 "0") (+1 "1") (+0 "2")))))))) + (List/= _rights + (rights (: (List (| Text Text)) + (list (+0 "0") (+1 "1") (+0 "2")))))))) - (assert "Can apply a function to an Either value depending on the case." - (and (i.= 10 (either (function [_] 10) - (function [_] 20) - (: (| Text Text) (+0 "")))) - (i.= 20 (either (function [_] 10) - (function [_] 20) - (: (| Text Text) (+1 "")))))) + (test "Can apply a function to an Either value depending on the case." + (and (i.= 10 (either (function [_] 10) + (function [_] 20) + (: (| Text Text) (+0 "")))) + (i.= 20 (either (function [_] 10) + (function [_] 20) + (: (| Text Text) (+1 "")))))) ))) diff --git a/stdlib/test/test/lux/data/text.lux b/stdlib/test/test/lux/data/text.lux index aa316a7ad..fafba01e2 100644 --- a/stdlib/test/test/lux/data/text.lux +++ b/stdlib/test/test/lux/data/text.lux @@ -11,46 +11,46 @@ ["R" math/random]) lux/test) -(test: "Size" +(context: "Size" [size (:: @ map (n.% +100) R;nat) sample (R;text size)] - (assert "" (or (and (n.= +0 size) - (&;empty? sample)) - (n.= size (&;size sample))))) + (test "" (or (and (n.= +0 size) + (&;empty? sample)) + (n.= size (&;size sample))))) (def: bounded-size (R;Random Nat) (|> R;nat (:: R;Monad<Random> map (|>. (n.% +20) (n.+ +1))))) -(test: "Locations" +(context: "Locations" [size bounded-size idx (:: @ map (n.% size) R;nat) sample (R;text size)] - (assert "" (|> sample - (&;nth idx) - (case> (^multi (#;Some char) - [(char;as-text 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) + (test "" (|> sample + (&;nth idx) + (case> (^multi (#;Some char) + [(char;as-text 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 + )) + )) -(test: "Text functions" +(context: "Text functions" [sizeL bounded-size sizeR bounded-size sampleL (R;text sizeL) @@ -60,38 +60,38 @@ dup-sample (&;join-with "" (list sampleL sampleR)) enclosed-sample (&;enclose [sampleR sampleR] sampleL) (^open) &;Eq<Text>]] - (assert "" (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)))) + (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)) + ) + )) -(test: "More text functions" +(context: "More text functions" [sizeP bounded-size sizeL bounded-size #let [## The wider unicode charset includes control characters that @@ -107,50 +107,50 @@ sample2 (&;concat (list;interpose sep2 parts)) (^open "&/") &;Eq<Text>]] ($_ seq - (assert "Can split text through a separator." - (n.= (list;size parts) - (list;size (&;split-all-with sep1 sample1)))) + (test "Can split text through a separator." + (n.= (list;size parts) + (list;size (&;split-all-with sep1 sample1)))) - (assert "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))) )) -(test: "Other text functions" +(context: "Other text functions" (let [(^open "&/") &;Eq<Text>] ($_ seq - (assert "Can transform texts in certain ways." - (and (&/= "abc" (&;lower-case "ABC")) - (&/= "ABC" (&;upper-case "abc")) - (&/= "ABC" (&;trim " \tABC\n\r")))) + (test "Can transform texts in certain ways." + (and (&/= "abc" (&;lower-case "ABC")) + (&/= "ABC" (&;upper-case "abc")) + (&/= "ABC" (&;trim " \tABC\n\r")))) ))) -(test: "Structures" +(context: "Structures" (let [(^open "&/") &;Order<Text>] ($_ seq - (assert "" (&/< "bcd" "abc")) - (assert "" (not (&/< "abc" "abc"))) - (assert "" (not (&/< "abc" "bcd"))) - (assert "" (&/<= "bcd" "abc")) - (assert "" (&/<= "abc" "abc")) - (assert "" (not (&/<= "abc" "bcd"))) - (assert "" (&/> "abc" "bcd")) - (assert "" (not (&/> "abc" "abc"))) - (assert "" (not (&/> "bcd" "abc"))) - (assert "" (&/>= "abc" "bcd")) - (assert "" (&/>= "abc" "abc")) - (assert "" (not (&/>= "bcd" "abc"))) + (test "" (&/< "bcd" "abc")) + (test "" (not (&/< "abc" "abc"))) + (test "" (not (&/< "abc" "bcd"))) + (test "" (&/<= "bcd" "abc")) + (test "" (&/<= "abc" "abc")) + (test "" (not (&/<= "abc" "bcd"))) + (test "" (&/> "abc" "bcd")) + (test "" (not (&/> "abc" "abc"))) + (test "" (not (&/> "bcd" "abc"))) + (test "" (&/>= "abc" "bcd")) + (test "" (&/>= "abc" "abc")) + (test "" (not (&/>= "bcd" "abc"))) ))) -(test: "Codec" +(context: "Codec" [size bounded-size sample (R;text size) #let [(^open) &;Eq<Text>]] - (assert "" (|> sample - (:: &;Codec<Text,Text> encode) - (:: &;Codec<Text,Text> decode) - (case> (#;Right decoded) - (= sample decoded) + (test "" (|> sample + (:: &;Codec<Text,Text> encode) + (:: &;Codec<Text,Text> decode) + (case> (#;Right decoded) + (= sample decoded) - _ - false)))) + _ + false)))) diff --git a/stdlib/test/test/lux/data/text/format.lux b/stdlib/test/test/lux/data/text/format.lux index 97b955e20..afd788fa0 100644 --- a/stdlib/test/test/lux/data/text/format.lux +++ b/stdlib/test/test/lux/data/text/format.lux @@ -7,14 +7,14 @@ [number])) lux/test) -(test: "Formatters" +(context: "Formatters" (let [(^open "&/") text;Eq<Text>] ($_ seq - (assert "Can format common values simply." - (and (&/= "true" (%b true)) - (&/= "123" (%i 123)) - (&/= "123.456" (%r 123.456)) - (&/= "#\"t\"" (%c #"t")) - (&/= "\"YOLO\"" (%t "YOLO")) - (&/= "User-id: 123 -- Active: true" (format "User-id: " (%i 123) " -- Active: " (%b true))))) + (test "Can format common values simply." + (and (&/= "true" (%b true)) + (&/= "123" (%i 123)) + (&/= "123.456" (%r 123.456)) + (&/= "#\"t\"" (%c #"t")) + (&/= "\"YOLO\"" (%t "YOLO")) + (&/= "User-id: 123 -- Active: true" (format "User-id: " (%i 123) " -- Active: " (%b true))))) ))) diff --git a/stdlib/test/test/lux/data/text/lexer.lux b/stdlib/test/test/lux/data/text/lexer.lux index df77f804a..8f1d94185 100644 --- a/stdlib/test/test/lux/data/text/lexer.lux +++ b/stdlib/test/test/lux/data/text/lexer.lux @@ -55,251 +55,251 @@ false)) ## [Tests] -(test: "End" +(context: "End" ($_ seq - (assert "Can detect the end of the input." - (|> (&;run "" - &;end) - (case> (#;Right _) true _ false))) + (test "Can detect the end of the input." + (|> (&;run "" + &;end) + (case> (#;Right _) true _ false))) - (assert "Won't mistake non-empty text for no more input." - (|> (&;run "YOLO" - &;end) - (case> (#;Left _) true _ false))) + (test "Won't mistake non-empty text for no more input." + (|> (&;run "YOLO" + &;end) + (case> (#;Left _) true _ false))) )) -(test: "Literals" +(context: "Literals" [size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10)))) pre (r;text size) post (|> (r;text size) (r;filter (|>. (text;starts-with? pre) not)))] ($_ seq - (assert "Can find literal text fragments." - (and (|> (&;run (format pre post) - (&;this pre)) - (case> (#;Right []) true _ false)) - (|> (&;run post - (&;this pre)) - (case> (#;Left _) true _ false)))) + (test "Can find literal text fragments." + (and (|> (&;run (format pre post) + (&;this pre)) + (case> (#;Right []) true _ false)) + (|> (&;run post + (&;this pre)) + (case> (#;Left _) true _ false)))) )) -(test: "Char lexers" +(context: "Char lexers" ($_ seq - (assert "Can lex characters." - (and (|> (&;run "YOLO" - (&;this "Y")) - (case> (#;Right []) true _ false)) - (|> (&;run "MEME" - (&;this "Y")) - (case> (#;Left _) true _ false)))) + (test "Can lex characters." + (and (|> (&;run "YOLO" + (&;this "Y")) + (case> (#;Right []) true _ false)) + (|> (&;run "MEME" + (&;this "Y")) + (case> (#;Left _) true _ false)))) - (assert "Can lex characters ranges." - (and (should-passT "Y" (&;run "YOLO" - (&;char-range #"X" #"Z"))) - (should-fail (&;run "MEME" - (&;char-range #"X" #"Z"))))) + (test "Can lex characters ranges." + (and (should-passT "Y" (&;run "YOLO" + (&;char-range #"X" #"Z"))) + (should-fail (&;run "MEME" + (&;char-range #"X" #"Z"))))) )) -(test: "Custom lexers" +(context: "Custom lexers" ($_ seq - (assert "Can lex anything" - (and (should-passT "A" (&;run "A" - &;any)) - (should-fail (&;run "" - &;any)))) + (test "Can lex anything" + (and (should-passT "A" (&;run "A" + &;any)) + (should-fail (&;run "" + &;any)))) - (assert "Can lex upper-case and &;lower-case letters." - (and (should-passT "Y" (&;run "YOLO" - &;upper)) - (should-fail (&;run "meme" - &;upper)) - - (should-passT "y" (&;run "yolo" - &;lower)) - (should-fail (&;run "MEME" - &;lower)))) + (test "Can lex upper-case and &;lower-case letters." + (and (should-passT "Y" (&;run "YOLO" + &;upper)) + (should-fail (&;run "meme" + &;upper)) + + (should-passT "y" (&;run "yolo" + &;lower)) + (should-fail (&;run "MEME" + &;lower)))) - (assert "Can lex numbers." - (and (should-passT "1" (&;run "1" - &;digit)) - (should-fail (&;run " " - &;digit)) + (test "Can lex numbers." + (and (should-passT "1" (&;run "1" + &;digit)) + (should-fail (&;run " " + &;digit)) - (should-passT "7" (&;run "7" - &;oct-digit)) - (should-fail (&;run "8" - &;oct-digit)) + (should-passT "7" (&;run "7" + &;oct-digit)) + (should-fail (&;run "8" + &;oct-digit)) - (should-passT "1" (&;run "1" - &;hex-digit)) - (should-passT "a" (&;run "a" - &;hex-digit)) - (should-passT "A" (&;run "A" - &;hex-digit)) - (should-fail (&;run " " - &;hex-digit)) - )) + (should-passT "1" (&;run "1" + &;hex-digit)) + (should-passT "a" (&;run "a" + &;hex-digit)) + (should-passT "A" (&;run "A" + &;hex-digit)) + (should-fail (&;run " " + &;hex-digit)) + )) - (assert "Can lex alphabetic characters." - (and (should-passT "A" (&;run "A" - &;alpha)) - (should-passT "a" (&;run "a" - &;alpha)) - (should-fail (&;run "1" - &;alpha)))) + (test "Can lex alphabetic characters." + (and (should-passT "A" (&;run "A" + &;alpha)) + (should-passT "a" (&;run "a" + &;alpha)) + (should-fail (&;run "1" + &;alpha)))) - (assert "Can lex alphanumeric characters." - (and (should-passT "A" (&;run "A" - &;alpha-num)) - (should-passT "a" (&;run "a" - &;alpha-num)) - (should-passT "1" (&;run "1" - &;alpha-num)) - (should-fail (&;run " " - &;alpha-num)))) + (test "Can lex alphanumeric characters." + (and (should-passT "A" (&;run "A" + &;alpha-num)) + (should-passT "a" (&;run "a" + &;alpha-num)) + (should-passT "1" (&;run "1" + &;alpha-num)) + (should-fail (&;run " " + &;alpha-num)))) - (assert "Can lex white-space." - (and (should-passT " " (&;run " " - &;space)) - (should-fail (&;run "8" - &;space)))) + (test "Can lex white-space." + (and (should-passT " " (&;run " " + &;space)) + (should-fail (&;run "8" + &;space)))) )) -(test: "Combinators" +(context: "Combinators" ($_ seq - (assert "Can combine lexers sequentially." - (and (|> (&;run "YOLO" - (&;seq &;any &;any)) - (case> (#;Right ["Y" "O"]) true - _ false)) - (should-fail (&;run "Y" - (&;seq &;any &;any))))) + (test "Can combine lexers sequentially." + (and (|> (&;run "YOLO" + (&;seq &;any &;any)) + (case> (#;Right ["Y" "O"]) true + _ false)) + (should-fail (&;run "Y" + (&;seq &;any &;any))))) - (assert "Can combine lexers alternatively." - (and (should-passE (#;Left "0") (&;run "0" - (&;alt &;digit &;upper))) - (should-passE (#;Right "A") (&;run "A" - (&;alt &;digit &;upper))) - (should-fail (&;run "a" - (&;alt &;digit &;upper))))) + (test "Can combine lexers alternatively." + (and (should-passE (#;Left "0") (&;run "0" + (&;alt &;digit &;upper))) + (should-passE (#;Right "A") (&;run "A" + (&;alt &;digit &;upper))) + (should-fail (&;run "a" + (&;alt &;digit &;upper))))) - (assert "Can create the opposite of a lexer." - (and (should-passT "a" (&;run "a" - (&;not (&;alt &;digit &;upper)))) - (should-fail (&;run "A" - (&;not (&;alt &;digit &;upper)))))) + (test "Can create the opposite of a lexer." + (and (should-passT "a" (&;run "a" + (&;not (&;alt &;digit &;upper)))) + (should-fail (&;run "A" + (&;not (&;alt &;digit &;upper)))))) - (assert "Can use either lexer." - (and (should-passT "0" (&;run "0" - (&;either &;digit &;upper))) - (should-passT "A" (&;run "A" - (&;either &;digit &;upper))) - (should-fail (&;run "a" - (&;either &;digit &;upper))))) + (test "Can use either lexer." + (and (should-passT "0" (&;run "0" + (&;either &;digit &;upper))) + (should-passT "A" (&;run "A" + (&;either &;digit &;upper))) + (should-fail (&;run "a" + (&;either &;digit &;upper))))) - (assert "Can select from among a set of characters." - (and (should-passT "C" (&;run "C" - (&;one-of "ABC"))) - (should-fail (&;run "D" - (&;one-of "ABC"))))) + (test "Can select from among a set of characters." + (and (should-passT "C" (&;run "C" + (&;one-of "ABC"))) + (should-fail (&;run "D" + (&;one-of "ABC"))))) - (assert "Can avoid a set of characters." - (and (should-passT "D" (&;run "D" - (&;none-of "ABC"))) - (should-fail (&;run "C" - (&;none-of "ABC"))))) + (test "Can avoid a set of characters." + (and (should-passT "D" (&;run "D" + (&;none-of "ABC"))) + (should-fail (&;run "C" + (&;none-of "ABC"))))) - (assert "Can lex using arbitrary predicates." - (and (should-passT "D" (&;run "D" - (&;satisfies (function [c] true)))) - (should-fail (&;run "C" - (&;satisfies (function [c] false)))))) + (test "Can lex using arbitrary predicates." + (and (should-passT "D" (&;run "D" + (&;satisfies (function [c] true)))) + (should-fail (&;run "C" + (&;satisfies (function [c] false)))))) - (assert "Can apply a lexer multiple times." - (and (should-passT "0123456789ABCDEF" (&;run "0123456789ABCDEF yolo" - (&;many' &;hex-digit))) - (should-fail (&;run "yolo" - (&;many' &;hex-digit))) + (test "Can apply a lexer multiple times." + (and (should-passT "0123456789ABCDEF" (&;run "0123456789ABCDEF yolo" + (&;many' &;hex-digit))) + (should-fail (&;run "yolo" + (&;many' &;hex-digit))) - (should-passT "" (&;run "yolo" - (&;some' &;hex-digit))))) + (should-passT "" (&;run "yolo" + (&;some' &;hex-digit))))) )) -(test: "Yet more combinators..." +(context: "Yet more combinators..." ($_ seq - (assert "Can fail at will." - (should-fail (&;run "yolo" - (&;fail "Well, it really SHOULD fail...")))) + (test "Can fail at will." + (should-fail (&;run "yolo" + (&;fail "Well, it really SHOULD fail...")))) - (assert "Can make assertions." - (and (should-fail (&;run "yolo" - (&;assert "Well, it really SHOULD fail..." false))) - (|> (&;run "yolo" - (&;assert "GO, GO, GO!" true)) - (case> (#;Right []) true - _ false)))) + (test "Can make assertions." + (and (should-fail (&;run "yolo" + (&;assert "Well, it really SHOULD fail..." false))) + (|> (&;run "yolo" + (&;assert "GO, GO, GO!" true)) + (case> (#;Right []) true + _ false)))) - (assert "Can apply a lexer multiple times." - (and (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") - (&;run "0123456789ABCDEF yolo" - (&;many &;hex-digit))) - (should-fail (&;run "yolo" - (&;many &;hex-digit))) + (test "Can apply a lexer multiple times." + (and (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") + (&;run "0123456789ABCDEF yolo" + (&;many &;hex-digit))) + (should-fail (&;run "yolo" + (&;many &;hex-digit))) - (should-passL (list) - (&;run "yolo" - (&;some &;hex-digit))))) + (should-passL (list) + (&;run "yolo" + (&;some &;hex-digit))))) - (assert "Can lex exactly N elements." - (and (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") - (&;run "0123456789ABCDEF yolo" - (&;exactly +16 &;hex-digit))) - (should-passL (list "0" "1" "2") - (&;run "0123456789ABCDEF yolo" - (&;exactly +3 &;hex-digit))) - (should-fail (&;run "0123456789ABCDEF yolo" - (&;exactly +17 &;hex-digit))))) + (test "Can lex exactly N elements." + (and (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") + (&;run "0123456789ABCDEF yolo" + (&;exactly +16 &;hex-digit))) + (should-passL (list "0" "1" "2") + (&;run "0123456789ABCDEF yolo" + (&;exactly +3 &;hex-digit))) + (should-fail (&;run "0123456789ABCDEF yolo" + (&;exactly +17 &;hex-digit))))) - (assert "Can lex at-most N elements." - (and (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") - (&;run "0123456789ABCDEF yolo" - (&;at-most +16 &;hex-digit))) - (should-passL (list "0" "1" "2") - (&;run "0123456789ABCDEF yolo" - (&;at-most +3 &;hex-digit))) - (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") - (&;run "0123456789ABCDEF yolo" - (&;at-most +17 &;hex-digit))))) + (test "Can lex at-most N elements." + (and (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") + (&;run "0123456789ABCDEF yolo" + (&;at-most +16 &;hex-digit))) + (should-passL (list "0" "1" "2") + (&;run "0123456789ABCDEF yolo" + (&;at-most +3 &;hex-digit))) + (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") + (&;run "0123456789ABCDEF yolo" + (&;at-most +17 &;hex-digit))))) - (assert "Can lex tokens between lower and upper boundaries of quantity." - (and (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") - (&;run "0123456789ABCDEF yolo" - (&;between +0 +16 &;hex-digit))) - (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") - (&;run "0123456789ABCDEF yolo" - (&;between +3 +16 &;hex-digit))) - (should-fail (&;run "0123456789ABCDEF yolo" - (&;between +17 +100 &;hex-digit))) - (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") - (&;run "0123456789ABCDEF yolo" - (&;between +15 +20 &;hex-digit))))) + (test "Can lex tokens between lower and upper boundaries of quantity." + (and (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") + (&;run "0123456789ABCDEF yolo" + (&;between +0 +16 &;hex-digit))) + (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") + (&;run "0123456789ABCDEF yolo" + (&;between +3 +16 &;hex-digit))) + (should-fail (&;run "0123456789ABCDEF yolo" + (&;between +17 +100 &;hex-digit))) + (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") + (&;run "0123456789ABCDEF yolo" + (&;between +15 +20 &;hex-digit))))) - (assert "Can optionally lex a token." - (and (|> (&;run "123abc" - (&;opt &;hex-digit)) - (case> (#;Right (#;Some "1")) true - _ false)) - (|> (&;run "yolo" - (&;opt &;hex-digit)) - (case> (#;Right #;None) true - _ false)))) + (test "Can optionally lex a token." + (and (|> (&;run "123abc" + (&;opt &;hex-digit)) + (case> (#;Right (#;Some "1")) true + _ false)) + (|> (&;run "yolo" + (&;opt &;hex-digit)) + (case> (#;Right #;None) true + _ false)))) - (assert "Can take into account separators during lexing." - (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "a" "b" "c" "d" "e" "f") - (&;run "0 1 2 3 4 5 6 7 8 9 a b c d e f YOLO" - (&;sep-by &;space &;hex-digit)))) + (test "Can take into account separators during lexing." + (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "a" "b" "c" "d" "e" "f") + (&;run "0 1 2 3 4 5 6 7 8 9 a b c d e f YOLO" + (&;sep-by &;space &;hex-digit)))) - (assert "Can obtain the whole of the remaining input." - (should-passT "yolo" (&;run "yolo" - &;get-input))) + (test "Can obtain the whole of the remaining input." + (should-passT "yolo" (&;run "yolo" + &;get-input))) )) diff --git a/stdlib/test/test/lux/data/text/regex.lux b/stdlib/test/test/lux/data/text/regex.lux index e4cfa2e10..bef24c0bf 100644 --- a/stdlib/test/test/lux/data/text/regex.lux +++ b/stdlib/test/test/lux/data/text/regex.lux @@ -47,238 +47,238 @@ false)))))) ## [Tests] -(test: "Regular Expressions [Basics]" - (assert "Can parse character literals." - (and (should-pass (&;regex "a") "a") - (should-fail (&;regex "a") ".") - (should-pass (&;regex "\\.") ".") - (should-fail (&;regex "\\.") "a")))) - -(test: "Regular Expressions [System character classes]" +(context: "Regular Expressions [Basics]" + (test "Can parse character literals." + (and (should-pass (&;regex "a") "a") + (should-fail (&;regex "a") ".") + (should-pass (&;regex "\\.") ".") + (should-fail (&;regex "\\.") "a")))) + +(context: "Regular Expressions [System character classes]" ($_ seq - (assert "Can parse anything." - (should-pass (&;regex ".") "a")) + (test "Can parse anything." + (should-pass (&;regex ".") "a")) - (assert "Can parse digits." - (and (should-pass (&;regex "\\d") "0") - (should-fail (&;regex "\\d") "m"))) + (test "Can parse digits." + (and (should-pass (&;regex "\\d") "0") + (should-fail (&;regex "\\d") "m"))) - (assert "Can parse non digits." - (and (should-pass (&;regex "\\D") "m") - (should-fail (&;regex "\\D") "0"))) + (test "Can parse non digits." + (and (should-pass (&;regex "\\D") "m") + (should-fail (&;regex "\\D") "0"))) - (assert "Can parse white-space." - (and (should-pass (&;regex "\\s") " ") - (should-fail (&;regex "\\s") "m"))) + (test "Can parse white-space." + (and (should-pass (&;regex "\\s") " ") + (should-fail (&;regex "\\s") "m"))) - (assert "Can parse non white-space." - (and (should-pass (&;regex "\\S") "m") - (should-fail (&;regex "\\S") " "))) + (test "Can parse non white-space." + (and (should-pass (&;regex "\\S") "m") + (should-fail (&;regex "\\S") " "))) - (assert "Can parse word characters." - (and (should-pass (&;regex "\\w") "_") - (should-fail (&;regex "\\w") "^"))) + (test "Can parse word characters." + (and (should-pass (&;regex "\\w") "_") + (should-fail (&;regex "\\w") "^"))) - (assert "Can parse non word characters." - (and (should-pass (&;regex "\\W") ".") - (should-fail (&;regex "\\W") "a"))) + (test "Can parse non word characters." + (and (should-pass (&;regex "\\W") ".") + (should-fail (&;regex "\\W") "a"))) )) -(test: "Regular Expressions [Special system character classes : Part 1]" +(context: "Regular Expressions [Special system character classes : Part 1]" ($_ seq - (assert "Can parse using special character classes." - (and (and (should-pass (&;regex "\\p{Lower}") "m") - (should-fail (&;regex "\\p{Lower}") "M")) + (test "Can parse using special character classes." + (and (and (should-pass (&;regex "\\p{Lower}") "m") + (should-fail (&;regex "\\p{Lower}") "M")) - (and (should-pass (&;regex "\\p{Upper}") "M") - (should-fail (&;regex "\\p{Upper}") "m")) + (and (should-pass (&;regex "\\p{Upper}") "M") + (should-fail (&;regex "\\p{Upper}") "m")) - (and (should-pass (&;regex "\\p{Alpha}") "M") - (should-fail (&;regex "\\p{Alpha}") "0")) + (and (should-pass (&;regex "\\p{Alpha}") "M") + (should-fail (&;regex "\\p{Alpha}") "0")) - (and (should-pass (&;regex "\\p{Digit}") "1") - (should-fail (&;regex "\\p{Digit}") "n")) + (and (should-pass (&;regex "\\p{Digit}") "1") + (should-fail (&;regex "\\p{Digit}") "n")) - (and (should-pass (&;regex "\\p{Alnum}") "1") - (should-fail (&;regex "\\p{Alnum}") ".")) + (and (should-pass (&;regex "\\p{Alnum}") "1") + (should-fail (&;regex "\\p{Alnum}") ".")) - (and (should-pass (&;regex "\\p{Space}") " ") - (should-fail (&;regex "\\p{Space}") ".")) - )) + (and (should-pass (&;regex "\\p{Space}") " ") + (should-fail (&;regex "\\p{Space}") ".")) + )) )) -(test: "Regular Expressions [Special system character classes : Part 2]" +(context: "Regular Expressions [Special system character classes : Part 2]" ($_ seq - (assert "Can parse using special character classes." - (and (and (should-pass (&;regex "\\p{HexDigit}") "a") - (should-fail (&;regex "\\p{HexDigit}") ".")) + (test "Can parse using special character classes." + (and (and (should-pass (&;regex "\\p{HexDigit}") "a") + (should-fail (&;regex "\\p{HexDigit}") ".")) - (and (should-pass (&;regex "\\p{OctDigit}") "6") - (should-fail (&;regex "\\p{OctDigit}") ".")) + (and (should-pass (&;regex "\\p{OctDigit}") "6") + (should-fail (&;regex "\\p{OctDigit}") ".")) - (and (should-pass (&;regex "\\p{Blank}") "\t") - (should-fail (&;regex "\\p{Blank}") ".")) + (and (should-pass (&;regex "\\p{Blank}") "\t") + (should-fail (&;regex "\\p{Blank}") ".")) - (and (should-pass (&;regex "\\p{ASCII}") "\t") - (should-fail (&;regex "\\p{ASCII}") "\u1234")) + (and (should-pass (&;regex "\\p{ASCII}") "\t") + (should-fail (&;regex "\\p{ASCII}") "\u1234")) - (and (should-pass (&;regex "\\p{Contrl}") "\u0012") - (should-fail (&;regex "\\p{Contrl}") "a")) + (and (should-pass (&;regex "\\p{Contrl}") "\u0012") + (should-fail (&;regex "\\p{Contrl}") "a")) - (and (should-pass (&;regex "\\p{Punct}") "@") - (should-fail (&;regex "\\p{Punct}") "a")) + (and (should-pass (&;regex "\\p{Punct}") "@") + (should-fail (&;regex "\\p{Punct}") "a")) - (and (should-pass (&;regex "\\p{Graph}") "@") - (should-fail (&;regex "\\p{Graph}") " ")) + (and (should-pass (&;regex "\\p{Graph}") "@") + (should-fail (&;regex "\\p{Graph}") " ")) - (and (should-pass (&;regex "\\p{Print}") "\u0020") - (should-fail (&;regex "\\p{Print}") "\u1234")) - )) + (and (should-pass (&;regex "\\p{Print}") "\u0020") + (should-fail (&;regex "\\p{Print}") "\u1234")) + )) )) -(test: "Regular Expressions [Custom character classes : Part 1]" +(context: "Regular Expressions [Custom character classes : Part 1]" ($_ seq - (assert "Can parse using custom character classes." - (and (should-pass (&;regex "[abc]") "a") - (should-fail (&;regex "[abc]") "m"))) - - (assert "Can parse using character ranges." - (and (should-pass (&;regex "[a-z]") "a") - (should-pass (&;regex "[a-z]") "m") - (should-pass (&;regex "[a-z]") "z"))) - - (assert "Can combine character ranges." - (and (should-pass (&;regex "[a-zA-Z]") "a") - (should-pass (&;regex "[a-zA-Z]") "m") - (should-pass (&;regex "[a-zA-Z]") "z") - (should-pass (&;regex "[a-zA-Z]") "A") - (should-pass (&;regex "[a-zA-Z]") "M") - (should-pass (&;regex "[a-zA-Z]") "Z"))) + (test "Can parse using custom character classes." + (and (should-pass (&;regex "[abc]") "a") + (should-fail (&;regex "[abc]") "m"))) + + (test "Can parse using character ranges." + (and (should-pass (&;regex "[a-z]") "a") + (should-pass (&;regex "[a-z]") "m") + (should-pass (&;regex "[a-z]") "z"))) + + (test "Can combine character ranges." + (and (should-pass (&;regex "[a-zA-Z]") "a") + (should-pass (&;regex "[a-zA-Z]") "m") + (should-pass (&;regex "[a-zA-Z]") "z") + (should-pass (&;regex "[a-zA-Z]") "A") + (should-pass (&;regex "[a-zA-Z]") "M") + (should-pass (&;regex "[a-zA-Z]") "Z"))) )) -(test: "Regular Expressions [Custom character classes : Part 2]" +(context: "Regular Expressions [Custom character classes : Part 2]" ($_ seq - (assert "Can negate custom character classes." - (and (should-fail (&;regex "[^abc]") "a") - (should-pass (&;regex "[^abc]") "m"))) + (test "Can negate custom character classes." + (and (should-fail (&;regex "[^abc]") "a") + (should-pass (&;regex "[^abc]") "m"))) - (assert "Can negate character ranges.." - (and (should-fail (&;regex "[^a-z]") "a") - (should-pass (&;regex "[^a-z]") "0"))) + (test "Can negate character ranges.." + (and (should-fail (&;regex "[^a-z]") "a") + (should-pass (&;regex "[^a-z]") "0"))) - (assert "Can parse negate combinations of character ranges." - (and (should-fail (&;regex "[^a-zA-Z]") "a") - (should-pass (&;regex "[^a-zA-Z]") "0"))) + (test "Can parse negate combinations of character ranges." + (and (should-fail (&;regex "[^a-zA-Z]") "a") + (should-pass (&;regex "[^a-zA-Z]") "0"))) )) -(test: "Regular Expressions [Custom character classes : Part 3]" +(context: "Regular Expressions [Custom character classes : Part 3]" ($_ seq - (assert "Can make custom character classes more specific." - (and (let [RE (&;regex "[a-z&&[def]]")] - (and (should-fail RE "a") - (should-pass RE "d"))) - - (let [RE (&;regex "[a-z&&[^bc]]")] - (and (should-pass RE "a") - (should-fail RE "b"))) - - (let [RE (&;regex "[a-z&&[^m-p]]")] - (and (should-pass RE "a") - (should-fail RE "m") - (should-fail RE "p"))))) + (test "Can make custom character classes more specific." + (and (let [RE (&;regex "[a-z&&[def]]")] + (and (should-fail RE "a") + (should-pass RE "d"))) + + (let [RE (&;regex "[a-z&&[^bc]]")] + (and (should-pass RE "a") + (should-fail RE "b"))) + + (let [RE (&;regex "[a-z&&[^m-p]]")] + (and (should-pass RE "a") + (should-fail RE "m") + (should-fail RE "p"))))) )) -(test: "Regular Expressions [Reference]" +(context: "Regular Expressions [Reference]" (let [number (&;regex "\\d+")] - (assert "Can build complex regexs by combining simpler ones." - (should-check ["809-345-6789" "809" "345" "6789"] (&;regex "(\\@<number>)-(\\@<number>)-(\\@<number>)") "809-345-6789")))) + (test "Can build complex regexs by combining simpler ones." + (should-check ["809-345-6789" "809" "345" "6789"] (&;regex "(\\@<number>)-(\\@<number>)-(\\@<number>)") "809-345-6789")))) -(test: "Regular Expressions [Fuzzy Quantifiers]" +(context: "Regular Expressions [Fuzzy Quantifiers]" ($_ seq - (assert "Can sequentially combine patterns." - (should-passT "aa" (&;regex "aa") "aa")) + (test "Can sequentially combine patterns." + (should-passT "aa" (&;regex "aa") "aa")) - (assert "Can match patterns optionally." - (and (should-passT "a" (&;regex "a?") "a") - (should-passT "" (&;regex "a?") ""))) + (test "Can match patterns optionally." + (and (should-passT "a" (&;regex "a?") "a") + (should-passT "" (&;regex "a?") ""))) - (assert "Can match a pattern 0 or more times." - (and (should-passT "aaa" (&;regex "a*") "aaa") - (should-passT "" (&;regex "a*") ""))) + (test "Can match a pattern 0 or more times." + (and (should-passT "aaa" (&;regex "a*") "aaa") + (should-passT "" (&;regex "a*") ""))) - (assert "Can match a pattern 1 or more times." - (and (should-passT "aaa" (&;regex "a+") "aaa") - (should-passT "a" (&;regex "a+") "a") - (should-fail (&;regex "a+") ""))) + (test "Can match a pattern 1 or more times." + (and (should-passT "aaa" (&;regex "a+") "aaa") + (should-passT "a" (&;regex "a+") "a") + (should-fail (&;regex "a+") ""))) )) -(test: "Regular Expressions [Crisp Quantifiers]" +(context: "Regular Expressions [Crisp Quantifiers]" ($_ seq - (assert "Can match a pattern N times." - (and (should-passT "aa" (&;regex "a{2}") "aa") - (should-passT "a" (&;regex "a{1}") "aa") - (should-fail (&;regex "a{3}") "aa"))) - - (assert "Can match a pattern at-least N times." - (and (should-passT "aa" (&;regex "a{1,}") "aa") - (should-passT "aa" (&;regex "a{2,}") "aa") - (should-fail (&;regex "a{3,}") "aa"))) - - (assert "Can match a pattern at-most N times." - (and (should-passT "a" (&;regex "a{,1}") "aa") - (should-passT "aa" (&;regex "a{,2}") "aa") - (should-passT "aa" (&;regex "a{,3}") "aa"))) - - (assert "Can match a pattern between N and M times." - (and (should-passT "a" (&;regex "a{1,2}") "a") - (should-passT "aa" (&;regex "a{1,2}") "aa") - (should-passT "aa" (&;regex "a{1,2}") "aaa"))) + (test "Can match a pattern N times." + (and (should-passT "aa" (&;regex "a{2}") "aa") + (should-passT "a" (&;regex "a{1}") "aa") + (should-fail (&;regex "a{3}") "aa"))) + + (test "Can match a pattern at-least N times." + (and (should-passT "aa" (&;regex "a{1,}") "aa") + (should-passT "aa" (&;regex "a{2,}") "aa") + (should-fail (&;regex "a{3,}") "aa"))) + + (test "Can match a pattern at-most N times." + (and (should-passT "a" (&;regex "a{,1}") "aa") + (should-passT "aa" (&;regex "a{,2}") "aa") + (should-passT "aa" (&;regex "a{,3}") "aa"))) + + (test "Can match a pattern between N and M times." + (and (should-passT "a" (&;regex "a{1,2}") "a") + (should-passT "aa" (&;regex "a{1,2}") "aa") + (should-passT "aa" (&;regex "a{1,2}") "aaa"))) )) -(test: "Regular Expressions [Groups]" +(context: "Regular Expressions [Groups]" ($_ seq - (assert "Can extract groups of sub-matches specified in a pattern." - (and (should-check ["abc" "b"] (&;regex "a(.)c") "abc") - (should-check ["abbbbbc" "bbbbb"] (&;regex "a(b+)c") "abbbbbc") - (should-check ["809-345-6789" "809" "345" "6789"] (&;regex "(\\d{3})-(\\d{3})-(\\d{4})") "809-345-6789") - (should-check ["809-345-6789" "809" "6789"] (&;regex "(\\d{3})-(?:\\d{3})-(\\d{4})") "809-345-6789") - (should-check ["809-809-6789" "809" "6789"] (&;regex "(\\d{3})-\\0-(\\d{4})") "809-809-6789") - (should-check ["809-809-6789" "809" "6789"] (&;regex "(?<code>\\d{3})-\\k<code>-(\\d{4})") "809-809-6789") - (should-check ["809-809-6789-6789" "809" "6789"] (&;regex "(?<code>\\d{3})-\\k<code>-(\\d{4})-\\0") "809-809-6789-6789"))) - - (assert "Can specify groups within groups." - (should-check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (&;regex "(\\d{3})-((\\d{3})-(\\d{4}))") "809-345-6789")) + (test "Can extract groups of sub-matches specified in a pattern." + (and (should-check ["abc" "b"] (&;regex "a(.)c") "abc") + (should-check ["abbbbbc" "bbbbb"] (&;regex "a(b+)c") "abbbbbc") + (should-check ["809-345-6789" "809" "345" "6789"] (&;regex "(\\d{3})-(\\d{3})-(\\d{4})") "809-345-6789") + (should-check ["809-345-6789" "809" "6789"] (&;regex "(\\d{3})-(?:\\d{3})-(\\d{4})") "809-345-6789") + (should-check ["809-809-6789" "809" "6789"] (&;regex "(\\d{3})-\\0-(\\d{4})") "809-809-6789") + (should-check ["809-809-6789" "809" "6789"] (&;regex "(?<code>\\d{3})-\\k<code>-(\\d{4})") "809-809-6789") + (should-check ["809-809-6789-6789" "809" "6789"] (&;regex "(?<code>\\d{3})-\\k<code>-(\\d{4})-\\0") "809-809-6789-6789"))) + + (test "Can specify groups within groups." + (should-check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (&;regex "(\\d{3})-((\\d{3})-(\\d{4}))") "809-345-6789")) )) -(test: "Regular Expressions [Alternation]" +(context: "Regular Expressions [Alternation]" ($_ seq - (assert "Can specify alternative patterns." - (and (should-check ["a" (+0 [])] (&;regex "a|b") "a") - (should-check ["b" (+1 [])] (&;regex "a|b") "b") - (should-fail (&;regex "a|b") "c"))) - - (assert "Can have groups within alternations." - (and (should-check ["abc" (+0 ["b" "c"])] (&;regex "a(.)(.)|b(.)(.)") "abc") - (should-check ["bcd" (+1 ["c" "d"])] (&;regex "a(.)(.)|b(.)(.)") "bcd") - (should-fail (&;regex "a(.)(.)|b(.)(.)") "cde") - - (should-check ["809-345-6789" (+0 ["809" "345-6789" "345" "6789"])] - (&;regex "(\\d{3})-((\\d{3})-(\\d{4}))|b(.)d") - "809-345-6789"))) + (test "Can specify alternative patterns." + (and (should-check ["a" (+0 [])] (&;regex "a|b") "a") + (should-check ["b" (+1 [])] (&;regex "a|b") "b") + (should-fail (&;regex "a|b") "c"))) + + (test "Can have groups within alternations." + (and (should-check ["abc" (+0 ["b" "c"])] (&;regex "a(.)(.)|b(.)(.)") "abc") + (should-check ["bcd" (+1 ["c" "d"])] (&;regex "a(.)(.)|b(.)(.)") "bcd") + (should-fail (&;regex "a(.)(.)|b(.)(.)") "cde") + + (should-check ["809-345-6789" (+0 ["809" "345-6789" "345" "6789"])] + (&;regex "(\\d{3})-((\\d{3})-(\\d{4}))|b(.)d") + "809-345-6789"))) )) -(test: "Pattern-matching" +(context: "Pattern-matching" [sample1 (R;text +3) sample2 (R;text +3) sample3 (R;text +4)] (case (format sample1 "-" sample2 "-" sample3) (&;^regex "(.{3})-(.{3})-(.{4})" [_ match1 match2 match3]) - (assert "Can pattern-match using regular-expressions." - (and (T/= sample1 match1) - (T/= sample2 match2) - (T/= sample3 match3))) + (test "Can pattern-match using regular-expressions." + (and (T/= sample1 match1) + (T/= sample2 match2) + (T/= sample3 match3))) _ - (assert "Cannot pattern-match using regular-expressions." - false))) + (test "Cannot pattern-match using regular-expressions." + false))) diff --git a/stdlib/test/test/lux/host.js.lux b/stdlib/test/test/lux/host.js.lux index b7dbe043f..f533a8fe6 100644 --- a/stdlib/test/test/lux/host.js.lux +++ b/stdlib/test/test/lux/host.js.lux @@ -7,25 +7,25 @@ ["R" math/random]) lux/test) -(test: "JavaScript operations" +(context: "JavaScript operations" ($_ seq - (assert "Null equals itself." - (is (&;null) (&;null))) + (test "Null equals itself." + (is (&;null) (&;null))) - (assert "Undefined equals itself." - (is (&;undef) (&;undef))) + (test "Undefined equals itself." + (is (&;undef) (&;undef))) - (assert "Can reference JavaScript objects." - (is (&;ref "Math") (&;ref "Math"))) + (test "Can reference JavaScript objects." + (is (&;ref "Math") (&;ref "Math"))) - (assert "Can create objects and access their fields." - (|> (&;object "foo" "BAR") - (&;get "foo" Text) - (is "BAR"))) + (test "Can create objects and access their fields." + (|> (&;object "foo" "BAR") + (&;get "foo" Text) + (is "BAR"))) - (assert "Can call JavaScript functions" - (and (is 124.0 - (&;call! (&;ref "Math.ceil" &;Function) [123.45] Real)) - (is 124.0 - (&;call! (&;ref "Math") "ceil" [123.45] Real)))) + (test "Can call JavaScript functions" + (and (is 124.0 + (&;call! (&;ref "Math.ceil" &;Function) [123.45] Real)) + (is 124.0 + (&;call! (&;ref "Math") "ceil" [123.45] Real)))) )) diff --git a/stdlib/test/test/lux/host.jvm.lux b/stdlib/test/test/lux/host.jvm.lux index ae12784af..a90db336c 100644 --- a/stdlib/test/test/lux/host.jvm.lux +++ b/stdlib/test/test/lux/host.jvm.lux @@ -52,14 +52,14 @@ (interface: TestInterface ([] foo [boolean String] void #throws [Exception])) -(test: "Conversions" +(context: "Conversions" [sample R;int] (with-expansions [<int-convs> (do-template [<to> <from> <message>] - [(assert <message> - (or (|> sample <to> <from> (i.= sample)) - (let [capped-sample (|> sample <to> <from>)] - (|> capped-sample <to> <from> (i.= capped-sample)))))] + [(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."] @@ -72,42 +72,42 @@ <int-convs> ))) -(test: "Miscellaneous" +(context: "Miscellaneous" ($_ seq - (assert "Can check if an object is of a certain class." - (and (&;instance? String "") - (not (&;instance? Long "")) - (&;instance? Object "") - (not (&;instance? Object (&;null))))) - - (assert "Can run code in a \"synchronized\" block." - (&;synchronized "" true)) - - (assert "Can access Class instances." - (Text/= "java.lang.Class" (Class.getName [] (&;class-for java.lang.Class)))) - - (assert "Can check if a value is null." - (and (&;null? (&;null)) - (not (&;null? "")))) - - (assert "Can safely convert nullable references into Maybe values." - (and (|> (: (Maybe Object) (&;??? (&;null))) - (case> #;None true - _ false)) - (|> (: (Maybe Object) (&;??? "")) - (case> (#;Some _) true - _ false)))) + (test "Can check if an object is of a certain class." + (and (&;instance? String "") + (not (&;instance? Long "")) + (&;instance? Object "") + (not (&;instance? Object (&;null))))) + + (test "Can run code in a \"synchronized\" block." + (&;synchronized "" true)) + + (test "Can access Class instances." + (Text/= "java.lang.Class" (Class.getName [] (&;class-for java.lang.Class)))) + + (test "Can check if a value is null." + (and (&;null? (&;null)) + (not (&;null? "")))) + + (test "Can safely convert nullable references into Maybe values." + (and (|> (: (Maybe Object) (&;??? (&;null))) + (case> #;None true + _ false)) + (|> (: (Maybe Object) (&;??? "")) + (case> (#;Some _) true + _ false)))) )) -(test: "Arrays" +(context: "Arrays" [size (|> R;nat (:: @ map (|>. (n.% +100) (n.max +1)))) idx (|> R;nat (:: @ map (n.% size))) value R;int] ($_ seq - (assert "Can create arrays of some length." - (n.= size (&;array-length (&;array Long size)))) + (test "Can create arrays of some length." + (n.= size (&;array-length (&;array Long size)))) - (assert "Can set and get array values." - (let [arr (&;array Long size)] - (exec (&;array-store idx value arr) - (i.= value (&;array-load idx arr))))))) + (test "Can set and get array values." + (let [arr (&;array Long size)] + (exec (&;array-store idx value arr) + (i.= value (&;array-load idx arr))))))) diff --git a/stdlib/test/test/lux/io.lux b/stdlib/test/test/lux/io.lux index 839996e81..0347d75ec 100644 --- a/stdlib/test/test/lux/io.lux +++ b/stdlib/test/test/lux/io.lux @@ -7,15 +7,15 @@ [number])) lux/test) -(test: "I/O" +(context: "I/O" ($_ seq - (assert "" (Text/= "YOLO" (&;run (&;io "YOLO")))) - (assert "" (i.= 11 (&;run (:: &;Functor<IO> map i.inc (&;io 10))))) - (assert "" (i.= 10 (&;run (:: &;Applicative<IO> wrap 10)))) - (assert "" (i.= 30 (&;run (let [(^open "&/") &;Applicative<IO>] - (&/apply (&/wrap (i.+ 10)) (&/wrap 20)))))) - (assert "" (i.= 30 (&;run (do &;Monad<IO> - [f (wrap i.+) - x (wrap 10) - y (wrap 20)] - (wrap (f x y)))))))) + (test "" (Text/= "YOLO" (&;run (&;io "YOLO")))) + (test "" (i.= 11 (&;run (:: &;Functor<IO> map i.inc (&;io 10))))) + (test "" (i.= 10 (&;run (:: &;Applicative<IO> wrap 10)))) + (test "" (i.= 30 (&;run (let [(^open "&/") &;Applicative<IO>] + (&/apply (&/wrap (i.+ 10)) (&/wrap 20)))))) + (test "" (i.= 30 (&;run (do &;Monad<IO> + [f (wrap i.+) + x (wrap 10) + y (wrap 20)] + (wrap (f x y)))))))) diff --git a/stdlib/test/test/lux/macro/code.lux b/stdlib/test/test/lux/macro/code.lux index 2f05ad926..fd1d7415e 100644 --- a/stdlib/test/test/lux/macro/code.lux +++ b/stdlib/test/test/lux/macro/code.lux @@ -9,12 +9,12 @@ (macro ["&" code])) lux/test) -(test: "Code" +(context: "Code" (with-expansions [<tests> (do-template [<expr> <text>] - [(assert (format "Can produce Code node: " <text>) - (and (T/= <text> (&;to-text <expr>)) - (:: &;Eq<Code> = <expr> <expr>)))] + [(test (format "Can produce Code node: " <text>) + (and (T/= <text> (&;to-text <expr>)) + (:: &;Eq<Code> = <expr> <expr>)))] [(&;bool true) "true"] [(&;bool false) "false"] diff --git a/stdlib/test/test/lux/macro/poly/eq.lux b/stdlib/test/test/lux/macro/poly/eq.lux index 3cd515fc6..512a7633b 100644 --- a/stdlib/test/test/lux/macro/poly/eq.lux +++ b/stdlib/test/test/lux/macro/poly/eq.lux @@ -53,8 +53,8 @@ (derived: (&;Eq<?> Record)) ## [Tests] -(test: "Eq polytypism" +(context: "Eq polytypism" [sample gen-record #let [(^open "&/") Eq<Record>]] - (assert "Every instance equals itself." - (&/= sample sample))) + (test "Every instance equals itself." + (&/= sample sample))) diff --git a/stdlib/test/test/lux/macro/poly/functor.lux b/stdlib/test/test/lux/macro/poly/functor.lux index 3294556a4..ae0765a60 100644 --- a/stdlib/test/test/lux/macro/poly/functor.lux +++ b/stdlib/test/test/lux/macro/poly/functor.lux @@ -34,5 +34,5 @@ (derived: (&;Functor<?> My-State)) ## [Tests] -(test: "Functor polytypism" - (assert "" true)) +(context: "Functor polytypism" + (test "" true)) diff --git a/stdlib/test/test/lux/macro/poly/text-encoder.lux b/stdlib/test/test/lux/macro/poly/text-encoder.lux index ec392fc8e..240ad7ad4 100644 --- a/stdlib/test/test/lux/macro/poly/text-encoder.lux +++ b/stdlib/test/test/lux/macro/poly/text-encoder.lux @@ -53,5 +53,5 @@ (derived: (&;Codec<Text,?>::encode Record)) ## [Tests] -(test: "Text-encoding polytypism" - (assert "" true)) +(context: "Text-encoding polytypism" + (test "" true)) diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux index 9982dc01b..5f84f5c26 100644 --- a/stdlib/test/test/lux/macro/syntax.lux +++ b/stdlib/test/test/lux/macro/syntax.lux @@ -62,13 +62,13 @@ false))))) ## [Tests] -(test: "Simple value syntax." +(context: "Simple value syntax." (with-expansions [<simple-tests> (do-template [<assertion> <value> <ctor> <Eq> <get>] - [(assert <assertion> - (and (is? <Eq> <value> <get> (list (<ctor> <value>))) - (found? (s;this? (<ctor> <value>)) (list (<ctor> <value>))) - (enforced? (s;this (<ctor> <value>)) (list (<ctor> <value>)))))] + [(test <assertion> + (and (is? <Eq> <value> <get> (list (<ctor> <value>))) + (found? (s;this? (<ctor> <value>)) (list (<ctor> <value>))) + (enforced? (s;this (<ctor> <value>)) (list (<ctor> <value>)))))] ["Can parse Bool syntax." true code;bool bool;Eq<Bool> s;bool] ["Can parse Nat syntax." +123 code;nat number;Eq<Nat> s;nat] @@ -83,172 +83,172 @@ ($_ seq <simple-tests> - (assert "Can parse symbols belonging to the current namespace." - (and (match "yolo" - (s;run (list (code;local-symbol "yolo")) - s;local-symbol)) - (fails? (s;run (list (code;symbol ["yolo" "lol"])) - s;local-symbol)))) + (test "Can parse symbols belonging to the current namespace." + (and (match "yolo" + (s;run (list (code;local-symbol "yolo")) + s;local-symbol)) + (fails? (s;run (list (code;symbol ["yolo" "lol"])) + s;local-symbol)))) - (assert "Can parse tags belonging to the current namespace." - (and (match "yolo" - (s;run (list (code;local-tag "yolo")) - s;local-tag)) - (fails? (s;run (list (code;tag ["yolo" "lol"])) - s;local-tag)))) + (test "Can parse tags belonging to the current namespace." + (and (match "yolo" + (s;run (list (code;local-tag "yolo")) + s;local-tag)) + (fails? (s;run (list (code;tag ["yolo" "lol"])) + s;local-tag)))) ))) -(test: "Complex value syntax." +(context: "Complex value syntax." (with-expansions [<group-tests> (do-template [<type> <parser> <ctor>] - [(assert (format "Can parse " <type> " syntax.") - (and (match [true 123] - (s;run (list (<ctor> (list (code;bool true) (code;int 123)))) - (<parser> (s;seq s;bool s;int)))) - (match true - (s;run (list (<ctor> (list (code;bool true)))) - (<parser> s;bool))) - (fails? (s;run (list (<ctor> (list (code;bool true) (code;int 123)))) - (<parser> s;bool))) - (match (#;Left true) - (s;run (list (<ctor> (list (code;bool true)))) - (<parser> (s;alt s;bool s;int)))) - (match (#;Right 123) - (s;run (list (<ctor> (list (code;int 123)))) - (<parser> (s;alt s;bool s;int)))) - (fails? (s;run (list (<ctor> (list (code;real 123.0)))) - (<parser> (s;alt s;bool s;int))))))] + [(test (format "Can parse " <type> " syntax.") + (and (match [true 123] + (s;run (list (<ctor> (list (code;bool true) (code;int 123)))) + (<parser> (s;seq s;bool s;int)))) + (match true + (s;run (list (<ctor> (list (code;bool true)))) + (<parser> s;bool))) + (fails? (s;run (list (<ctor> (list (code;bool true) (code;int 123)))) + (<parser> s;bool))) + (match (#;Left true) + (s;run (list (<ctor> (list (code;bool true)))) + (<parser> (s;alt s;bool s;int)))) + (match (#;Right 123) + (s;run (list (<ctor> (list (code;int 123)))) + (<parser> (s;alt s;bool s;int)))) + (fails? (s;run (list (<ctor> (list (code;real 123.0)))) + (<parser> (s;alt s;bool s;int))))))] ["form" s;form code;form] ["tuple" s;tuple code;tuple])] ($_ seq <group-tests> - (assert "Can parse record syntax." - (match [true 123] - (s;run (list (code;record (list [(code;bool true) (code;int 123)]))) - (s;record (s;seq s;bool s;int))))) + (test "Can parse record syntax." + (match [true 123] + (s;run (list (code;record (list [(code;bool true) (code;int 123)]))) + (s;record (s;seq s;bool s;int))))) ))) -(test: "Assertions" - (assert "Can make assertions while parsing." - (and (match [] - (s;run (list (code;bool true) (code;int 123)) - (s;assert "yolo" true))) - (fails? (s;run (list (code;bool true) (code;int 123)) - (s;assert "yolo" false)))))) +(context: "Assertions" + (test "Can make assertions while parsing." + (and (match [] + (s;run (list (code;bool true) (code;int 123)) + (s;assert "yolo" true))) + (fails? (s;run (list (code;bool true) (code;int 123)) + (s;assert "yolo" false)))))) -(test: "Combinators [Part 1]" +(context: "Combinators [Part 1]" ($_ seq - (assert "Can parse any Code." - (match [_ (#;Bool true)] - (s;run (list (code;bool true) (code;int 123)) - s;any))) - - (assert "Can optionally succeed with some parser." - (and (match (#;Some +123) - (s;run (list (code;nat +123)) - (s;opt s;nat))) - (match #;None - (s;run (list (code;int -123)) - (s;opt s;nat))))) - - (assert "Can apply a parser 0 or more times." - (and (match (list +123 +456 +789) - (s;run (list (code;nat +123) (code;nat +456) (code;nat +789)) - (s;some s;nat))) - (match (list) - (s;run (list (code;int -123)) - (s;some s;nat))))) - - (assert "Can apply a parser 1 or more times." - (and (match (list +123 +456 +789) - (s;run (list (code;nat +123) (code;nat +456) (code;nat +789)) - (s;many s;nat))) - (match (list +123) - (s;run (list (code;nat +123)) - (s;many s;nat))) - (fails? (s;run (list (code;int -123)) - (s;many s;nat))))) - - (assert "Can use either parser." - (and (match 123 - (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;either s;pos-int s;int))) - (match -123 - (s;run (list (code;int -123) (code;int 456) (code;int 789)) - (s;either s;pos-int s;int))) - (fails? (s;run (list (code;bool true) (code;int 456) (code;int 789)) - (s;either s;pos-int s;int))))) - - (assert "Can create the opposite/negation of any parser." - (and (fails? (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;not s;int))) - (match [] - (s;run (list (code;bool true) (code;int 456) (code;int 789)) - (s;not s;int))))) + (test "Can parse any Code." + (match [_ (#;Bool true)] + (s;run (list (code;bool true) (code;int 123)) + s;any))) + + (test "Can optionally succeed with some parser." + (and (match (#;Some +123) + (s;run (list (code;nat +123)) + (s;opt s;nat))) + (match #;None + (s;run (list (code;int -123)) + (s;opt s;nat))))) + + (test "Can apply a parser 0 or more times." + (and (match (list +123 +456 +789) + (s;run (list (code;nat +123) (code;nat +456) (code;nat +789)) + (s;some s;nat))) + (match (list) + (s;run (list (code;int -123)) + (s;some s;nat))))) + + (test "Can apply a parser 1 or more times." + (and (match (list +123 +456 +789) + (s;run (list (code;nat +123) (code;nat +456) (code;nat +789)) + (s;many s;nat))) + (match (list +123) + (s;run (list (code;nat +123)) + (s;many s;nat))) + (fails? (s;run (list (code;int -123)) + (s;many s;nat))))) + + (test "Can use either parser." + (and (match 123 + (s;run (list (code;int 123) (code;int 456) (code;int 789)) + (s;either s;pos-int s;int))) + (match -123 + (s;run (list (code;int -123) (code;int 456) (code;int 789)) + (s;either s;pos-int s;int))) + (fails? (s;run (list (code;bool true) (code;int 456) (code;int 789)) + (s;either s;pos-int s;int))))) + + (test "Can create the opposite/negation of any parser." + (and (fails? (s;run (list (code;int 123) (code;int 456) (code;int 789)) + (s;not s;int))) + (match [] + (s;run (list (code;bool true) (code;int 456) (code;int 789)) + (s;not s;int))))) )) -(test: "Combinators Part [2]" +(context: "Combinators Part [2]" ($_ seq - (assert "Can check whether the end has been reached." - (and (match true - (s;run (list) - s;end?)) - (match false - (s;run (list (code;bool true)) - s;end?)))) - - (assert "Can ensure the end has been reached." - (and (match [] - (s;run (list) - s;end!)) - (fails? (s;run (list (code;bool true)) - s;end!)))) - - (assert "Can apply a parser N times." - (and (match (list 123 456 789) - (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;exactly +3 s;int))) - (match (list 123 456) - (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;exactly +2 s;int))) - (fails? (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;exactly +4 s;int))))) - - (assert "Can apply a parser at-least N times." - (and (match (list 123 456 789) - (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;at-least +3 s;int))) - (match (list 123 456 789) - (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;at-least +2 s;int))) - (fails? (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;at-least +4 s;int))))) - - (assert "Can apply a parser at-most N times." - (and (match (list 123 456 789) - (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;at-most +3 s;int))) - (match (list 123 456) - (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;at-most +2 s;int))) - (match (list 123 456 789) - (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;at-most +4 s;int))))) - - (assert "Can apply a parser between N and M times." - (and (match (list 123 456 789) - (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;between +3 +10 s;int))) - (fails? (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;between +4 +10 s;int))))) - - (assert "Can parse while taking separators into account." - (and (match (list 123 456 789) - (s;run (list (code;int 123) (code;text "YOLO") (code;int 456) (code;text "YOLO") (code;int 789)) - (s;sep-by (s;this (' "YOLO")) s;int))) - (match (list 123 456) - (s;run (list (code;int 123) (code;text "YOLO") (code;int 456) (code;int 789)) - (s;sep-by (s;this (' "YOLO")) s;int))))) + (test "Can check whether the end has been reached." + (and (match true + (s;run (list) + s;end?)) + (match false + (s;run (list (code;bool true)) + s;end?)))) + + (test "Can ensure the end has been reached." + (and (match [] + (s;run (list) + s;end!)) + (fails? (s;run (list (code;bool true)) + s;end!)))) + + (test "Can apply a parser N times." + (and (match (list 123 456 789) + (s;run (list (code;int 123) (code;int 456) (code;int 789)) + (s;exactly +3 s;int))) + (match (list 123 456) + (s;run (list (code;int 123) (code;int 456) (code;int 789)) + (s;exactly +2 s;int))) + (fails? (s;run (list (code;int 123) (code;int 456) (code;int 789)) + (s;exactly +4 s;int))))) + + (test "Can apply a parser at-least N times." + (and (match (list 123 456 789) + (s;run (list (code;int 123) (code;int 456) (code;int 789)) + (s;at-least +3 s;int))) + (match (list 123 456 789) + (s;run (list (code;int 123) (code;int 456) (code;int 789)) + (s;at-least +2 s;int))) + (fails? (s;run (list (code;int 123) (code;int 456) (code;int 789)) + (s;at-least +4 s;int))))) + + (test "Can apply a parser at-most N times." + (and (match (list 123 456 789) + (s;run (list (code;int 123) (code;int 456) (code;int 789)) + (s;at-most +3 s;int))) + (match (list 123 456) + (s;run (list (code;int 123) (code;int 456) (code;int 789)) + (s;at-most +2 s;int))) + (match (list 123 456 789) + (s;run (list (code;int 123) (code;int 456) (code;int 789)) + (s;at-most +4 s;int))))) + + (test "Can apply a parser between N and M times." + (and (match (list 123 456 789) + (s;run (list (code;int 123) (code;int 456) (code;int 789)) + (s;between +3 +10 s;int))) + (fails? (s;run (list (code;int 123) (code;int 456) (code;int 789)) + (s;between +4 +10 s;int))))) + + (test "Can parse while taking separators into account." + (and (match (list 123 456 789) + (s;run (list (code;int 123) (code;text "YOLO") (code;int 456) (code;text "YOLO") (code;int 789)) + (s;sep-by (s;this (' "YOLO")) s;int))) + (match (list 123 456) + (s;run (list (code;int 123) (code;text "YOLO") (code;int 456) (code;int 789)) + (s;sep-by (s;this (' "YOLO")) s;int))))) )) diff --git a/stdlib/test/test/lux/math.lux b/stdlib/test/test/lux/math.lux index 2b834b9cc..a3000e7dd 100644 --- a/stdlib/test/test/lux/math.lux +++ b/stdlib/test/test/lux/math.lux @@ -22,100 +22,100 @@ ## ## 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 -## (test: "Trigonometry" +## (context: "Trigonometry" ## [angle (|> R;real (:: @ map (r.* &;tau)))] ## ($_ seq -## (assert "Sine and arc-sine are inverse functions." -## (|> angle &;sin &;asin (within? margin angle))) +## (test "Sine and arc-sine are inverse functions." +## (|> angle &;sin &;asin (within? margin angle))) -## (assert "Cosine and arc-cosine are inverse functions." -## (|> angle &;cos &;acos (within? margin angle))) +## (test "Cosine and arc-cosine are inverse functions." +## (|> angle &;cos &;acos (within? margin angle))) -## (assert "Tangent and arc-tangent are inverse functions." -## (|> angle &;tan &;atan (within? margin angle))) +## (test "Tangent and arc-tangent are inverse functions." +## (|> angle &;tan &;atan (within? margin angle))) ## )) -(test: "Roots" +(context: "Roots" [factor (|> R;nat (:: @ map (|>. (n.% +1000) (n.max +1) nat-to-int int-to-real))) base (|> R;real (:: @ map (r.* factor)))] ($_ seq - (assert "Square-root is inverse of square." - (|> base (&;pow 2.0) &;root2 (r.= base))) + (test "Square-root is inverse of square." + (|> base (&;pow 2.0) &;root2 (r.= base))) - (assert "Cubic-root is inverse of cube." - (|> base (&;pow 3.0) &;root3 (r.= base))) + (test "Cubic-root is inverse of cube." + (|> base (&;pow 3.0) &;root3 (r.= base))) )) -(test: "Rounding" +(context: "Rounding" [sample (|> R;real (:: @ map (r.* 1000.0)))] ($_ seq - (assert "The ceiling will be an integer value, and will be >= the original." - (let [ceil'd (&;ceil sample)] - (and (|> ceil'd real-to-int int-to-real (r.= ceil'd)) - (r.>= sample ceil'd) - (r.<= 1.0 (r.- sample ceil'd))))) - - (assert "The floor will be an integer value, and will be <= the original." - (let [floor'd (&;floor sample)] - (and (|> floor'd real-to-int int-to-real (r.= floor'd)) - (r.<= sample floor'd) - (r.<= 1.0 (r.- floor'd sample))))) - - (assert "The round will be an integer value, and will be < or > or = the original." - (let [round'd (&;round sample)] - (and (|> round'd real-to-int int-to-real (r.= round'd)) - (r.<= 1.0 (r/abs (r.- sample round'd)))))) + (test "The ceiling will be an integer value, and will be >= the original." + (let [ceil'd (&;ceil sample)] + (and (|> ceil'd real-to-int int-to-real (r.= ceil'd)) + (r.>= sample ceil'd) + (r.<= 1.0 (r.- sample ceil'd))))) + + (test "The floor will be an integer value, and will be <= the original." + (let [floor'd (&;floor sample)] + (and (|> floor'd real-to-int int-to-real (r.= floor'd)) + (r.<= sample floor'd) + (r.<= 1.0 (r.- 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 real-to-int int-to-real (r.= round'd)) + (r.<= 1.0 (r/abs (r.- sample round'd)))))) )) -(test: "Exponentials and logarithms" +(context: "Exponentials and logarithms" [sample (|> R;real (:: @ map (r.* 10.0)))] - (assert "Logarithm is the inverse of exponential." - (|> sample &;exp &;log (within? 1.0e-15 sample)))) + (test "Logarithm is the inverse of exponential." + (|> sample &;exp &;log (within? 1.0e-15 sample)))) -(test: "Greatest-Common-Divisor and Least-Common-Multiple" +(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] - ($_ (assert "GCD" - (let [gcd (&;gcd x y)] - (and (n.= +0 (n.% gcd x)) - (n.= +0 (n.% gcd y)) - (n.>= +1 gcd)))) - - (assert "LCM" - (let [lcm (&;lcm x y)] - (and (n.= +0 (n.% x lcm)) - (n.= +0 (n.% y lcm)) - (n.<= (n.* x y) lcm)))) + ($_ (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)))) )) -(test: "Infix syntax" +(context: "Infix syntax" [x R;nat y R;nat z R;nat #let [top (|> x (n.max y) (n.max z)) bottom (|> x (n.min y) (n.min z))]] ($_ seq - (assert "Constant values don't change." - (n.= x (&;infix x))) + (test "Constant values don't change." + (n.= x (&;infix x))) - (assert "Can call infix functions." - (n.= (&;gcd y x) (&;infix [x &;gcd y]))) + (test "Can call infix functions." + (n.= (&;gcd y x) (&;infix [x &;gcd y]))) - (assert "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 regular syntax in the middle of infix code." + (n.= (&;gcd +450 (n.* +3 +9)) + (&;infix [(n.* +3 +9) &;gcd +450]))) - (assert "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 use non-numerical functions/macros as operators." + (b/= (and (n.< y x) (n.< z y)) + (&;infix [[x n.< y] and [y n.< z]]))) - (assert "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])))) + (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 b1770c815..c57060400 100644 --- a/stdlib/test/test/lux/math/logic/continuous.lux +++ b/stdlib/test/test/lux/math/logic/continuous.lux @@ -6,26 +6,26 @@ ["&" math/logic/continuous]) lux/test) -(test: "Operations" +(context: "Operations" [left R;deg right R;deg] ($_ seq - (assert "AND is the minimum." - (let [result (&;~and left right)] - (and (d.<= left result) - (d.<= right result)))) + (test "AND is the minimum." + (let [result (&;~and left right)] + (and (d.<= left result) + (d.<= right result)))) - (assert "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)))) - (assert "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)))) - (assert "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 73530f35b..bdc283551 100644 --- a/stdlib/test/test/lux/math/logic/fuzzy.lux +++ b/stdlib/test/test/lux/math/logic/fuzzy.lux @@ -13,7 +13,7 @@ lux/test) (do-template [<desc> <hash> <gen> <triangle> <lt> <lte> <gt> <gte>] - [(test: (format "[" <desc> "] " "Triangles") + [(context: (format "[" <desc> "] " "Triangles") [values (R;set <hash> +3 <gen>) #let [[x y z] (case (set;to-list values) (^ (list x y z)) @@ -30,22 +30,22 @@ (undefined)) triangle (<triangle> x y z)]] ($_ seq - (assert "The middle value will always have maximum membership." - (d.= ~true (&;membership middle triangle))) + (test "The middle value will always have maximum membership." + (d.= ~true (&;membership middle triangle))) - (assert "Boundary values will always have 0 membership." - (and (d.= ~false (&;membership bottom triangle)) - (d.= ~false (&;membership top triangle)))) - - (assert "Values within range, will have membership > 0." - (B/= (d.> ~false (&;membership sample triangle)) - (and (<gt> bottom sample) - (<lt> top sample)))) - - (assert "Values outside of range, will have membership = 0." - (B/= (d.= ~false (&;membership sample triangle)) - (or (<lte> bottom sample) - (<gte> top sample)))) + (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)))) ))] ["Real" number;Hash<Real> R;real &;r.triangle r.< r.<= r.> r.>=] @@ -53,7 +53,7 @@ ) (do-template [<desc> <hash> <gen> <trapezoid> <lt> <lte> <gt> <gte>] - [(test: (format "[" <desc> "] " "Trapezoids") + [(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)) @@ -70,40 +70,40 @@ (undefined)) trapezoid (<trapezoid> w x y z)]] ($_ seq - (assert "The middle values will always have maximum membership." - (and (d.= ~true (&;membership middle-bottom trapezoid)) - (d.= ~true (&;membership middle-top trapezoid)))) + (test "The middle values will always have maximum membership." + (and (d.= ~true (&;membership middle-bottom trapezoid)) + (d.= ~true (&;membership middle-top trapezoid)))) - (assert "Boundary values will always have 0 membership." - (and (d.= ~false (&;membership bottom trapezoid)) - (d.= ~false (&;membership top trapezoid)))) - - (assert "Values within inner range will have membership = 1" - (B/= (d.= ~true (&;membership sample trapezoid)) - (and (<gte> middle-bottom sample) - (<lte> middle-top sample)))) - - (assert "Values within range, will have membership > 0." - (B/= (d.> ~false (&;membership sample trapezoid)) - (and (<gt> bottom sample) - (<lt> top sample)))) - - (assert "Values outside of range, will have membership = 0." - (B/= (d.= ~false (&;membership sample trapezoid)) - (or (<lte> bottom sample) - (<gte> top sample)))) + (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)))) ))] ["Real" number;Hash<Real> R;real &;r.trapezoid r.< r.<= r.> r.>=] ["Deg" number;Hash<Deg> R;deg &;d.trapezoid d.< d.<= d.> d.>=] ) -(test: "Gaussian" +(context: "Gaussian" [deviation (|> R;real (R;filter (r.> 0.0))) center R;real #let [gaussian (&;gaussian deviation center)]] - (assert "The center value will always have maximum membership." - (d.= ~true (&;membership center gaussian)))) + (test "The center value will always have maximum membership." + (d.= ~true (&;membership center gaussian)))) (def: gen-triangle (R;Random (&;Fuzzy Real)) @@ -113,65 +113,65 @@ z R;real] (wrap (&;r.triangle x y z)))) -(test: "Combinators" +(context: "Combinators" [left gen-triangle right gen-triangle sample R;real] ($_ seq - (assert "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 "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)))) - (assert "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 "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)))) - (assert "Complement membership is the opposite of normal membership." - (d.= (&;membership sample left) - (~not (&;membership sample (&;complement left))))) - - (assert "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))))) + (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))))) )) -(test: "From predicates and sets" +(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 - (assert "Values that satisfy a predicate have membership = 1. + (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))) - (assert "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))) )) -(test: "Thresholds" +(context: "Thresholds" [fuzzy gen-triangle sample R;real threshold R;deg #let [vip-fuzzy (&;cut threshold fuzzy) member? (&;to-predicate threshold fuzzy)]] ($_ seq - (assert "Can increase the threshold of membership of a fuzzy set." - (B/= (d.> ~false (&;membership sample vip-fuzzy)) - (d.> threshold (&;membership sample fuzzy)))) + (test "Can increase the threshold of membership of a fuzzy set." + (B/= (d.> ~false (&;membership sample vip-fuzzy)) + (d.> threshold (&;membership sample fuzzy)))) - (assert "Can turn fuzzy sets into predicates through a threshold." - (B/= (member? sample) - (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/simple.lux b/stdlib/test/test/lux/math/simple.lux index 67d8bf8d0..1b35c4069 100644 --- a/stdlib/test/test/lux/math/simple.lux +++ b/stdlib/test/test/lux/math/simple.lux @@ -13,20 +13,20 @@ lux/test) (do-template [<category> <generator> <=> <+> <-> <*> </> <%> <0>] - [(test: (format <category> " arihtmetic") + [(context: (format <category> " arihtmetic") [x <generator> y (|> <generator> (R;filter (. not (<=> <0>))))] ($_ seq - (assert "Can add." - (<=> (<+> y x) (&;+ y x))) - (assert "Can subtract." - (<=> (<-> y x) (&;- y x))) - (assert "Can multiply." - (<=> (<*> y x) (&;* y x))) - (assert "Can divide." - (<=> (</> y x) (&;/ y x))) - (assert "Can get remainder." - (<=> (<%> y x) (&;% y x))) + (test "Can add." + (<=> (<+> y x) (&;+ y x))) + (test "Can subtract." + (<=> (<-> y x) (&;- y x))) + (test "Can multiply." + (<=> (<*> y x) (&;* y x))) + (test "Can divide." + (<=> (</> y x) (&;/ y x))) + (test "Can get remainder." + (<=> (<%> y x) (&;% y x))) ))] ["Nat" R;nat n.= n.+ n.- n.* n./ n.% +0] @@ -36,18 +36,18 @@ ) (do-template [<category> <generator> <lt> <lte> <gt> <gte>] - [(test: (format <category> " comparisons") + [(context: (format <category> " comparisons") [x <generator> y <generator>] ($_ seq - (assert "<" - (b/= (<lt> y x) (&;< y x))) - (assert "<=" - (b/= (<lte> y x) (&;<= y x))) - (assert ">" - (b/= (<gt> y x) (&;> y x))) - (assert ">=" - (b/= (<gte> y x) (&;>= y x))) + (test "<" + (b/= (<lt> y x) (&;< y x))) + (test "<=" + (b/= (<lte> y x) (&;<= y x))) + (test ">" + (b/= (<gt> y x) (&;> y x))) + (test ">=" + (b/= (<gte> y x) (&;>= y x))) ))] ["Nat" R;nat n.< n.<= n.> n.>=] @@ -57,14 +57,14 @@ ) (do-template [<category> <generator> <=> <min> <max>] - [(test: (format <category> " min & max") + [(context: (format <category> " min & max") [x <generator> y <generator>] ($_ seq - (assert "Min." - (<=> (<min> y x) (&;min y x))) - (assert "Max." - (<=> (<max> y x) (&;max y x))) + (test "Min." + (<=> (<min> y x) (&;min y x))) + (test "Max." + (<=> (<max> y x) (&;max y x))) ))] ["Nat" R;nat n.= n.min n.max] @@ -72,13 +72,13 @@ ) (do-template [<category> <generator> <=> <inc> <dec>] - [(test: (format <category> " inc & dec") + [(context: (format <category> " inc & dec") [x <generator>] ($_ seq - (assert "Inc." - (<=> (<inc> x) (&;inc x))) - (assert "Dec." - (<=> (<dec> x) (&;dec x))) + (test "Inc." + (<=> (<inc> x) (&;inc x))) + (test "Dec." + (<=> (<dec> x) (&;dec x))) ))] ["Nat" R;nat n.= n.inc n.dec] @@ -86,13 +86,13 @@ ) (do-template [<category> <generator> <even?> <odd?>] - [(test: (format <category> " even & odd") + [(context: (format <category> " even & odd") [x <generator>] ($_ seq - (assert "Even." - (b/= (<even?> x) (&;even? x))) - (assert "Odd." - (b/= (<odd?> x) (&;odd? x))) + (test "Even." + (b/= (<even?> x) (&;even? x))) + (test "Odd." + (b/= (<odd?> x) (&;odd? x))) ))] ["Nat" R;nat n.even? n.odd?] diff --git a/stdlib/test/test/lux/type.lux b/stdlib/test/test/lux/type.lux index 543484bb8..8adc9384e 100644 --- a/stdlib/test/test/lux/type.lux +++ b/stdlib/test/test/lux/type.lux @@ -44,41 +44,41 @@ ))))) ## [Tests] -(test: "Types" +(context: "Types" [sample gen-type] - (assert "Every type is equal to itself." - (:: &;Eq<Type> = sample sample))) - -(test: "Type application" - (assert "Can apply quantified types (universal and existential quantification)." - (and (default false - (do Monad<Maybe> - [partial (&;apply-type Meta Bool) - full (&;apply-type partial Int)] - (wrap (:: &;Eq<Type> = full (#;Product Bool Int))))) - (|> (&;apply-type Text Bool) - (case> #;None true _ false))))) - -(test: "Naming" + (test "Every type is equal to itself." + (:: &;Eq<Type> = sample sample))) + +(context: "Type application" + (test "Can apply quantified types (universal and existential quantification)." + (and (default false + (do Monad<Maybe> + [partial (&;apply-type Meta Bool) + full (&;apply-type partial Int)] + (wrap (:: &;Eq<Type> = full (#;Product Bool Int))))) + (|> (&;apply-type Text Bool) + (case> #;None true _ false))))) + +(context: "Naming" (let [base (#;Named ["" "a"] (#;Product Bool Int)) aliased (#;Named ["" "c"] (#;Named ["" "b"] base))] ($_ seq - (assert "Can remove aliases from an already-named type." - (:: &;Eq<Type> = - base - (&;un-alias aliased))) - - (assert "Can remove all names from a type." - (and (not (:: &;Eq<Type> = - base - (&;un-name aliased))) - (:: &;Eq<Type> = - (&;un-name base) - (&;un-name aliased))))))) - -(test: "Type construction [structs]" + (test "Can remove aliases from an already-named type." + (:: &;Eq<Type> = + base + (&;un-alias aliased))) + + (test "Can remove all names from a type." + (and (not (:: &;Eq<Type> = + base + (&;un-name aliased))) + (:: &;Eq<Type> = + (&;un-name base) + (&;un-name aliased))))))) + +(context: "Type construction [structs]" [size (|> R;nat (:: @ map (n.% +3))) members (|> gen-type (R;filter (function [type] @@ -94,11 +94,11 @@ (^open "L/") (list;Eq<List> &;Eq<Type>)]] (with-expansions [<struct-tests> (do-template [<desc> <ctor> <dtor> <unit>] - [(assert (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)))))] + [(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] @@ -107,7 +107,7 @@ <struct-tests> ))) -(test: "Type construction [parameterized]" +(context: "Type construction [parameterized]" [size (|> R;nat (:: @ map (n.% +3))) members (seqM @ (list;repeat size gen-type)) extra (|> gen-type @@ -121,17 +121,17 @@ #let [(^open "&/") &;Eq<Type> (^open "L/") (list;Eq<List> &;Eq<Type>)]] ($_ seq - (assert "Can build and tear-down function types." - (let [[inputs output] (|> (&;function members extra) &;flatten-function)] - (and (L/= members inputs) - (&/= extra output)))) - - (assert "Can build and tear-down application types." - (let [[tfunc tparams] (|> members (&;application extra) &;flatten-application)] - (n.= (list;size members) (list;size tparams)))) + (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] (|> members (&;application extra) &;flatten-application)] + (n.= (list;size members) (list;size tparams)))) )) -(test: "Type construction [higher order]" +(context: "Type construction [higher order]" [size (|> R;nat (:: @ map (n.% +3))) extra (|> gen-type (R;filter (function [type] @@ -144,10 +144,10 @@ #let [(^open "&/") &;Eq<Type>]] (with-expansions [<quant-tests> (do-template [<desc> <ctor> <dtor>] - [(assert (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))))] + [(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] diff --git a/stdlib/test/test/lux/type/auto.lux b/stdlib/test/test/lux/type/auto.lux index c7e321240..95185671c 100644 --- a/stdlib/test/test/lux/type/auto.lux +++ b/stdlib/test/test/lux/type/auto.lux @@ -15,25 +15,25 @@ type/auto) lux/test) -(test: "Automatic structure selection" +(context: "Automatic structure selection" [x R;nat y R;nat] ($_ seq - (assert "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 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))) + ))) - (assert "Can automatically select second-order structures." - (::: = - (list;n.range +1 +10) - (list;n.range +1 +10))) + (test "Can automatically select second-order structures." + (::: = + (list;n.range +1 +10) + (list;n.range +1 +10))) - (assert "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/type/check.lux b/stdlib/test/test/lux/type/check.lux index 8cc8c88d7..1c4767a15 100644 --- a/stdlib/test/test/lux/type/check.lux +++ b/stdlib/test/test/lux/type/check.lux @@ -73,104 +73,104 @@ false)) ## [Tests] -(test: "Top and Bottom" +(context: "Top and Bottom" [sample (|> gen-type (R;filter valid-type?))] ($_ seq - (assert "Top is the super-type of everything." - (&;checks? Top sample)) + (test "Top is the super-type of everything." + (&;checks? Top sample)) - (assert "Bottom is the sub-type of everything." - (&;checks? sample Bottom)) + (test "Bottom is the sub-type of everything." + (&;checks? sample Bottom)) )) -(test: "Simple type-checking." +(context: "Simple type-checking." ($_ seq - (assert "Unit and Void match themselves." - (and (&;checks? Void Void) - (&;checks? Unit Unit))) - - (assert "Existential types only match with themselves." - (and (type-checks? (do &;Monad<Check> - [[id ex] &;existential] - (&;check ex ex))) - (not (type-checks? (do &;Monad<Check> - [[lid lex] &;existential - [rid rex] &;existential] - (&;check lex rex)))))) - - (assert "Names don't affect type-checking." - (and (type-checks? (do &;Monad<Check> - [[id ex] &;existential] - (&;check (#;Named ["module" "name"] ex) - ex))) - (type-checks? (do &;Monad<Check> - [[id ex] &;existential] - (&;check ex - (#;Named ["module" "name"] ex)))) - (type-checks? (do &;Monad<Check> - [[id ex] &;existential] - (&;check (#;Named ["module" "name"] ex) - (#;Named ["module" "name"] ex)))))) - - (assert "Can type-check functions." - (and (&;checks? (#;Function Bottom Top) - (#;Function Top Bottom)) - (not (&;checks? (#;Function Top Bottom) - (#;Function Bottom Top))))) + (test "Unit and Void match themselves." + (and (&;checks? Void Void) + (&;checks? Unit Unit))) + + (test "Existential types only match with themselves." + (and (type-checks? (do &;Monad<Check> + [[id ex] &;existential] + (&;check ex ex))) + (not (type-checks? (do &;Monad<Check> + [[lid lex] &;existential + [rid rex] &;existential] + (&;check lex rex)))))) + + (test "Names don't affect type-checking." + (and (type-checks? (do &;Monad<Check> + [[id ex] &;existential] + (&;check (#;Named ["module" "name"] ex) + ex))) + (type-checks? (do &;Monad<Check> + [[id ex] &;existential] + (&;check ex + (#;Named ["module" "name"] ex)))) + (type-checks? (do &;Monad<Check> + [[id ex] &;existential] + (&;check (#;Named ["module" "name"] ex) + (#;Named ["module" "name"] ex)))))) + + (test "Can type-check functions." + (and (&;checks? (#;Function Bottom Top) + (#;Function Top Bottom)) + (not (&;checks? (#;Function Top Bottom) + (#;Function Bottom Top))))) )) -(test: "Type application" +(context: "Type application" [meta gen-type data gen-type] - (assert "Can type-check type application." - (and (&;checks? (#;App (#;App Meta meta) data) - (type;tuple (list meta data))) - (&;checks? (type;tuple (list meta data)) - (#;App (#;App Meta meta) data))))) + (test "Can type-check type application." + (and (&;checks? (#;App (#;App Meta meta) data) + (type;tuple (list meta data))) + (&;checks? (type;tuple (list meta data)) + (#;App (#;App Meta meta) data))))) -(test: "Host types" +(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 - (assert "Host types match when they have the same name and the same parameters." - (&;checks? (#;Host nameL (list paramL)) - (#;Host nameL (list paramL)))) + (test "Host types match when they have the same name and the same parameters." + (&;checks? (#;Host nameL (list paramL)) + (#;Host nameL (list paramL)))) - (assert "Names matter to host types." - (not (&;checks? (#;Host nameL (list paramL)) - (#;Host nameR (list paramL))))) + (test "Names matter to host types." + (not (&;checks? (#;Host nameL (list paramL)) + (#;Host nameR (list paramL))))) - (assert "Parameters matter to host types." - (not (&;checks? (#;Host nameL (list paramL)) - (#;Host nameL (list paramR))))) + (test "Parameters matter to host types." + (not (&;checks? (#;Host nameL (list paramL)) + (#;Host nameL (list paramR))))) )) -(test: "Type-vars" +(context: "Type-vars" ($_ seq - (assert "Type-vars check against themselves." - (type-checks? (&;with-var (function [[id var]] (&;check var var))))) - - (assert "Can bind unbound type-vars by type-checking against them." - (and (type-checks? (&;with-var (function [[id var]] (&;check var #;Unit)))) - (type-checks? (&;with-var (function [[id var]] (&;check #;Unit var)))))) - - (assert "Can't rebind already bound type-vars." - (not (type-checks? (&;with-var (function [[id var]] - (do &;Monad<Check> - [_ (&;check var #;Unit)] - (&;check var #;Void))))))) - - (assert "If the type bound to a var is a super-type to another, then the var is also a super-type." - (type-checks? (&;with-var (function [[id var]] - (do &;Monad<Check> - [_ (&;check var Top)] - (&;check var #;Unit)))))) - - (assert "If the type bound to a var is a sub-type of another, then the var is also a sub-type." - (type-checks? (&;with-var (function [[id var]] - (do &;Monad<Check> - [_ (&;check var Bottom)] - (&;check #;Unit var)))))) + (test "Type-vars check against themselves." + (type-checks? (&;with-var (function [[id var]] (&;check var var))))) + + (test "Can bind unbound type-vars by type-checking against them." + (and (type-checks? (&;with-var (function [[id var]] (&;check var #;Unit)))) + (type-checks? (&;with-var (function [[id var]] (&;check #;Unit var)))))) + + (test "Can't rebind already bound type-vars." + (not (type-checks? (&;with-var (function [[id var]] + (do &;Monad<Check> + [_ (&;check var #;Unit)] + (&;check var #;Void))))))) + + (test "If the type bound to a var is a super-type to another, then the var is also a super-type." + (type-checks? (&;with-var (function [[id var]] + (do &;Monad<Check> + [_ (&;check var Top)] + (&;check var #;Unit)))))) + + (test "If the type bound to a var is a sub-type of another, then the var is also a sub-type." + (type-checks? (&;with-var (function [[id var]] + (do &;Monad<Check> + [_ (&;check var Bottom)] + (&;check #;Unit var)))))) )) |