diff options
Diffstat (limited to '')
42 files changed, 3327 insertions, 0 deletions
diff --git a/stdlib/test/test/lux.lux b/stdlib/test/test/lux.lux new file mode 100644 index 000000000..947ec5b6f --- /dev/null +++ b/stdlib/test/test/lux.lux @@ -0,0 +1,164 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + lux/test + (lux (control monad) + (codata [io]) + [math] + (math ["R" random]) + (data text/format) + [compiler] + (macro ["s" syntax #+ syntax:]))) + +(test: "Every value is identical to itself, and the 'id' function doesn't change values in any way." + [value R;int] + (assert "" (and (== value value) + (== value (id value))))) + +(test: "Values created separately can't be identical." + [x R;int + y R;int] + (match false (== 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.") + [value rand-gen] + (assert "" (and (|> value inc dec (= value)) + (|> value dec inc (= value))))) + + (test: (format "[" category "] " "(x+1) > x && (x-1) < x") + [value rand-gen] + (assert "" (and (|> value inc (> value)) + (|> value dec (< value))))) + + (test: (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?)))))] + + ["Nat" R;nat inc+ dec+ even?+ odd?+ =+ <+ >+] + ["Int" R;int inc dec even? odd? = < >] + ) + +(do-template [category rand-gen = < > <= >= min max] + [(test: (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: (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))) + )))] + + ["Int" R;int = < > <= >= min max] + ["Nat" R;nat =+ <+ >+ <=+ >=+ min+ max+] + ["Real" R;real =. <. >. <=. >=. min. max.] + ["Frac" R;frac =.. <.. >.. <=.. >=.. min.. max..] + ) + +(do-template [category rand-gen = + - * / <%> > <0> <1> <10> %x <cap> <prep>] + [(test: (format "[" category "] " "Additive identity") + [x rand-gen] + (assert "" + (and (|> x (+ <0>) (= x)) + (|> x (- <0>) (= x))))) + + (test: (format "[" category "] " "Addition & Substraction") + [x (:: @ map <prep> rand-gen) + y (:: @ map <prep> rand-gen) + #let [x (* <10> x) + y (* <10> y) + cond (and (|> x (- y) (+ y) (= x)) + (|> x (+ y) (- y) (= x))) + _ (if cond + [] + (exec + (log! "+- SAMPLE") + (log! (format (%x x) " -+ " (%x y) " = " (%x (|> x (- y) (+ y))))) + (log! (format (%x x) " +- " (%x y) " = " (%x (|> x (+ y) (- y))))))) + ]] + (assert "" + (and (|> x (- y) (+ y) (= x)) + (|> x (+ y) (- y) (= x))))) + + (test: (format "[" category "] " "Multiplicative identity") + [x rand-gen] + (assert "" + (and (|> x (* <1>) (= x)) + (|> x (/ <1>) (= x))))) + + (test: (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 "" + (or (> x' y) + (|> x' (/ y) (* y) (= x'))) + ))] + + ["Nat" R;nat =+ ++ -+ *+ /+ ;%+ >+ +0 +1 +1000000 %n (;%+ +1000) id] + ["Int" R;int = + - * / ;% > 0 1 1000000 %i (;% 1000) id] + ["Real" R;real =. +. -. *. /. ;%. >. 0.0 1.0 1000000.0 %r id math;floor] + ) + +(do-template [category rand-gen -> <- = <cap> %a %z] + [(test: (format "[" category "] " "Numeric conversions") + [value rand-gen + #let [value (<cap> value)]] + (assert "" + (|> value -> <- (= value))))] + + ["Int->Nat" R;int int-to-nat nat-to-int = (;% 1000000) %i %n] + ["Nat->Int" R;nat nat-to-int int-to-nat =+ (;%+ +1000000) %n %i] + ["Int->Real" R;int int-to-real real-to-int = (;% 1000000) %i %r] + ["Real->Int" R;real real-to-int int-to-real =. math;floor %r %i] + ## [R;real real-to-frac frac-to-real =. (;%. 1.0) %r %f] + ) + +(test: "Simple macros and constructs" + (all (match ["lux" "yolo"] (ident-for ;yolo)) + (match ["test/lux" "yolo"] (ident-for ;;yolo)) + (match ["" "yolo"] (ident-for yolo)) + (match ["lux/test" "yolo"] (ident-for lux/test;yolo)) + (match ["lux" "yolo"] (ident-for #;yolo)) + (match ["test/lux" "yolo"] (ident-for #;;yolo)) + (match ["" "yolo"] (ident-for #yolo)) + (match ["lux/test" "yolo"] (ident-for #lux/test;yolo)) + + (match 1000 (loop [counter 0 + value 1] + (if (< 3 counter) + (recur (inc counter) (* 10 value)) + value))) + + (match (^ (list 1 2 3)) + (list 1 2 3)) + (match (^ (list 1 2 3 4 5 6)) + (list& 1 2 3 (list 4 5 6))) + + (match "yolo" (default "yolo" + #;None)) + (match "lol" (default "yolo" + (#;Some "lol"))) + )) diff --git a/stdlib/test/test/lux/cli.lux b/stdlib/test/test/lux/cli.lux new file mode 100644 index 000000000..c95ec9e9c --- /dev/null +++ b/stdlib/test/test/lux/cli.lux @@ -0,0 +1,84 @@ +(;module: + [lux #- not] + (lux (codata [io]) + (control monad) + (data text/format + [number] + [product] + [sum]) + (codata function) + [cli #- run]) + [lux/test #- assert]) + +(test: "lux/cli exports" + (test-all (match (#;Right "foo") + (cli;run any (list "foo" "bar" "baz"))) + (match (#;Left _) + (cli;run any (list))) + (match (#;Right 123) + (cli;run (parse (:: number;Codec<Text,Int> decode) any) (list "123"))) + (match (#;Left _) + (cli;run (option (list "-p" "--port")) (list))) + (match (#;Left _) + (cli;run (option (list "-p" "--port")) (list "yolo"))) + (match (#;Right "123") + (cli;run (option (list "-p" "--port")) (list "-p" "123"))) + (match (#;Right "123") + (cli;run (option (list "-p" "--port")) (list "--port" "123"))) + (match (#;Right false) + (cli;run (flag (list "-h" "--help")) (list))) + (match (#;Right false) + (cli;run (flag (list "-h" "--help")) (list "yolo"))) + (match (#;Right true) + (cli;run (flag (list "-h" "--help")) (list "-h"))) + (match (#;Right true) + (cli;run (flag (list "-h" "--help")) (list "--help"))) + (match (#;Right []) + (cli;run end (list))) + (match (#;Left _) + (cli;run end (list "yolo"))) + (match (#;Left "YOLO") + (cli;run (assert false "YOLO") (list "yolo"))) + (match (#;Right []) + (cli;run (assert true "YOLO") (list "yolo"))) + (match (#;Right #;None) + (cli;run (opt any) (list))) + (match (#;Right (#;Some "yolo")) + (cli;run (opt any) (list "yolo"))) + (match (#;Right ["foo" "bar"]) + (cli;run (seq any any) (list "foo" "bar" "baz"))) + (match (#;Right ["foo" "bar"]) + (cli;run (seq any any) (list "foo" "bar"))) + (match (#;Left _) + (cli;run (seq any any) (list "foo"))) + ## (match (#;Right (#;Left 123)) + ## (cli;run (alt (parse (:: number;Codec<Text,Int> decode) any) + ## any) + ## (list "123" "foo"))) + ## (match (#;Right (#;Right "foo")) + ## (cli;run (alt (parse (:: number;Codec<Text,Int> decode) any) + ## any) + ## (list "foo"))) + (match (#;Left _) + (cli;run (alt (parse (:: number;Codec<Text,Int> decode) any) + (parse (:: number;Codec<Text,Real> decode) any)) + (list "foo"))) + (match (#;Left _) + (cli;run (not (parse (:: number;Codec<Text,Int> decode) any)) + (list "123"))) + (match (#;Right []) + (cli;run (not (parse (:: number;Codec<Text,Int> decode) any)) + (list "yolo"))) + (match (^ (#;Right (list "foo" "bar" "baz"))) + (cli;run (some any) (list "foo" "bar" "baz"))) + (match (^ (#;Right (list))) + (cli;run (some any) (list))) + (match (^ (#;Right (list "foo" "bar" "baz"))) + (cli;run (many any) (list "foo" "bar" "baz"))) + (match (#;Left _) + (cli;run (many any) (list))) + (match (#;Right "yolo") + (cli;run (either (parse sum;right any) + any) + (list "yolo"))) + )) diff --git a/stdlib/test/test/lux/codata/env.lux b/stdlib/test/test/lux/codata/env.lux new file mode 100644 index 000000000..7a374cd4d --- /dev/null +++ b/stdlib/test/test/lux/codata/env.lux @@ -0,0 +1,23 @@ +(;module: + lux + (lux (codata [io]) + (control monad) + (data [text "Text/" Monoid<Text>] + text/format + [number]) + (codata function + env)) + lux/test) + +(test: "lux/codata/env exports" + (test-all (match 123 (run 123 ask)) + (match 246 (run 123 (local (* 2) ask))) + (match 134 (run 123 (:: Functor<Env> map inc (+ 10)))) + (match 10 (run 123 (:: Applicative<Env> wrap 10))) + (match 30 (run 123 (let [(^open) Applicative<Env>] + (apply (wrap (+ 10)) (wrap 20))))) + (match 30 (run 123 (do Monad<Env> + [f (wrap +) + x (wrap 10) + y (wrap 20)] + (wrap (f x y))))))) diff --git a/stdlib/test/test/lux/codata/io.lux b/stdlib/test/test/lux/codata/io.lux new file mode 100644 index 000000000..5d521faff --- /dev/null +++ b/stdlib/test/test/lux/codata/io.lux @@ -0,0 +1,21 @@ +(;module: + lux + (lux (control monad) + (data [text "Text/" Monoid<Text>] + text/format + [number]) + (codata function + io)) + lux/test) + +(test: "lux/codata/io exports" + (test-all (match "YOLO" (run (io "YOLO"))) + (match 11 (run (:: Functor<IO> map inc (io 10)))) + (match 10 (run (:: Applicative<IO> wrap 10))) + (match 30 (run (let [(^open) Applicative<IO>] + (apply (wrap (+ 10)) (wrap 20))))) + (match 30 (run (do Monad<IO> + [f (wrap +) + x (wrap 10) + y (wrap 20)] + (wrap (f x y))))))) diff --git a/stdlib/test/test/lux/codata/state.lux b/stdlib/test/test/lux/codata/state.lux new file mode 100644 index 000000000..054b59d45 --- /dev/null +++ b/stdlib/test/test/lux/codata/state.lux @@ -0,0 +1,34 @@ +(;module: + lux + (lux (codata [io]) + (control monad) + (data [text "Text/" Monoid<Text>] + text/format + [number] + [product]) + (codata function + state)) + lux/test) + +(test: "lux/codata/state exports" + (test-all (match 123 (product;right (run 123 get))) + (match 321 (product;right (run 123 (do Monad<State> + [_ (put 321)] + get)))) + (match 369 (product;right (run 123 (do Monad<State> + [_ (update (* 3))] + get)))) + (match 124 (product;right (run 123 (use inc)))) + (match 246 (product;right (run 123 (local (* 2) get)))) + (match 124 (product;right (run 123 (:: Functor<State> map inc get)))) + (match 10 (product;right (run 123 (:: Applicative<State> wrap 10)))) + (match 30 (product;right (run 123 (let [(^open) Applicative<State>] + (apply (wrap (+ 10)) (wrap 20)))))) + (match 30 (product;right (run 123 (: (State Int Int) + (do Monad<State> + [f (wrap +) + x (wrap 10) + y (wrap 20)] + + (wrap (f x y))))))) + )) diff --git a/stdlib/test/test/lux/codata/struct/stream.lux b/stdlib/test/test/lux/codata/struct/stream.lux new file mode 100644 index 000000000..28292a405 --- /dev/null +++ b/stdlib/test/test/lux/codata/struct/stream.lux @@ -0,0 +1,68 @@ +(;module: + lux + (lux (codata [io]) + (control monad + comonad) + (data [text "Text/" Monoid<Text>] + text/format + [number "Int/" Codec<Text,Int>]) + (codata function + [cont] + (struct stream))) + lux/test) + +(test: "lux/codata/stream exports" + (let% [<take+drop+split> (do-template [<take> <drop> <split> <arg>] + [(match (^ (list 0 1 2)) + (<take> <arg> (iterate inc 0))) + (match (^=> (^stream& w x y z ...) + {[w x y z] [3 4 5 6]}) + (<drop> <arg> (iterate inc 0))) + (match (^=> (^ [(list 0 1 2) _stream_]) + {_stream_ (^stream& w x y z ...)} + {[w x y z] [3 4 5 6]}) + (<split> <arg> (iterate inc 0)))] + + [take drop split +3] + [take-while drop-while split-with (< 3)]) + ] + (test-all (match (^=> (^stream& w x y z ...) + {[w x y z] [0 1 2 3]}) + (iterate inc 0)) + (match (^=> (^stream& w x y z ...) + {[w x y z] [0 0 0 0]}) + (repeat 0)) + (match (^=> (#;Some the-stream) + {the-stream (^stream& w x y z ...)} + {[w x y z] [0 1 0 1]}) + (cycle (list 0 1))) + (match 0 (head (iterate inc 0))) + (match (^=> (^stream& w x y z ...) + {[w x y z] [1 2 3 4]}) + (tail (iterate inc 0))) + (match 9 (at +9 (iterate inc 0))) + (match 0 (at +0 (iterate inc 0))) + <take+drop+split> + (match (^=> (^stream& w x y z ...) + {[w x y z] ["0" "1" "2" "3"]}) + (unfold (lambda [n] [(inc n) (Int/encode n)]) + 0)) + (match (^=> (^stream& w x y z ...) + {[w x y z] [0 2 4 6]}) + (filter even? (iterate inc 0))) + (match (^=> [e_stream o_stream] + {e_stream (^stream& w x y z ...)} + {o_stream (^stream& a b c d ...)} + {[w x y z a b c d] [0 2 4 6 1 3 5 7]}) + (partition even? (iterate inc 0))) + (match (^=> (^stream& w x y z ...) + {[w x y z] [0 1 4 9]}) + (let [square (lambda [n] (* n n))] + (:: Functor<Stream> map square (iterate inc 0)))) + (match (^=> (^stream& w x y z ...) + {[w x y z] [4 9 16 25]}) + (let [square (lambda [n] (* n n))] + (be CoMonad<Stream> + [inputs (iterate inc 2)] + (square (head inputs))))) + ))) diff --git a/stdlib/test/test/lux/concurrency/actor.lux b/stdlib/test/test/lux/concurrency/actor.lux new file mode 100644 index 000000000..e9a19e8ea --- /dev/null +++ b/stdlib/test/test/lux/concurrency/actor.lux @@ -0,0 +1,70 @@ +(;module: + lux + (lux (control monad) + (data [number] + text/format + error) + (concurrency [promise #+ Promise Monad<Promise> "Promise/" Monad<Promise>] + actor) + (codata function + [io #- run])) + lux/test) + +(actor: Adder + Int + + (method: (add! {offset Int}) + [Int Int] + (let [*state*' (+ offset *state*)] + (wrap (#;Right [*state*' [*state* *state*']])))) + + (stop: + (exec (log! (format "Cause of death: " (default "???" *cause*))) + (log! (format "Current state: " (%i *state*))) + (wrap [])))) + +(test: "lux/concurrency/actor exports" + (let [counter-proc (: (Proc Int (Promise Int)) + [(lambda [self output state] + (let [state' (inc state)] + (exec (io;run (promise;resolve state' output)) + (Promise/wrap (#;Right state'))))) + (lambda [?error state] (Promise/wrap []))])] + (test-all (match true + (let [counter (: (Actor Int (Promise Int)) + (io;run (spawn 0 counter-proc)))] + (alive? counter))) + (match [true false] + (let [counter (: (Actor Int (Promise Int)) + (io;run (spawn 0 counter-proc)))] + [(io;run (poison counter)) + (alive? counter)])) + (match [true false] + (let [counter (: (Actor Int (Promise Int)) + (io;run (spawn 0 counter-proc)))] + [(io;run (poison counter)) + (io;run (poison counter))])) + (match+ [1 2 3] + (do Monad<Promise> + [#let [counter (: (Actor Int (Promise Int)) + (io;run (spawn 0 counter-proc))) + output-1 (: (Promise Int) (promise;promise)) + output-2 (: (Promise Int) (promise;promise)) + output-3 (: (Promise Int) (promise;promise))] + ?1 (send output-1 counter) + ?2 (send output-2 counter) + ?3 (send output-3 counter)] + (if (and ?1 ?2 ?3) + (from-promise ($_ promise;seq output-1 output-2 output-3)) + (wrap (#;Left "Uh, oh..."))))) + (match+ [[0 1] [1 3] [3 6]] + (do Monad<Promise> + [#let [adder (: Adder + (io;run (spawn 0 Adder//new)))] + t1 (add! 1 adder) + t2 (add! 2 adder) + t3 (add! 3 adder) + #let [? (io;run (poison adder))]] + (wrap (#;Right [t1 t2 t3])) + )) + ))) diff --git a/stdlib/test/test/lux/concurrency/frp.lux b/stdlib/test/test/lux/concurrency/frp.lux new file mode 100644 index 000000000..62ca0b57d --- /dev/null +++ b/stdlib/test/test/lux/concurrency/frp.lux @@ -0,0 +1,54 @@ +(;module: + lux + (lux (control monad) + (data [number] + text/format + error) + (concurrency [promise #+ Promise Monad<Promise> "Promise/" Monad<Promise>] + frp) + (codata function + io)) + lux/test) + +(def: (List->Chan values) + (-> (List Int) (Chan Int)) + (let [_chan (: (Chan Int) (chan))] + (run (do Monad<IO> + [_ (mapM Monad<IO> + (lambda [value] + (write value _chan)) + values) + _ (close _chan)] + (wrap _chan))))) + +(test: "lux/concurrency/frp exports" + (test-all (match+ (^ (list 0 1 2 3 4 5)) + (from-promise (consume (List->Chan (list 0 1 2 3 4 5))))) + (match+ (^ (list 0 1 2 3 4 5)) + (from-promise (consume (let [input (List->Chan (list 0 1 2 3 4 5)) + output (: (Chan Int) (chan))] + (exec (pipe input output) + output))))) + (match+ (^ (list 0 2 4)) + (from-promise (consume (filter even? (List->Chan (list 0 1 2 3 4 5)))))) + (match+ (^ (list 0 1 2 3 4 5 0 -1 -2 -3 -4 -5)) + (from-promise (consume (merge (list (List->Chan (list 0 1 2 3 4 5)) + (List->Chan (list 0 -1 -2 -3 -4 -5))))))) + (match+ 15 (from-promise (fold (lambda [base input] (Promise/wrap (+ input base))) 0 (List->Chan (list 0 1 2 3 4 5))))) + (match+ (^ (list 0 1 2 3 4 5)) + (from-promise (consume (no-dups number;Eq<Int> (List->Chan (list 0 0 0 1 2 2 3 3 3 3 4 4 4 5 5)))))) + (match+ (^ (list 12345)) + (from-promise (consume (as-chan (:: promise;Monad<Promise> wrap 12345))))) + (match+ (^ (list 1 2 3 4 5 6)) + (from-promise (consume (:: Functor<Chan> map inc (List->Chan (list 0 1 2 3 4 5)))))) + (match+ (^ (list 12345)) + (from-promise (consume (:: Applicative<Chan> wrap 12345)))) + (match+ (^ (list 12346)) + (from-promise (consume (let [(^open) Applicative<Chan>] + (apply (wrap inc) (wrap 12345)))))) + (match+ (^ (list 12346)) + (from-promise (consume (do Monad<Chan> + [f (wrap inc) + a (wrap 12345)] + (wrap (f a)))))) + )) diff --git a/stdlib/test/test/lux/concurrency/promise.lux b/stdlib/test/test/lux/concurrency/promise.lux new file mode 100644 index 000000000..77e5a0aed --- /dev/null +++ b/stdlib/test/test/lux/concurrency/promise.lux @@ -0,0 +1,31 @@ +(;module: + lux + (lux (control monad) + (data [number] + text/format + error) + (concurrency promise) + (codata function + [io #*])) + lux/test) + +(test: "lux/concurrency/promise exports" + (test-all (match+ true (from-promise (future (io true)))) + (match+ [] (from-promise (wait +500))) + (match+ [true false] (from-promise (seq (future (io true)) + (future (io false))))) + (match+ (#;Left true) (from-promise (alt (delay +100 true) + (delay +200 false)))) + (match+ (#;Right false) (from-promise (alt (delay +200 true) + (delay +100 false)))) + (match+ true (from-promise (either (delay +100 true) + (delay +200 false)))) + (match+ false (from-promise (either (delay +200 true) + (delay +100 false)))) + (match (#;Some true) (poll (:: Monad<Promise> wrap true))) + (match #;None (poll (delay +200 true))) + (match false (io;run (resolve false (:: Monad<Promise> wrap true)))) + (match true (io;run (resolve true (: (Promise Bool) (promise))))) + (match+ #;None (from-promise (time-out +100 (delay +200 true)))) + (match+ (#;Some true) (from-promise (time-out +200 (delay +100 true)))) + )) diff --git a/stdlib/test/test/lux/concurrency/stm.lux b/stdlib/test/test/lux/concurrency/stm.lux new file mode 100644 index 000000000..e29a5294b --- /dev/null +++ b/stdlib/test/test/lux/concurrency/stm.lux @@ -0,0 +1,57 @@ +(;module: + lux + (lux (codata [io]) + (control monad) + (data [number] + (struct [list "" Functor<List>]) + text/format) + (concurrency stm + [promise]) + (codata function)) + lux/test) + +(def: vars Int 5) +(def: processes/vars Int 5) +(def: iterations/processes Int 100) + +(test: "lux/concurrency/stm exports" + (let [_var (var 0) + changes (io;run (follow "test" _var)) + tests (: (List (Test Int)) + (map (lambda [_] + (let [_concurrency-var (var 0)] + (from-promise (do promise;Monad<Promise> + [_ (seqM @ + (map (lambda [_] + (mapM @ (lambda [_] (commit (update inc _concurrency-var))) + (list;range 1 iterations/processes))) + (list;range 1 processes/vars)))] + (commit (read _concurrency-var)))))) + (list;range 1 vars)))] + (test-all (match+ 0 (commit (do Monad<STM> + [value (read _var)] + (wrap (#;Right value))))) + (match+ 5 (commit (do Monad<STM> + [_ (write 5 _var) + value (read _var)] + (wrap (#;Right value))))) + (match+ 5 (commit (do Monad<STM> + [value (read _var)] + (wrap (#;Right value))))) + (match+ 15 (commit (do Monad<STM> + [_ (update (* 3) _var) + value (read _var)] + (wrap (#;Right value))))) + (match+ 15 (commit (do Monad<STM> + [value (read _var)] + (wrap (#;Right value))))) + (match+ [5 15] (do promise;Monad<Promise> + [?c1+changes' changes + #let [[c1 changes'] (default [-1 changes] ?c1+changes')] + ?c2+changes' changes' + #let [[c2 changes'] (default [-1 changes] ?c2+changes')]] + (wrap (#;Right [c1 c2])))) + ## Temporarily commented-out due to type-checking bug in + ## compiler... + ## (match+ _ (seqM Monad<Test> tests)) + ))) diff --git a/stdlib/test/test/lux/data/bit.lux b/stdlib/test/test/lux/data/bit.lux new file mode 100644 index 000000000..e20027818 --- /dev/null +++ b/stdlib/test/test/lux/data/bit.lux @@ -0,0 +1,65 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (control [monad]) + (codata [io]) + (data ["&" bit] + number) + (math ["R" random])) + lux/test) + +(def: width Nat +64) + +(test: "Bitwise operations." + [pattern R;nat + idx (:: @ map (%+ width) R;nat)] + (all (assert "" (and (<+ (&;count (&;set idx pattern)) + (&;count (&;clear idx pattern))) + (<=+ (&;count pattern) + (&;count (&;clear idx pattern))) + (>=+ (&;count pattern) + (&;count (&;set idx pattern))) + + (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)))) + + (=+ width + (++ (&;count pattern) + (&;count (&;~ pattern)))) + + (=+ +0 + (&;& pattern + (&;~ pattern))) + (=+ (&;~ +0) + (&;| pattern + (&;~ pattern))) + (=+ (&;~ +0) + (&;^ pattern + (&;~ pattern))) + (=+ +0 + (&;^ pattern + pattern)) + + (|> pattern (&;rotate-left idx) (&;rotate-right idx) (=+ pattern)) + (|> pattern (&;rotate-right idx) (&;rotate-left idx) (=+ pattern)) + (|> pattern (&;rotate-left idx) (&;rotate-left (-+ idx width)) (=+ pattern)) + (|> pattern (&;rotate-right idx) (&;rotate-right (-+ idx width)) (=+ pattern)) + )) + + (assert "Shift right respect the sign of ints." + (let [value (nat-to-int pattern)] + (if (< 0 value) + (< 0 (&;>> idx value)) + (>= 0 (&;>> idx value))))) + )) diff --git a/stdlib/test/test/lux/data/bool.lux b/stdlib/test/test/lux/data/bool.lux new file mode 100644 index 000000000..218846e2e --- /dev/null +++ b/stdlib/test/test/lux/data/bool.lux @@ -0,0 +1,38 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (control [monad]) + (codata [io]) + (data bool) + (math ["R" random])) + lux/test) + +(test: "Boolean operations." + [value R;bool] + (assert "" (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 (:: 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) + + (#;Left _) + false) + ))) diff --git a/stdlib/test/test/lux/data/char.lux b/stdlib/test/test/lux/data/char.lux new file mode 100644 index 000000000..ab2e84d59 --- /dev/null +++ b/stdlib/test/test/lux/data/char.lux @@ -0,0 +1,47 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (control [monad]) + (codata [io]) + (data char + [text]) + (math ["R" random]) + pipe + [host #- try]) + lux/test) + +(test: "Char operations" + [value R;char] + (assert "" (and (:: Eq<Char> = value value) + (|> value code char (:: Eq<Char> = value)) + (|> value + (:: Codec<Text,Char> encode) + (:: Codec<Text,Char> decode) + (case> (#;Right dec-value) + (:: Eq<Char> = value dec-value) + + (#;Left _) + false)) + (|> value as-text + (text;at +0) (default (undefined)) + (:: Eq<Char> = value)) + (|> value as-text text;upper-case + (text;at +0) (default (undefined)) + (:: Ord<Char> <= value)) + (|> value as-text text;lower-case + (text;at +0) (default (undefined)) + (:: Ord<Char> >= value)) + ))) + +(test: "Special cases" + (all (assert "" (space? #" ")) + (assert "" (space? #"\n")) + (assert "" (space? #"\t")) + (assert "" (space? #"\r")) + (assert "" (space? #"\f")) + (assert "" (not (space? #"a"))) + )) diff --git a/stdlib/test/test/lux/data/error.lux b/stdlib/test/test/lux/data/error.lux new file mode 100644 index 000000000..a1d2cb6ff --- /dev/null +++ b/stdlib/test/test/lux/data/error.lux @@ -0,0 +1,42 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad) + (data error)) + lux/test) + +(test: "lux/data/error exports" + (all (match (#;Right 11) + (:: Functor<Error> map inc (: (Error Int) + (#;Right 10)))) + (match (#;Left "YOLO") + (:: Functor<Error> map inc (: (Error Int) + (#;Left "YOLO")))) + + (match (#;Right 20) + (:: Applicative<Error> wrap 20)) + (match (#;Right 11) + (let [(^open) Applicative<Error>] + (apply (wrap inc) (wrap 10)))) + (match (#;Left "YOLO") + (let [(^open) Applicative<Error>] + (apply (wrap inc) (#;Left "YOLO")))) + + (match (#;Right 30) + (do Monad<Error> + [f (wrap +) + a (wrap 10) + b (wrap 20)] + (wrap (f a b)))) + (match (#;Left "YOLO") + (do Monad<Error> + [f (wrap +) + a (#;Left "YOLO") + b (wrap 20)] + (wrap (f a b)))) + )) diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux new file mode 100644 index 000000000..78b0b1a76 --- /dev/null +++ b/stdlib/test/test/lux/data/format/json.lux @@ -0,0 +1,314 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad) + (data [text "Text/" Monoid<Text>] + text/format + error + (format [json #* "JSON/" Eq<JSON> Codec<Text,JSON>]) + (struct [vector #+ vector] + [dict])) + [compiler #+ with-gensyms] + (macro [ast] + [syntax #+ syntax:] + [poly #+ derived:]) + [pipe] + test) + ) + +## [Utils] +(syntax: (reads-to-itself expr) + (with-gensyms [g!json g!parsed g!message] + (wrap (list (` (: (Test Unit) + (let [(~ g!json) (~ expr)] + (case (|> (~ g!json) JSON/encode JSON/decode) + (#;Left (~ g!message)) + (fail (~ g!message)) + + (#;Right (~ g!parsed)) + (if (JSON/= (~ g!json) (~ g!parsed)) + (~ (' (:: Monad<Test> wrap []))) + (fail (format "Expression does not parse to itself: " (~ (ast;text (ast;ast-to-text expr))) + "\n\nWhich is: " (|> (~ g!json) JSON/encode) + "\n\nInstead, it parsed to: " (JSON/encode (~ g!parsed)))) + )))) + ))))) + +## [Tests] +## (derived: (Codec<JSON,?> ;Bool)) +## (derived: (Codec<JSON,?> ;Int)) +## (derived: (Codec<JSON,?> ;Real)) +## (derived: (Codec<JSON,?> ;Char)) +## (derived: (Codec<JSON,?> ;Text)) + +## (type: Int-List (List Int)) +## (derived: (Codec<JSON,?> ;;Int-List)) + +## (type: Int-Maybe (Maybe Int)) +## (derived: (Codec<JSON,?> ;;Int-Maybe)) + +## (type: Triple [Bool Int Text]) +## (derived: (Codec<JSON,?> ;;Triple)) + +## (type: User +## {#alive? Bool +## #age Int +## #name Text}) +## (derived: (Codec<JSON,?> ;;User)) + +## (type: Options +## (#One Bool) +## (#Two Int) +## (#Three Text)) +## (derived: (Codec<JSON,?> ;;Options)) + +## (test: "Auto-generated codecs" +## (let% [<tests> (do-template [<input> <output> <codec>] +## [(match <output> +## (|> <input> +## (:: <codec> encode) +## JSON/encode)) +## (match+ <input> +## (should-pass (|> (JSON/decode <output>) +## (pipe;%> Error/Monad +## [(:: <codec> decode)]))))] + +## [true "true" Codec<JSON,Bool>] +## [123 "123.0" Codec<JSON,Int>] +## [123.45 "123.45" Codec<JSON,Real>] +## [#"a" "\"a\"" Codec<JSON,Char>] +## ["yolo" "\"yolo\"" Codec<JSON,Text>] + +## [(#;Cons 1 (#;Cons 2 (#;Cons 3 #;Nil))) "[1.0,2.0,3.0]" Codec<JSON,Int-List>] +## [#;Nil "[]" Codec<JSON,Int-List>] +## [(#;Some 1) "1.0" Codec<JSON,Int-Maybe>] +## [#;None "null" Codec<JSON,Int-Maybe>] +## [[false 456 "lol"] "[false,456.0,\"lol\"]" Codec<JSON,Triple>] +## [{#alive? true #age 25 #name "Eduardo Julian"} +## "{\"alive?\":true,\"age\":25.0,\"name\":\"Eduardo Julian\"}" +## Codec<JSON,User>] +## [(#One true) "[\"One\",true]" Codec<JSON,Options>] +## [(#Two 123) "[\"Two\",123.0]" Codec<JSON,Options>] +## [(#Three "yolo") "[\"Three\",\"yolo\"]" Codec<JSON,Options>] +## )] +## (test-all <tests> +## ))) + +(test: "Basics" + (test-all (match #json;Null + null) + + (match (#json;Boolean true) + (gen-boolean true)) + + (match (#json;Boolean false) + (gen-boolean false)) + + (match (#json;Number 123.45) + (gen-number 123.45)) + + (match (#json;String "YOLO") + (gen-string "YOLO")) + + ## (match (^ (#json;Array (list (#json;Boolean true) (#json;Number 123.45) (#json;String "YOLO")))) + ## (json [(gen-boolean true) (gen-number 123.45) (gen-string "YOLO")])) + + ## (match (^ (#json;Object (list ["yolo" (#json;Boolean true)] + ## ["lol" (#json;Number 123.45)]))) + ## (json {"yolo" (gen-boolean true) + ## "lol" (gen-number 123.45)})) + + (match (#;Some (#json;Boolean true)) + (get "yolo" (json {"yolo" true + "lol" 123.45}))) + + (match (#;Left _) + (get "yolo" (json {}))) + + ## (match (^ (#;Some (#json;Object (list ["lol" (#json;Number 123.45)] + ## ["yolo" (#json;Boolean true)])))) + ## (|> (json {"yolo" (gen-boolean true)}) + ## (set "lol" (gen-number 123.45)))) + + (match (#;Right true) + (get-boolean "value" (json {"value" true}))) + + (match (#;Right 123.45) + (get-number "value" (json {"value" 123.45}))) + + (match (#;Right "YOLO") + (get-string "value" (json {"value" "YOLO"}))) + + ## (match (^ (#;Right (list (#json;Boolean true) (#json;Number 123.45) (#json;String "YOLO")))) + ## (get-array "value" (json {"value" (json [(gen-boolean true) + ## (gen-number 123.45) + ## (gen-string "YOLO")])}))) + + ## (match (^ (#;Right (list ["yolo" (#json;Boolean true)] + ## ["lol" (#json;Number 123.45)]))) + ## (get-object "value" (json {"value" (json {"yolo" (gen-boolean true) + ## "lol" (gen-number 123.45)})}))) + + (match (#;Left _) + (get-array "value" (json {}))) + + (match (#;Left _) + (get-array "value" (gen-boolean true))) + )) + +(test: "Encoding" + (test-all (match "null" + (JSON/encode (json #null))) + + (match "123.0" + (JSON/encode (json 123))) + + (match "123.46" + (JSON/encode (json 123.46))) + + (match "true" + (JSON/encode (json true))) + + (match "false" + (JSON/encode (json false))) + + (match "\"YOLO\"" + (JSON/encode (json "YOLO"))) + + (match "[null,123.46,true,\"YOLO\",[\"nyan\",\"cat\"]]" + (JSON/encode (json [#null 123.46 true "YOLO" ["nyan" "cat"]]))) + + (match "{\"foo\":\"bar\",\"baz\":null,\"quux\":[\"nyan\",{\"cat\":\"meme\"}]}" + (JSON/encode (json {"foo" "bar" + "baz" #null + "quux" ["nyan" {"cat" "meme"}]}))) + )) + +(test: "Decoding" + (test-all (reads-to-itself (json #null)) + (reads-to-itself (json 123)) + (reads-to-itself (json 123.46)) + (reads-to-itself (json true)) + (reads-to-itself (json false)) + (reads-to-itself (json "\tY\"OLO\n")) + (reads-to-itself (json [#null 123.46 true "YOLO" ["nyan" "cat"]])) + (reads-to-itself (json {"foo" "bar" + "baz" #null + "quux" ["nyan" {"cat" "meme"}]})) + )) + +(test: "Parser" + (test-all (should-pass (run unit + (json #null))) + (should-fail (run unit + (json 123))) + + (match+ 123.45 + (should-pass (run real + (json 123.45)))) + (should-fail (run real + (json #null))) + + (match+ 123 + (should-pass (run int + (json 123)))) + (should-fail (run int + (json #null))) + + (match+ true + (should-pass (run bool + (json true)))) + (should-fail (run bool + (json 123))) + + (match+ "YOLO" + (should-pass (run text + (json "YOLO")))) + (should-fail (run text + (json 123))) + + (match+ (^ (list "YOLO" "LOL" "MEME")) + (should-pass (run (array text) + (json ["YOLO" "LOL" "MEME"])))) + (should-fail (run (array text) + (json 123))) + + (match+ "LOL" + (should-pass (run (at +1 text) + (json ["YOLO" "LOL" "MEME"])))) + (should-fail (run (array text) + (json 123))) + + (match+ "MEME" + (should-pass (run (field "baz" text) + (json {"foo" "YOLO" + "bar" "LOL" + "baz" "MEME"})))) + (should-fail (run (field "baz" text) + (json 123))) + + (match+ (#json;Number 123.0) + (should-pass (run any + (json 123)))) + + (match+ ["YOLO" "MEME"] + (should-pass (run (seq (field "foo" text) + (field "baz" text)) + (json {"foo" "YOLO" + "bar" "LOL" + "baz" "MEME"})))) + (should-fail (run (seq (field "foo" text) + (field "baz" text)) + (json {"foo" "YOLO" + "bar" "LOL"}))) + + (match+ (#;Left "YOLO") + (should-pass (run (alt (field "foo" text) + (field "baz" text)) + (json {"foo" "YOLO" + "bar" "LOL" + "baz" "MEME"})))) + (match+ (#;Right "MEME") + (should-pass (run (alt (field "fool" text) + (field "baz" text)) + (json {"foo" "YOLO" + "bar" "LOL" + "baz" "MEME"})))) + (should-fail (run (alt (field "fool" text) + (field "baz" text)) + (json {"foo" "YOLO" + "bar" "LOL"}))) + + (match+ "YOLO" + (should-pass (run (either (field "foo" text) + (field "baz" text)) + (json {"foo" "YOLO" + "bar" "LOL" + "baz" "MEME"})))) + (match+ "MEME" + (should-pass (run (either (field "fool" text) + (field "baz" text)) + (json {"foo" "YOLO" + "bar" "LOL" + "baz" "MEME"})))) + (should-fail (run (either (field "fool" text) + (field "baz" text)) + (json {"foo" "YOLO" + "bar" "LOL"}))) + + (match+ (#;Some "YOLO") + (should-pass (run (opt (field "foo" text)) + (json {"foo" "YOLO" + "bar" "LOL" + "baz" "MEME"})))) + (match+ #;None + (should-pass (run (opt (field "fool" text)) + (json {"foo" "YOLO" + "bar" "LOL" + "baz" "MEME"})))) + )) diff --git a/stdlib/test/test/lux/data/ident.lux b/stdlib/test/test/lux/data/ident.lux new file mode 100644 index 000000000..8cb85175f --- /dev/null +++ b/stdlib/test/test/lux/data/ident.lux @@ -0,0 +1,53 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad) + (data ["&" ident] + [text "Text/" Eq<Text>]) + (math ["R" random]) + pipe) + lux/test) + +(test: "Idents" + [## First Ident + sizeM1 (|> R;nat (:: @ map (%+ +100))) + sizeN1 (|> R;nat (:: @ map (%+ +100))) + module1 (R;text sizeM1) + name1 (R;text sizeN1) + #let [ident1 [module1 name1]] + ## Second Ident + sizeM2 (|> R;nat (:: @ map (%+ +100))) + sizeN2 (|> R;nat (:: @ map (%+ +100))) + module2 (R;text sizeM2) + name2 (R;text sizeN2) + #let [ident2 [module2 name2]] + #let [(^open "&/") &;Eq<Ident> + (^open "&/") &;Codec<Text,Ident>]] + (all (assert "Can get the module & name parts of an ident." + (and (== module1 (&;module ident1)) + (== 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)))))) + + (assert "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)) + )) diff --git a/stdlib/test/test/lux/data/identity.lux b/stdlib/test/test/lux/data/identity.lux new file mode 100644 index 000000000..f492a801e --- /dev/null +++ b/stdlib/test/test/lux/data/identity.lux @@ -0,0 +1,36 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad + comonad) + (data identity + [text "Text/" Monoid<Text>])) + lux/test) + +(test: "lux/data/identity exports" + (all (match "yololol" (:: Functor<Identity> map (Text/append "yolo") "lol")) + + (match "yolo" (:: Applicative<Identity> wrap "yolo")) + (match "yololol" (let [(^open) Applicative<Identity>] + (apply (wrap (Text/append "yolo")) (wrap "lol")))) + + (match "yololol" + (do Monad<Identity> + [f (wrap Text/append) + a (wrap "yolo") + b (wrap "lol")] + (wrap (f a b)))) + + (match "yololol" (:: CoMonad<Identity> unwrap "yololol")) + (match "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 new file mode 100644 index 000000000..c052a29da --- /dev/null +++ b/stdlib/test/test/lux/data/log.lux @@ -0,0 +1,32 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad) + (data log + [text "Text/" Monoid<Text>] + [number]) + (codata function)) + lux/test) + +(test: "lux/data/log exports" + (all (match ["" 11] + (:: Functor<Log> map inc ["" 10])) + (match ["" 20] + (:: (Applicative<Log> text;Monoid<Text>) wrap 20)) + (match ["" 30] + (let [(^open) (Applicative<Log> text;Monoid<Text>)] + (apply (wrap (+ 10)) (wrap 20)))) + (match ["" 30] + (do (Monad<Log> text;Monoid<Text>) + [f (wrap +) + a (wrap 10) + b (wrap 20)] + (wrap (f a b)))) + (match ["YOLO" []] + (log "YOLO")) + )) diff --git a/stdlib/test/test/lux/data/maybe.lux b/stdlib/test/test/lux/data/maybe.lux new file mode 100644 index 000000000..bd44593d7 --- /dev/null +++ b/stdlib/test/test/lux/data/maybe.lux @@ -0,0 +1,49 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad) + (data maybe + [text "Text/" Monoid<Text>] + [number])) + lux/test) + +(test: "lux/data/maybe exports" + (all (match #;None (:: Monoid<Maybe> unit)) + (match (#;Some "yolo") (:: Monoid<Maybe> append (#;Some "yolo") (#;Some "lol"))) + (match (#;Some "yolo") (:: Monoid<Maybe> append (#;Some "yolo") #;None)) + (match (#;Some "lol") (:: Monoid<Maybe> append #;None (#;Some "lol"))) + (match #;None (: (Maybe Text) (:: Monoid<Maybe> append #;None #;None))) + + (match #;None (:: Functor<Maybe> map (Text/append "yolo") #;None)) + (match (#;Some "yololol") (:: Functor<Maybe> map (Text/append "yolo") (#;Some "lol"))) + + (match (#;Some "yolo") (:: Applicative<Maybe> wrap "yolo")) + (match (#;Some "yololol") + (let [(^open) Applicative<Maybe>] + (apply (wrap (Text/append "yolo")) (wrap "lol")))) + + (match (#;Some "yololol") + (do Monad<Maybe> + [f (wrap Text/append) + a (wrap "yolo") + b (wrap "lol")] + (wrap (f a b)))) + + (match true (:: (Eq<Maybe> text;Eq<Text>) = + (: (Maybe Text) #;None) + (: (Maybe Text) #;None))) + (match true (:: (Eq<Maybe> text;Eq<Text>) = + (#;Some "yolo") + (#;Some "yolo"))) + (match false (:: (Eq<Maybe> text;Eq<Text>) = + (#;Some "yolo") + (#;Some "lol"))) + (match false (:: (Eq<Maybe> text;Eq<Text>) = + (#;Some "yolo") + (: (Maybe Text) #;None))) + )) diff --git a/stdlib/test/test/lux/data/number.lux b/stdlib/test/test/lux/data/number.lux new file mode 100644 index 000000000..adefb480a --- /dev/null +++ b/stdlib/test/test/lux/data/number.lux @@ -0,0 +1,135 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad) + (data number + [text "Text/" Monoid<Text>] + text/format) + (math ["R" random]) + pipe) + lux/test) + +(do-template [category rand-gen <Eq> <Ord>] + [(test: (format "[" category "] " "Eq & Ord") + [x rand-gen + y rand-gen] + (assert "" (and (:: <Eq> = x x) + (or (:: <Eq> = x y) + (:: <Ord> < y x) + (:: <Ord> > y x)))))] + + ["Nat" R;nat Eq<Nat> Ord<Nat>] + ["Int" R;int Eq<Int> Ord<Int>] + ["Real" R;real Eq<Real> Ord<Real>] + ["Frac" R;frac Eq<Frac> Ord<Frac>] + ) + +(do-template [category rand-gen <Number>] + [(test: (format "[" category "] " "Number") + [x rand-gen] + (assert "" (let [(^open) <Number>] + (and (>= x (abs x)) + (<= x (negate (abs x))) + (= x (* (signum x) + (abs x)))))))] + + ["Nat" R;nat Number<Nat>] + ["Int" R;int Number<Int>] + ["Real" R;real Number<Real>] + ) + +(do-template [category rand-gen <Enum> <Number>] + [(test: (format "[" category "] " "Enum") + [x rand-gen] + (assert "" (let [(^open) <Number>] + (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>] + ["Int" R;int Enum<Int> Number<Int>] + ) + +(do-template [category rand-gen <Number> <Bounded>] + [(test: (format "[" category "] " "Bounded") + [x rand-gen] + (assert "" (let [(^open) <Number>] + (and (<= x (:: <Bounded> bottom)) + (>= x (:: <Bounded> top)) + ))))] + + ["Nat" R;nat Number<Nat> Bounded<Nat>] + ["Int" R;int Number<Int> Bounded<Int>] + ["Real" R;real Number<Real> Bounded<Real>] + ) + +(do-template [category rand-gen <Number> <Monoid> <cap>] + [(test: (format "[" category "] " "Monoid") + [x (:: @ map (|>. (:: <Number> abs) <cap>) rand-gen)] + (assert "" (let [(^open) <Number> + (^open) <Monoid>] + (and (= x (append unit x)) + (= x (append x unit)) + (= unit (append unit unit)) + (>= x (append x x))))))] + + ["Nat/Add" R;nat Number<Nat> Add@Monoid<Nat> (;%+ +1000)] + ["Nat/Mul" R;nat Number<Nat> Mul@Monoid<Nat> (;%+ +1000)] + ["Nat/Min" R;nat Number<Nat> Min@Monoid<Nat> (;%+ +1000)] + ["Nat/Max" R;nat Number<Nat> Max@Monoid<Nat> (;%+ +1000)] + ["Int/Add" R;int Number<Int> Add@Monoid<Int> (;% 1000)] + ["Int/Mul" R;int Number<Int> Mul@Monoid<Int> (;% 1000)] + ["Int/Min" R;int Number<Int> Min@Monoid<Int> (;% 1000)] + ["Int/Max" R;int Number<Int> Max@Monoid<Int> (;% 1000)] + ["Real/Add" R;real Number<Real> Add@Monoid<Real> (;%. 1000.0)] + ["Real/Mul" R;real Number<Real> Mul@Monoid<Real> (;%. 1000.0)] + ["Real/Min" R;real Number<Real> Min@Monoid<Real> (;%. 1000.0)] + ["Real/Max" R;real Number<Real> Max@Monoid<Real> (;%. 1000.0)] + ) + +(do-template [category rand-gen <Number> <Codec>] + [(test: (format "[" category "] " "Codec") + [x rand-gen] + (assert "" (|> x + (:: <Codec> encode) + (:: <Codec> decode) + (case> (#;Right x') + (:: <Number> = x x') + + (#;Left _) + false))))] + + ["Nat" R;nat Number<Nat> Codec<Text,Nat>] + ["Int" R;int Number<Int> Codec<Text,Int>] + ["Real" R;real Number<Real> Codec<Text,Real>] + ## ["Frac" R;frac Number<Frac> Codec<Text,Frac>] + ) + +(do-template [category rand-gen <Number> <Codec>] + [(test: (format "[" category "] " "Alternative formats") + [x rand-gen] + (assert "" (|> x + (:: <Codec> encode) + (:: <Codec> decode) + (case> (#;Right x') + (:: <Number> = x x') + + (#;Left _) + false))))] + + ["Nat/Binary" R;nat Number<Nat> Binary@Codec<Text,Nat>] + ["Nat/Octal" R;nat Number<Nat> Octal@Codec<Text,Nat>] + ["Nat/Hex" R;nat Number<Nat> Hex@Codec<Text,Nat>] + ) diff --git a/stdlib/test/test/lux/data/product.lux b/stdlib/test/test/lux/data/product.lux new file mode 100644 index 000000000..51c23e47d --- /dev/null +++ b/stdlib/test/test/lux/data/product.lux @@ -0,0 +1,20 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad) + (data product + [text "Text/" Monoid<Text>] + [number]) + (codata function)) + lux/test) + +(test: "Product operations" + (all (match 1 (left [1 2])) + (match 2 (right [1 2])) + (match [2 1] (swap [1 2])) + )) diff --git a/stdlib/test/test/lux/data/struct/array.lux b/stdlib/test/test/lux/data/struct/array.lux new file mode 100644 index 000000000..171631bd9 --- /dev/null +++ b/stdlib/test/test/lux/data/struct/array.lux @@ -0,0 +1,130 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (control [monad]) + (codata [io]) + (data (struct ["&" array] + [list]) + [number]) + (math ["R" random]) + pipe) + lux/test) + +(def: bounded-size + (R;Random Nat) + (|> R;nat + (:: R;Monad<Random> map (|>. (%+ +100) (++ +1))))) + +(test: "Arrays and their copies" + [size bounded-size + original (R;array size R;nat) + #let [clone (&;clone original) + copy (: (&;Array Nat) + (&;new size)) + manual-copy (: (&;Array Nat) + (&;new size))]] + (all (assert "Size function must correctly return size of array." + (=+ 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 (== 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 (== original copy))))) + (assert "Array folding should go over all values." + (exec (:: &;Fold<Array> fold + (lambda [x idx] + (exec (&;put idx x manual-copy) + (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: "Array mutation" + [size bounded-size + idx (:: @ map (%+ size) R;nat) + array (|> (R;array size R;nat) + (R;filter (|>. &;to-list (list;any? odd?+)))) + #let [value (default (undefined) + (&;get idx array))]] + (all (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') (=+ value' value) + #;None false)) + (assert "All cells should be occupied on a full array." + (and (=+ size (&;occupied array)) + (=+ +0 (&;vacant array)))) + (assert "Filtering mutates the array to remove invalid values." + (exec (&;filter even?+ array) + (and (<+ size (&;occupied array)) + (>+ +0 (&;vacant array)) + (=+ size (++ (&;occupied array) + (&;vacant array)))))) + )) + +(test: "Finding values." + [size bounded-size + array (|> (R;array size R;nat) + (R;filter (|>. &;to-list (list;any? even?+))))] + (all (assert "Can find values inside arrays." + (|> (&;find even?+ array) + (case> (#;Some _) true + #;None false))) + (assert "Can find values inside arrays (with access to indices)." + (|> (&;find+ (lambda [idx n] + (and (even?+ n) + (<+ size idx))) + array) + (case> (#;Some _) true + #;None false))))) + +(test: "Functor" + [size bounded-size + array (R;array size R;nat)] + (let [(^open) &;Functor<Array> + (^open) (&;Eq<Array> number;Eq<Nat>)] + (all (assert "Functor shouldn't alter original array." + (let [copy (map id array)] + (and (= array copy) + (not (== array copy))))) + (assert "Functor should go over all available array elements." + (let [there (map inc+ array) + back-again (map dec+ there)] + (and (not (= array there)) + (= array back-again))))))) + +(test: "Monoid" + [sizeL bounded-size + sizeR bounded-size + left (R;array sizeL R;nat) + right (R;array sizeR R;nat) + #let [(^open) &;Monoid<Array> + (^open) (&;Eq<Array> number;Eq<Nat>) + fusion (append left right)]] + (all (assert "Appending two arrays should produce a new one twice as large." + (=+ (++ 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))) + )) diff --git a/stdlib/test/test/lux/data/struct/dict.lux b/stdlib/test/test/lux/data/struct/dict.lux new file mode 100644 index 000000000..06b9550aa --- /dev/null +++ b/stdlib/test/test/lux/data/struct/dict.lux @@ -0,0 +1,136 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad + [eq]) + (data [text "Text/" Monoid<Text>] + text/format + [number] + [char] + (struct ["&" dict] + [list "List/" Fold<List> Functor<List>])) + (codata function) + (math ["R" random]) + pipe) + lux/test) + +(test: "Dictionaries." + [#let [capped-nat (:: R;Monad<Random> map (%+ +100) R;nat)] + size capped-nat + dict (R;dict char;Hash<Char> size R;char capped-nat) + non-key (|> R;char + (R;filter (lambda [key] (not (&;contains? key dict))))) + test-val (|> R;nat + (R;filter (lambda [val] (not (list;member? number;Eq<Nat> (&;values dict) val)))))] + (all (assert "Size function should correctly represent Dict size." + (=+ size (&;size dict))) + + (assert "Dicts of size 0 should be considered empty." + (if (=+ +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)))) + + (assert "Dict should be able to recognize it's own keys." + (list;every? (lambda [key] (&;contains? key dict)) + (&;keys dict))) + + (assert "Should be able to get every key." + (list;every? (lambda [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)) + + (assert "Should be able to put and then get a value." + (case (&;get non-key (&;put non-key test-val dict)) + (#;Some v) (=+ 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) (=+ test-val v) + _ true)) + + (assert "Shouldn't be able to put~ an existing key." + (or (=+ +0 size) + (let [first-key (|> dict &;keys list;head (default (undefined)))] + (case (&;get first-key (&;put~ first-key test-val dict)) + (#;Some v) (not (=+ 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)))))) + + (assert "Should be possible to update values via their keys." + (let [base (&;put non-key test-val dict) + updt (&;update non-key inc+ base)] + (case [(&;get non-key base) (&;get non-key updt)] + [(#;Some x) (#;Some y)] + (=+ (inc+ x) y) + + _ + 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 (=+ (inc+ (&;size dict)) (&;size plus)) + (=+ (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))))) + + (assert "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 (lambda [[k v]] [k (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? (lambda [[x x*2]] (=+ (*+ +2 x) x*2)) + (list;zip2 (&;values dict) + (&;values (&;merge-with ++ dict dict))))) + + (assert "Should be able to select subset of keys from dict." + (|> dict + (&;put non-key test-val) + (&;select (list non-key)) + &;size + (=+ +1))) + + (assert "Should be able to re-bind existing values to different keys." + (or (=+ +0 size) + (let [first-key (|> dict &;keys list;head (default (undefined))) + rebound (&;re-bind first-key non-key dict)] + (and (=+ (&;size dict) (&;size rebound)) + (&;contains? non-key rebound) + (not (&;contains? first-key rebound)) + (=+ (default (undefined) + (&;get first-key dict)) + (default (undefined) + (&;get non-key rebound))))))) + )) diff --git a/stdlib/test/test/lux/data/struct/list.lux b/stdlib/test/test/lux/data/struct/list.lux new file mode 100644 index 000000000..6baf13c6c --- /dev/null +++ b/stdlib/test/test/lux/data/struct/list.lux @@ -0,0 +1,191 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad) + (data (struct ["&" list]) + [text "Text/" Monoid<Text>] + [number] + [bool] + [product]) + (math ["R" random]) + pipe) + lux/test) + +(def: bounded-size + (R;Random Nat) + (|> R;nat + (:: R;Monad<Random> map (|>. (%+ +100) (++ +10))))) + +(test: "Lists" + [size bounded-size + idx (:: @ map (%+ size) R;nat) + sample (R;list size R;nat) + other-size bounded-size + other-sample (R;list other-size R;nat) + separator R;nat + #let [(^open) (&;Eq<List> number;Eq<Nat>) + (^open "&/") &;Functor<List>]] + (all (assert "The size function should correctly portray the size of the list." + (=+ size (&;size sample))) + + (assert "The repeat function should produce as many elements as asked of it." + (=+ size (&;size (&;repeat size [])))) + + (assert "Reversing a list does not change it's size." + (=+ (&;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 (=+ (&;size sample) + (++ (&;size (&;filter even?+ sample)) + (&;size (&;filter (bool;complement even?+) sample)))) + (let [[plus minus] (&;partition even?+ sample)] + (=+ (&;size sample) + (++ (&;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? even?+ sample) + (and (not (&;any? (bool;complement even?+) sample)) + (&;empty? (&;filter (bool;complement even?+) sample))) + (&;any? (bool;complement even?+) sample))) + + (assert "Any element of the list can be considered it's member." + (let [elem (default (undefined) + (&;at idx sample))] + (&;member? number;Eq<Nat> sample elem))) + + (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 inc+ sample) + back-again (map 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 even?+ sample)] + (and (= sample + (append left right)) + (= sample + (append left' right')) + (= sample + (append (&;take idx sample) + (&;drop idx sample))) + (= sample + (append (&;take-while even?+ sample) + (&;drop-while even?+ sample))) + ))) + + (assert "Segmenting the list in pairs should yield as many elements as N/2." + (=+ (/+ +2 size) + (&;size (&;as-pairs sample)))) + + (assert "Sorting a list shouldn't change it's size." + (=+ (&;size sample) + (&;size (&;sort <+ sample)))) + + (assert "Sorting a list with one order should yield the reverse of sorting it with the opposite order." + (= (&;sort <+ sample) + (&;reverse (&;sort >+ sample)))) + + (assert "If you zip 2 lists, the result's size will be that of the smaller list." + (=+ (&;size (&;zip2 sample other-sample)) + (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)))))) + + (assert "You can generate indices for any size, and they will be in ascending order." + (let [(^open) &;Functor<List> + indices (&;indices size)] + (and (=+ size (&;size indices)) + (= indices + (&;sort <+ indices)) + (&;every? (=+ (dec+ size)) + (&;zip2-with ++ + indices + (&;sort >+ indices))) + ))) + + (assert "The 'interpose' function places a value between every member of a list." + (let [(^open) &;Functor<List> + sample+ (&;interpose separator sample)] + (and (=+ (|> size (*+ +2) dec+) + (&;size sample+)) + (|> sample+ &;as-pairs (map product;right) (&;every? (=+ 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 inc+ sample) + (apply (wrap 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 even?+ sample) + (#;Some found) + (and (even?+ found) + (&;any? even?+ sample) + (not (&;every? (bool;complement even?+) sample))) + + #;None + (and (not (&;any? even?+ sample)) + (&;every? (bool;complement even?+) sample)))) + + (assert "You can iteratively construct a list, generating values until you're done." + (= (&;range+ +0 (dec+ size)) + (&;iterate (lambda [n] (if (<+ size n) (#;Some (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))))) + )) diff --git a/stdlib/test/test/lux/data/struct/queue.lux b/stdlib/test/test/lux/data/struct/queue.lux new file mode 100644 index 000000000..895929ab4 --- /dev/null +++ b/stdlib/test/test/lux/data/struct/queue.lux @@ -0,0 +1,54 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad) + (data (struct ["&" queue]) + [number]) + (math ["R" random]) + pipe) + lux/test) + +(test: "Queues" + [size (:: @ map (%+ +100) R;nat) + sample (R;queue size R;nat) + non-member (|> R;nat + (R;filter (. not (&;enqueued? number;Eq<Nat> sample))))] + (all (assert "I can query the size of a queue (and empty queues have size 0)." + (if (=+ +0 size) + (&;empty? sample) + (=+ size (&;size sample)))) + + (assert "Enqueueing and dequeing affects the size of queues." + (and (=+ (inc+ size) (&;size (&;enqueue non-member sample))) + (or (&;empty? sample) + (=+ (dec+ size) (&;size (&;dequeue sample)))) + (=+ size (&;size (&;dequeue (&;enqueue 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)))) + + (assert "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 (&;enqueued? number;Eq<Nat> sample non-member)) + (&;enqueued? number;Eq<Nat> (&;enqueue non-member sample) + non-member) + (case (&;peek sample) + #;None + (&;empty? sample) + + (#;Some first) + (and (&;enqueued? number;Eq<Nat> sample first) + (not (&;enqueued? number;Eq<Nat> (&;dequeue sample) first)))))) + )) diff --git a/stdlib/test/test/lux/data/struct/set.lux b/stdlib/test/test/lux/data/struct/set.lux new file mode 100644 index 000000000..3725e7f93 --- /dev/null +++ b/stdlib/test/test/lux/data/struct/set.lux @@ -0,0 +1,67 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad) + (data (struct ["&" set] + [list "" Fold<List>]) + [number]) + (math ["R" random]) + pipe) + lux/test) + +(def: gen-nat + (R;Random Nat) + (|> R;nat + (:: R;Monad<Random> map (%+ +100)))) + +(test: "Sets" + [sizeL gen-nat + sizeR gen-nat + setL (R;set number;Hash<Nat> sizeL gen-nat) + setR (R;set number;Hash<Nat> sizeR gen-nat) + non-member (|> gen-nat + (R;filter (. not (&;member? setL)))) + #let [(^open "&/") &;Eq<Set>]] + (all (assert "I can query the size of a set." + (and (=+ sizeL (&;size setL)) + (=+ 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? setL) (&;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)))) + )) diff --git a/stdlib/test/test/lux/data/struct/stack.lux b/stdlib/test/test/lux/data/struct/stack.lux new file mode 100644 index 000000000..dc3bb1e89 --- /dev/null +++ b/stdlib/test/test/lux/data/struct/stack.lux @@ -0,0 +1,47 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad) + (data (struct ["&" stack] + [list "" Fold<List>]) + [number]) + (math ["R" random]) + pipe) + lux/test) + +(def: gen-nat + (R;Random Nat) + (|> R;nat + (:: R;Monad<Random> map (%+ +100)))) + +(test: "Stacks" + [size gen-nat + sample (R;stack size gen-nat) + new-top gen-nat] + (all (assert "Can query the size of a stack." + (=+ size (&;size sample))) + + (assert "Can peek inside non-empty stacks." + (case (&;peek sample) + #;None (&;empty? sample) + (#;Some _) (not (&;empty? sample)))) + + (assert "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 (=+ (&;size sample) (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 (== sample + (&;pop (&;push new-top sample))) + (=+ (inc+ (&;size sample)) (&;size (&;push new-top sample))) + (|> (&;push new-top sample) &;peek (default (undefined)) + (== new-top)))) + )) diff --git a/stdlib/test/test/lux/data/struct/tree.lux b/stdlib/test/test/lux/data/struct/tree.lux new file mode 100644 index 000000000..0595ca7b3 --- /dev/null +++ b/stdlib/test/test/lux/data/struct/tree.lux @@ -0,0 +1,39 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad) + (data (struct ["&" tree] + [list "List/" Monad<List>]) + [number]) + (math ["R" random]) + pipe) + lux/test) + +(def: gen-nat + (R;Random Nat) + (|> R;nat + (:: R;Monad<Random> map (%+ +100)))) + +(test: "Trees" + [leaf (:: @ map &;leaf R;nat) + branchS gen-nat + branchV R;nat + branchC (R;list branchS R;nat) + #let [branch (&;branch branchV (List/map &;leaf branchC))] + #let [(^open "&/") (&;Eq<Tree> number;Eq<Nat>) + (^open "List/") (list;Eq<List> number;Eq<Nat>)]] + (all (assert "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))) + )) diff --git a/stdlib/test/test/lux/data/struct/vector.lux b/stdlib/test/test/lux/data/struct/vector.lux new file mode 100644 index 000000000..87f8fa4cb --- /dev/null +++ b/stdlib/test/test/lux/data/struct/vector.lux @@ -0,0 +1,84 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad) + (data (struct ["&" vector] + [list "List/" Fold<List> Functor<List>]) + [text "Text/" Monoid<Text>] + text/format + [number]) + (codata function) + (math ["R" random]) + pipe) + lux/test) + +(test: "Vectors" + [size (|> R;nat (:: @ map (%+ +100))) + idx (|> R;nat (:: @ map (%+ size))) + sample (R;vector size R;nat) + other-sample (R;vector size R;nat) + non-member (|> R;nat (R;filter (. not (&;member? number;Eq<Nat> sample)))) + #let [(^open "&/") (&;Eq<Vector> number;Eq<Nat>) + (^open "&/") &;Monad<Vector> + (^open "&/") &;Fold<Vector> + (^open "&/") &;Monoid<Vector>]] + (all (assert "Can query size of vector." + (if (&;empty? sample) + (and (=+ +0 size) + (=+ +0 (&;size sample))) + (=+ size (&;size sample)))) + + (assert "Can add and remove elements to vectors." + (and (=+ (inc+ size) + (&;size (&;add non-member sample))) + (=+ (dec+ size) + (&;size (&;pop sample))))) + + (assert "Can put and get elements into vectors." + (|> sample + (&;put idx non-member) + (&;at idx) + (default (undefined)) + (== non-member))) + + (assert "Can update elements of vectors." + (|> sample + (&;put idx non-member) + (&;update idx inc+) + (&;at idx) + (default (undefined)) + (=+ (inc+ non-member)))) + + (assert "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))) + + (assert "Can fold over elements of vector." + (=+ (List/fold ++ +0 (&;to-list sample)) + (&/fold ++ +0 sample))) + + (assert "Functor goes over every element." + (let [there (&/map inc+ sample) + back-again (&/map 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 inc+ sample) + (&/apply (&/wrap inc+) sample)))) + + (assert "Vector concatenation is a monad." + (&/= (&/append sample other-sample) + (&/join (&;vector sample other-sample)))) + )) diff --git a/stdlib/test/test/lux/data/struct/zipper.lux b/stdlib/test/test/lux/data/struct/zipper.lux new file mode 100644 index 000000000..a3bede88d --- /dev/null +++ b/stdlib/test/test/lux/data/struct/zipper.lux @@ -0,0 +1,127 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad) + (data (struct ["&" zipper] + [tree] + [list "List/" Fold<List> Functor<List>]) + [text "Text/" Monoid<Text>] + text/format + [number]) + (codata function) + (math ["R" random]) + pipe) + lux/test) + +(def: gen-tree + (R;Random (tree;Tree Nat)) + (R;rec (lambda [gen-tree] + (do R;Monad<Random> + ## Each branch can have, at most, 1 child. + [size (|> R;nat (:: @ map (%+ +2)))] + (R;seq R;nat + (R;list size gen-tree)))))) + +(def: (to-end zipper) + (All [a] (-> (&;Zipper a) (&;Zipper a))) + (loop [zipper zipper] + (if (&;end? zipper) + zipper + (recur (&;next zipper))))) + +(test: "Zippers" + [sample gen-tree + new-val R;nat + pre-val R;nat + post-val R;nat + #let [(^open "Tree/") (tree;Eq<Tree> number;Eq<Nat>) + (^open "List/") (list;Eq<List> number;Eq<Nat>)]] + (all (assert "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?)) + + (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)) (== zipper)) + (|> child &;up (== zipper)) + (|> child &;root (== zipper)))) + (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 (== pre-val)) + (|> zipper &;down &;right &;value (== mid-val)) + (|> zipper &;down &;right &;right &;value (== post-val)) + (|> zipper &;down &;rightmost &;leftmost &;value (== pre-val)) + (|> zipper &;down &;right &;left &;value (== mid-val)) + (|> zipper &;down &;rightmost &;value (== 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 (== pre-val)) + (|> zipper &;down &;right &;value (== mid-val)) + (|> zipper &;down &;right &;right &;value (== post-val)) + (|> zipper &;down &;rightmost &;leftmost &;value (== pre-val)) + (|> zipper &;down &;right &;left &;value (== mid-val)) + (|> zipper &;down &;rightmost &;value (== 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 (=+ new-val))) + + (assert "Zipper traversal follows the outline of the tree depth-first." + (List/= (tree;flatten sample) + (loop [zipper (&;from-tree sample)] + (if (&;end? zipper) + (list) + (#;Cons (&;value zipper) + (recur (&;next zipper))))))) + + (assert "Backwards zipper traversal yield reverse tree flatten." + (List/= (list;reverse (tree;flatten sample)) + (loop [zipper (to-end (&;from-tree sample))] + (if (&;root? zipper) + (list) + (#;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))))) + )) diff --git a/stdlib/test/test/lux/data/sum.lux b/stdlib/test/test/lux/data/sum.lux new file mode 100644 index 000000000..a23eeec00 --- /dev/null +++ b/stdlib/test/test/lux/data/sum.lux @@ -0,0 +1,32 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad) + (data sum + [text "Text/" Monoid<Text>] + [number]) + (codata function)) + lux/test) + +(test: "Sum operations" + (all (match (+0 1) (left 1)) + (match (+1 2) (right 2)) + (match (^ (list "0" "2")) + (lefts (: (List (| Text Text)) + (list (+0 "0") (+1 "1") (+0 "2"))))) + (match (^ (list "1")) + (rights (: (List (| Text Text)) + (list (+0 "0") (+1 "1") (+0 "2"))))) + (match (^ [(list "0" "2") (list "1")]) + (partition (: (List (| Text Text)) + (list (+0 "0") (+1 "1") (+0 "2"))))) + (match 10 + (either (lambda [_] 10) (lambda [_] 20) (: (| Text Text) (+0 "")))) + (match 20 + (either (lambda [_] 10) (lambda [_] 20) (: (| Text Text) (+1 "")))) + )) diff --git a/stdlib/test/test/lux/data/text.lux b/stdlib/test/test/lux/data/text.lux new file mode 100644 index 000000000..640ae3f4c --- /dev/null +++ b/stdlib/test/test/lux/data/text.lux @@ -0,0 +1,150 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad) + (data ["&" text] + [char] + text/format + [number] + (struct [list])) + (codata function) + (math ["R" random]) + pipe) + lux/test) + +(test: "Size" + [size (:: @ map (%+ +100) R;nat) + sample (R;text size)] + (assert "" (or (and (=+ +0 size) + (&;empty? sample)) + (=+ size (&;size sample))))) + +(def: bounded-size + (R;Random Nat) + (|> R;nat + (:: R;Monad<Random> map (|>. (%+ +100) (++ +1))))) + +(test: "Locations" + [size bounded-size + idx (:: @ map (%+ size) R;nat) + sample (R;text size)] + (assert "" (|> sample + (&;at idx) + (case> (^=> (#;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 (<=+ idx io) + (>=+ idx lio) + + (=+ idx io') + (>=+ idx lio') + + (&;contains? char' sample)) + + _ + false + )) + )) + +(test: "Text functions" + [sizeL bounded-size + sizeR bounded-size + sampleL (R;text sizeL) + sampleR (R;text sizeR) + #let [sample (&;concat (list sampleL sampleR)) + fake-sample (&;join-with " " (list sampleL sampleR)) + dup-sample (&;join-with "" (list sampleL sampleR)) + enclosed-sample (&;enclose [sampleR sampleR] sampleL) + (^open) &;Eq<Text>]] + (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)))) + + _ + false)) + + (|> [(&;sub +0 sizeL sample) + (&;sub sizeL (&;size sample) sample) + (&;sub' sizeL sample) + (&;sub' +0 sample)] + (case> [(#;Right _l) (#;Right _r) (#;Right _r') (#;Right _f)] + (and (= sampleL _l) + (= sampleR _r) + (= _r _r') + (= sample _f)) + + _ + false)) + ) + )) + +(test: "More text functions" + [sizeS bounded-size + sizeP bounded-size + sizeL bounded-size + sep1 (R;text sizeS) + sep2 (R;text sizeS) + #let [part-gen (|> (R;text sizeP) + (R;filter (. not (&;contains? sep1))))] + parts (R;list sizeL part-gen) + #let [sample1 (&;concat (list;interpose sep1 parts)) + sample2 (&;concat (list;interpose sep2 parts)) + (^open) &;Eq<Text>]] + (assert "" (and (=+ (list;size parts) + (list;size (&;split-all-with sep1 sample1))) + (= sample2 + (&;replace sep1 sep2 sample1)) + ))) + +(test: "Other text functions" + (all (match "abc" (&;lower-case "ABC")) + (match "ABC" (&;upper-case "abc")) + (match "ABC" (&;trim " \tABC\n\r")) + )) + +(test: "Structures" + (all (assert "" (:: &;Ord<Text> < "bcd" "abc")) + (assert "" (not (:: &;Ord<Text> < "abc" "abc"))) + (assert "" (not (:: &;Ord<Text> < "abc" "bcd"))) + (assert "" (:: &;Ord<Text> <= "bcd" "abc")) + (assert "" (:: &;Ord<Text> <= "abc" "abc")) + (assert "" (not (:: &;Ord<Text> <= "abc" "bcd"))) + (assert "" (:: &;Ord<Text> > "abc" "bcd")) + (assert "" (not (:: &;Ord<Text> > "abc" "abc"))) + (assert "" (not (:: &;Ord<Text> > "bcd" "abc"))) + (assert "" (:: &;Ord<Text> >= "abc" "bcd")) + (assert "" (:: &;Ord<Text> >= "abc" "abc")) + (assert "" (not (:: &;Ord<Text> >= "bcd" "abc"))) + )) + +(test: "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) + + _ + false)))) diff --git a/stdlib/test/test/lux/data/text/format.lux b/stdlib/test/test/lux/data/text/format.lux new file mode 100644 index 000000000..cd15c8584 --- /dev/null +++ b/stdlib/test/test/lux/data/text/format.lux @@ -0,0 +1,22 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad) + (data text/format + [number]) + (codata function)) + lux/test) + +(test: "Formatters" + (all (match "true" (%b true)) + (match "123" (%i 123)) + (match "123.456" (%r 123.456)) + (match "#\"t\"" (%c #"t")) + (match "\"YOLO\"" (%t "YOLO")) + (match "User-id: 123 -- Active: true" (format "User-id: " (%i 123) " -- Active: " (%b true))) + )) diff --git a/stdlib/test/test/lux/host.lux b/stdlib/test/test/lux/host.lux new file mode 100644 index 000000000..109d8dfed --- /dev/null +++ b/stdlib/test/test/lux/host.lux @@ -0,0 +1,54 @@ +(;module: + lux + (lux (control monad) + (data text/format + [number] + [product]) + (codata function + [io]) + host) + lux/test) + +(jvm-import java.lang.Object + (new [])) + +(jvm-import java.lang.String) + +(jvm-import (java.lang.Class a) + (getName [] String)) + +(test: "lux/host exports" + (let% [<conversions-0> (do-template [<value> <forward> <backward>] + [(match <value> (|> <value> <forward> <backward>))] + + [123 l2d d2l] + [123 l2f f2l] + [123 l2i i2l] + [123.0 d2l l2d] + [123.0 d2f f2d] + [123.0 d2i i2d] + ) + <conversions-1> (do-template [<forward> <backward>] + [(match 123 (|> 123 l2i <forward> <backward> i2l))] + + [i2c c2i] + )] + (test-all (match "java.lang.Class" (Class.getName [] (class-for java.lang.Class))) + (match "java.lang.Class" (Class.getName [] (class-for Class))) + (match true (null? (: Object (null)))) + (match false (null? (Object.new []))) + (match #;None (: (Maybe Object) (??? (null)))) + (match (#;Some _) (: (Maybe Object) (??? (Object.new [])))) + (match true (null? (!!! (: (Maybe Object) (??? (null)))))) + (match false (null? (!!! (: (Maybe Object) (??? (Object.new [])))))) + (match true (instance? Object (Object.new []))) + (match false (instance? String (Object.new []))) + (match 123 (synchronized (Object.new []) + 123)) + (match +10 (array-length (array String +10))) + (match "YOLO" (let [array (array String +10)] + (exec (array-store +0 "YOLO" array) + (array-load +0 array)))) + <conversions-0> + <conversions-1> + ))) diff --git a/stdlib/test/test/lux/lexer.lux b/stdlib/test/test/lux/lexer.lux new file mode 100644 index 000000000..d0b17fe4b --- /dev/null +++ b/stdlib/test/test/lux/lexer.lux @@ -0,0 +1,133 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + [lux #- not] + (lux (control monad) + (codata [io]) + (data error) + [test #- fail assert] + lexer)) + +## [Tests] +(test: "Lexer end works" + (test-all (should-pass (run end "")) + (should-fail (run end "YOLO")))) + +(test: "Simple text lexers" + (test-all (match (#;Right "YO") + (run (this "YO") "YOLO")) + (should-fail (run (this "YO") "MEME")))) + +(test: "Char lexers" + (test-all (match (#;Right #"Y") + (run (this-char #"Y") "YOLO")) + (should-fail (run (this-char #"Y") "MEME")) + (match (#;Right #"Y") + (run (char-range #"X" #"Z") "YOLO")) + (should-fail (run (char-range #"X" #"Z") "MEME")) + (match (#;Right #"Y") + (run upper "YOLO")) + (should-fail (run upper "meme")) + (match (#;Right #"y") + (run lower "yolo")) + (should-fail (run lower "MEME")) + (match (#;Right #"1") + (run digit "1")) + (should-fail (run digit " ")) + (match (#;Right #"7") + (run oct-digit "7")) + (should-fail (run oct-digit "8")) + (match (#;Right #"A") + (run any "A")) + (should-fail (run any "")))) + +(test: "Combinators" + (test-all (match (#;Right [#"Y" #"O"]) + (run (seq any any) "YOLO")) + (should-fail (run (seq any any) "Y")) + (match+ (#;Left #"0") + (should-pass (run (alt digit upper) "0"))) + (match+ (#;Right #"A") + (should-pass (run (alt digit upper) "A"))) + (should-fail (run (alt digit upper) "a")) + (should-pass (run (not (alt digit upper)) "a")) + (should-fail (run (not (alt digit upper)) "A")) + (match (#;Right #"0") + (run (either digit upper) "0")) + (match (#;Right #"A") + (run (either digit upper) "A")) + (should-fail (run (either digit upper) "a")) + (match (#;Right #"A") + (run alpha "A")) + (match (#;Right #"a") + (run alpha "a")) + (should-fail (run alpha "1")) + (match (#;Right #"A") + (run alpha-num "A")) + (match (#;Right #"a") + (run alpha-num "a")) + (match (#;Right #"1") + (run alpha-num "1")) + (should-fail (run alpha-num " ")) + (match (#;Right #"1") + (run hex-digit "1")) + (match (#;Right #"a") + (run hex-digit "a")) + (match (#;Right #"A") + (run hex-digit "A")) + (should-fail (run hex-digit " ")) + (match (#;Right #" ") + (run space " ")) + (should-fail (run space "8")) + (match (#;Right #"C") + (run (one-of "ABC") "C")) + (should-fail (run (one-of "ABC") "D")) + (match (#;Right #"D") + (run (none-of "ABC") "D")) + (should-fail (run (none-of "ABC") "C")) + (match (#;Right #"D") + (run (satisfies (lambda [c] true)) "D")) + (should-fail (run (satisfies (lambda [c] false)) "C")) + (match (#;Right "0123456789ABCDEF") + (run (many' hex-digit) "0123456789ABCDEF yolo")) + (should-fail (run (many' hex-digit) "yolo")) + (match (#;Right "") + (run (some' hex-digit) "yolo")) + )) + +(test: "Yet more combinators..." + (test-all (should-fail (run (fail "Well, it really SHOULD fail...") "yolo")) + (should-fail (run (assert false "Well, it really SHOULD fail...") "yolo")) + (should-pass (run (assert true "GO, GO, GO!") "yolo")) + (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F"))) + (run (many hex-digit) "0123456789ABCDEF yolo")) + (should-fail (run (many hex-digit) "yolo")) + (match (^ (#;Right (list))) + (run (some hex-digit) "yolo")) + (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F"))) + (run (exactly +16 hex-digit) "0123456789ABCDEF yolo")) + (match (^ (#;Right (list #"0" #"1" #"2"))) + (run (exactly +3 hex-digit) "0123456789ABCDEF yolo")) + (should-fail (run (exactly +17 hex-digit) "0123456789ABCDEF yolo")) + (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F"))) + (run (at-most +16 hex-digit) "0123456789ABCDEF yolo")) + (match (^ (#;Right (list #"0" #"1" #"2"))) + (run (at-most +3 hex-digit) "0123456789ABCDEF yolo")) + (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F"))) + (run (at-most +17 hex-digit) "0123456789ABCDEF yolo")) + (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F"))) + (run (between +0 +16 hex-digit) "0123456789ABCDEF yolo")) + (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F"))) + (run (between +3 +16 hex-digit) "0123456789ABCDEF yolo")) + (should-fail (run (between +17 +100 hex-digit) "0123456789ABCDEF yolo")) + (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F"))) + (run (between +15 +20 hex-digit) "0123456789ABCDEF yolo")) + (match (#;Right (#;Some #"1")) (run (opt hex-digit) "123abc")) + (match (#;Right #;None) (run (opt hex-digit) "yolo")) + (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"a" #"b" #"c" #"d" #"e" #"f"))) + (run (sep-by space hex-digit) "0 1 2 3 4 5 6 7 8 9 a b c d e f YOLO")) + (match (#;Right "yolo") (run get-input "yolo")) + )) diff --git a/stdlib/test/test/lux/macro/ast.lux b/stdlib/test/test/lux/macro/ast.lux new file mode 100644 index 000000000..b06efce01 --- /dev/null +++ b/stdlib/test/test/lux/macro/ast.lux @@ -0,0 +1,31 @@ +(;module: + lux + (lux (codata [io]) + (control monad) + (data [text "Text/" Monoid<Text>] + [number]) + (macro ast) + (codata function)) + lux/test) + +(test: "lux/macro/ast exports" + (let% [<tests> (do-template [<expr> <text> <pattern>] + [(match <pattern> <expr>) + (match <text> (ast-to-text <expr>)) + (match true (:: Eq<AST> = <expr> <expr>))] + + [(bool true) "true" [["" -1 -1] (#;BoolS true)]] + [(bool false) "false" [_ (#;BoolS false)]] + [(int 123) "123" [_ (#;IntS 123)]] + [(real 123.0) "123.0" [_ (#;RealS 123.0)]] + [(char #"\n") "#\"\\n\"" [_ (#;CharS #"\n")]] + [(text "\n") "\"\\n\"" [_ (#;TextS "\n")]] + [(tag ["yolo" "lol"]) "#yolo;lol" [_ (#;TagS ["yolo" "lol"])]] + [(symbol ["yolo" "lol"]) "yolo;lol" [_ (#;SymbolS ["yolo" "lol"])]] + [(form (list (bool true) (int 123))) "(true 123)" (^ [_ (#;FormS (list [_ (#;BoolS true)] [_ (#;IntS 123)]))])] + [(tuple (list (bool true) (int 123))) "[true 123]" (^ [_ (#;TupleS (list [_ (#;BoolS true)] [_ (#;IntS 123)]))])] + [(record (list [(bool true) (int 123)])) "{true 123}" (^ [_ (#;RecordS (list [[_ (#;BoolS true)] [_ (#;IntS 123)]]))])] + [(local-tag "lol") "#lol" [_ (#;TagS ["" "lol"])]] + [(local-symbol "lol") "lol" [_ (#;SymbolS ["" "lol"])]] + )] + (test-all <tests>))) diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux new file mode 100644 index 000000000..99f8550c0 --- /dev/null +++ b/stdlib/test/test/lux/macro/syntax.lux @@ -0,0 +1,176 @@ +(;module: + lux + (lux (codata [io]) + (control monad) + (data [text "Text/" Monoid<Text>] + [number]) + (macro [ast] + ["s" syntax #+ syntax: Syntax]) + (codata function)) + lux/test) + +(test: "lux/macro/syntax exports [Part 1]" + (let% [<simple-tests> (do-template [<pattern> <expr> <get> <ask> <demand>] + [(match (#;Right [_ <pattern>]) + (s;run (list <expr>) + <get>)) + (match (#;Right [_ true]) + (s;run (list <expr>) + (<ask> <pattern>))) + (match (#;Right [_ []]) + (s;run (list <expr>) + (<demand> <pattern>)))] + + [true (ast;bool true) s;bool s;bool? s;bool!] + [123 (ast;int 123) s;int s;int? s;int!] + [123.0 (ast;real 123.0) s;real s;real? s;real!] + [#"\n" (ast;char #"\n") s;char s;char? s;char!] + ["\n" (ast;text "\n") s;text s;text? s;text!] + [["yolo" "lol"] (ast;symbol ["yolo" "lol"]) s;symbol s;symbol? s;symbol!] + [["yolo" "lol"] (ast;tag ["yolo" "lol"]) s;tag s;tag? s;tag!] + ) + <group-tests> (do-template [<parser> <ctor>] + [(match (#;Right [_ [true 123]]) + (s;run (list (<ctor> (list (ast;bool true) (ast;int 123)))) + (<parser> (s;seq s;bool s;int)))) + (match (#;Right [_ true]) + (s;run (list (<ctor> (list (ast;bool true)))) + (<parser> s;bool))) + (match (#;Left _) + (s;run (list (<ctor> (list (ast;bool true) (ast;int 123)))) + (<parser> s;bool))) + (match (#;Right [_ (#;Left true)]) + (s;run (list (<ctor> (list (ast;bool true)))) + (<parser> (s;alt s;bool s;int)))) + (match (#;Right [_ (#;Right 123)]) + (s;run (list (<ctor> (list (ast;int 123)))) + (<parser> (s;alt s;bool s;int)))) + (match (#;Left _) + (s;run (list (<ctor> (list (ast;real 123.0)))) + (<parser> (s;alt s;bool s;int))))] + + [s;form ast;form] + [s;tuple ast;tuple])] + (test-all (match (#;Right [_ [_ (#;BoolS true)]]) + (s;run (list (ast;bool true) (ast;int 123)) + s;any)) + <simple-tests> + (match (#;Right [_ []]) + (s;run (list (ast;bool true) (ast;int 123)) + (s;assert true "yolo"))) + (match (#;Left _) + (s;run (list (ast;bool true) (ast;int 123)) + (s;assert false "yolo"))) + (match (#;Right [_ +123]) + (s;run (list (ast;nat +123)) + s;nat)) + (match (#;Left _) + (s;run (list (ast;int -123)) + s;nat)) + (match (#;Right [_ "yolo"]) + (s;run (list (ast;local-symbol "yolo")) + s;local-symbol)) + (match (#;Left _) + (s;run (list (ast;symbol ["yolo" "lol"])) + s;local-symbol)) + (match (#;Right [_ "yolo"]) + (s;run (list (ast;local-tag "yolo")) + s;local-tag)) + (match (#;Left _) + (s;run (list (ast;tag ["yolo" "lol"])) + s;local-tag)) + <group-tests> + ))) + +(test: "lux/macro/syntax exports [Part 2]" + (test-all (match (#;Right [_ [true 123]]) + (s;run (list (ast;record (list [(ast;bool true) (ast;int 123)]))) + (s;record (s;seq s;bool s;int)))) + (match (#;Right [_ (#;Some +123)]) + (s;run (list (ast;nat +123)) + (s;opt s;nat))) + (match (#;Right [_ #;None]) + (s;run (list (ast;int -123)) + (s;opt s;nat))) + (match (^ (#;Right [_ (list +123 +456 +789)])) + (s;run (list (ast;nat +123) (ast;nat +456) (ast;nat +789)) + (s;some s;nat))) + (match (^ (#;Right [_ (list)])) + (s;run (list (ast;int -123)) + (s;some s;nat))) + (match (^ (#;Right [_ (list +123 +456 +789)])) + (s;run (list (ast;nat +123) (ast;nat +456) (ast;nat +789)) + (s;many s;nat))) + (match (^ (#;Right [_ (list +123)])) + (s;run (list (ast;nat +123)) + (s;many s;nat))) + (match (#;Left _) + (s;run (list (ast;int -123)) + (s;many s;nat))) + (match (#;Right [_ 123]) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;either s;pos-int s;int))) + (match (#;Right [_ -123]) + (s;run (list (ast;int -123) (ast;int 456) (ast;int 789)) + (s;either s;pos-int s;int))) + (match (#;Left _) + (s;run (list (ast;bool true) (ast;int 456) (ast;int 789)) + (s;either s;pos-int s;int))) + (match (#;Right [_ true]) + (s;run (list) + s;end?)) + (match (#;Right [_ false]) + (s;run (list (ast;bool true)) + s;end?)) + (match (#;Right [_ []]) + (s;run (list) + s;end)) + (match (#;Left _) + (s;run (list (ast;bool true)) + s;end)) + (match (^ (#;Right [_ (list 123 456 789)])) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;exactly +3 s;int))) + (match (^ (#;Right [_ (list 123 456)])) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;exactly +2 s;int))) + (match (#;Left _) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;exactly +4 s;int))) + (match (^ (#;Right [_ (list 123 456 789)])) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;at-least +3 s;int))) + (match (^ (#;Right [_ (list 123 456 789)])) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;at-least +2 s;int))) + (match (#;Left _) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;at-least +4 s;int))) + (match (^ (#;Right [_ (list 123 456 789)])) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;at-most +3 s;int))) + (match (^ (#;Right [_ (list 123 456)])) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;at-most +2 s;int))) + (match (^ (#;Right [_ (list 123 456 789)])) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;at-most +4 s;int))) + (match (^ (#;Right [_ (list 123 456 789)])) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;between +3 +10 s;int))) + (match (#;Left _) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;between +4 +10 s;int))) + (match (^ (#;Right [_ (list 123 456 789)])) + (s;run (list (ast;int 123) (ast;text "YOLO") (ast;int 456) (ast;text "YOLO") (ast;int 789)) + (s;sep-by (s;text! "YOLO") s;int))) + (match (^ (#;Right [_ (list 123 456)])) + (s;run (list (ast;int 123) (ast;text "YOLO") (ast;int 456) (ast;int 789)) + (s;sep-by (s;text! "YOLO") s;int))) + (match (#;Left _) + (s;run (list (ast;int 123) (ast;int 456) (ast;int 789)) + (s;not s;int))) + (match (#;Right [_ []]) + (s;run (list (ast;bool true) (ast;int 456) (ast;int 789)) + (s;not s;int))) + )) diff --git a/stdlib/test/test/lux/math.lux b/stdlib/test/test/lux/math.lux new file mode 100644 index 000000000..3d5e053f7 --- /dev/null +++ b/stdlib/test/test/lux/math.lux @@ -0,0 +1,45 @@ +(;module: + lux + (lux (codata [io]) + (control monad) + (data [text "Text/" Monoid<Text>] + text/format + [number] + (struct [list "List/" Fold<List> Functor<List>]) + [product]) + (codata function) + math) + lux/test) + +(test: "lux/math exports" + (test-all (match 1.0 (cos 0.0)) + (match -1.0 (cos (/. 2.0 tau))) + ## (match 0.0 (cos (/. 4.0 tau))) + ## (match 0.0 (cos (*. (/. 4.0 3.0) tau))) + + (match 1.0 (sin (/. 4.0 tau))) + (match -1.0 (sin (*. (/. 4.0 3.0) tau))) + ## (match 0.0 (sin 0.0)) + ## (match 0.0 (sin (/. 2.0 tau))) + + (match 4 (ceil 3.75)) + (match 3 (floor 3.75)) + (match 4 (round 3.75)) + (match 3 (round 3.25)) + + (match 3.0 (cbrt 27.0)) + (match 4.0 (sqrt 16.0)) + + (match 90.0 (degrees (/. 4.0 tau))) + (match true (=. tau (radians (degrees tau)))) + + (match 9 (gcd 450 27)) + (match 40 (lcm 10 8)) + + (match 27 (infix 27)) + (match 9 (infix [27 gcd 450])) + (match 9 (infix [(* 3 9) gcd 450])) + (match true (infix [#and 27 < 450 < 2000])) + (match true (infix [#and 27 < 450 > 200])) + (match true (infix [[27 < 450] and [200 < 2000]])) + )) diff --git a/stdlib/test/test/lux/pipe.lux b/stdlib/test/test/lux/pipe.lux new file mode 100644 index 000000000..a601bbf98 --- /dev/null +++ b/stdlib/test/test/lux/pipe.lux @@ -0,0 +1,47 @@ +(;module: + lux + (lux (codata [io]) + (control monad) + (data text/format + [number] + [product] + identity) + (codata function) + pipe) + lux/test) + +(test: "lux/pipe exports" + (test-all (match 1 (|> 20 + (* 3) + (+ 4) + (_> 0 inc))) + (match 10 (|> 5 + (@> [(+ @ @)]))) + (match 15 (|> 5 + (?> [even?] [(* 2)] + [odd?] [(* 3)] + [(_> -1)]))) + (match 15 (|> 5 + (?> [even?] [(* 2)] + [odd?] [(* 3)]))) + (match 10 (|> 1 + (!> [(< 10)] + [inc]))) + (match 20 (|> 5 + (%> Monad<Identity> + [(* 3)] + [(+ 4)] + [inc]))) + (match "five" (|> 5 + (case> 0 "zero" + 1 "one" + 2 "two" + 3 "three" + 4 "four" + 5 "five" + 6 "six" + 7 "seven" + 8 "eight" + 9 "nine" + _ "???"))) + )) diff --git a/stdlib/test/test/lux/regex.lux b/stdlib/test/test/lux/regex.lux new file mode 100644 index 000000000..66355bdca --- /dev/null +++ b/stdlib/test/test/lux/regex.lux @@ -0,0 +1,200 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (codata [io]) + (control monad) + (data error + [product]) + [compiler] + (macro [ast] + ["s" syntax #+ syntax:]) + test + [lexer] + regex)) + +(syntax: (should-regex {veredict (s;alt s;bool s;any)} {regex s;text} {input s;text}) + (case veredict + (+0 ?) + (if ? + (wrap (list (` (match+ (~ (ast;text input)) + (should-pass (lexer;run (regex (~ (ast;text regex))) + (~ (ast;text input)))))))) + (wrap (list (` (should-fail (lexer;run (regex (~ (ast;text regex))) + (~ (ast;text input)))))))) + + (+1 result) + (wrap (list (` (match+ (~ result) + (should-pass (lexer;run (regex (~ (ast;text regex))) + (~ (ast;text input)))))))))) + +## [Tests] +(test: "Regular Expressions [Basics]" + (test-all (should-regex true "a" "a") + (should-regex false "a" ".") + (should-regex true "\\." ".") + (should-regex false "\\." "a") + )) + +(test: "Regular Expressions [System character classes]" + (test-all (should-regex true "." "a") + + (should-regex true "\\d" "0") + (should-regex false "\\d" "m") + (should-regex true "\\D" "m") + (should-regex false "\\D" "0") + + (should-regex true "\\s" " ") + (should-regex false "\\s" "m") + (should-regex true "\\S" "m") + (should-regex false "\\S" " ") + + (should-regex true "\\w" "_") + (should-regex false "\\w" "^") + (should-regex true "\\W" ".") + (should-regex false "\\W" "a") + + (should-regex true "\\p{Lower}" "m") + (should-regex false "\\p{Lower}" "M") + + (should-regex true "\\p{Upper}" "M") + (should-regex false "\\p{Upper}" "m") + + (should-regex true "\\p{Alpha}" "M") + (should-regex false "\\p{Alpha}" "0") + + (should-regex true "\\p{Digit}" "1") + (should-regex false "\\p{Digit}" "n") + + (should-regex true "\\p{Alnum}" "1") + (should-regex false "\\p{Alnum}" ".") + + (should-regex true "\\p{Space}" " ") + (should-regex false "\\p{Space}" ".") + + (should-regex true "\\p{HexDigit}" "a") + (should-regex false "\\p{HexDigit}" ".") + + (should-regex true "\\p{OctDigit}" "6") + (should-regex false "\\p{OctDigit}" ".") + + (should-regex true "\\p{Blank}" "\t") + (should-regex false "\\p{Blank}" ".") + + (should-regex true "\\p{ASCII}" "\t") + (should-regex false "\\p{ASCII}" "\u1234") + + (should-regex true "\\p{Contrl}" "\u0012") + (should-regex false "\\p{Contrl}" "a") + + (should-regex true "\\p{Punct}" "@") + (should-regex false "\\p{Punct}" "a") + + (should-regex true "\\p{Graph}" "@") + (should-regex false "\\p{Graph}" " ") + + (should-regex true "\\p{Print}" "\u0020") + (should-regex false "\\p{Print}" "\u1234") + )) + +(test: "Regular Expressions [Custom character classes]" + (test-all (should-regex true "[abc]" "a") + (should-regex false "[abc]" "m") + + (should-regex true "[a-z]" "a") + (should-regex true "[a-z]" "m") + (should-regex true "[a-z]" "z") + + (should-regex true "[a-zA-Z]" "a") + (should-regex true "[a-zA-Z]" "m") + (should-regex true "[a-zA-Z]" "z") + (should-regex true "[a-zA-Z]" "A") + (should-regex true "[a-zA-Z]" "M") + (should-regex true "[a-zA-Z]" "Z") + + (should-regex false "[^abc]" "a") + (should-regex true "[^abc]" "m") + + (should-regex false "[^a-z]" "a") + (should-regex true "[^a-z]" "0") + (should-regex false "[^a-zA-Z]" "a") + (should-regex true "[^a-zA-Z]" "0") + + (should-regex false "[a-z&&[def]]" "a") + (should-regex true "[a-z&&[def]]" "d") + + (should-regex true "[a-z&&[^bc]]" "a") + (should-regex false "[a-z&&[^bc]]" "b") + + (should-regex true "[a-z&&[^m-p]]" "a") + (should-regex false "[a-z&&[^m-p]]" "m") + (should-regex false "[a-z&&[^m-p]]" "p") + )) + +(test: "Regular Expressions [Reference]" + (test-all (let [number (regex "\\d+")] + (should-regex ["809-345-6789" "809" "345" "6789"] "(\\@<number>)-(\\@<number>)-(\\@<number>)" "809-345-6789")) + )) + +(test: "Regular Expressions [Quantifiers]" + (test-all (should-regex "aa" "aa" "aa") + + (should-regex "a" "a?" "a") + (should-regex "" "a?" "") + + (should-regex "aaa" "a*" "aaa") + (should-regex "" "a*" "") + + (should-regex "aaa" "a+" "aaa") + (should-regex "a" "a+" "a") + (should-regex false "a+" "") + + (should-regex "aa" "a{2}" "aa") + (should-regex "a" "a{1}" "aa") + (should-regex false "a{3}" "aa") + + (should-regex "aa" "a{1,}" "aa") + (should-regex "aa" "a{2,}" "aa") + (should-regex false "a{3,}" "aa") + + (should-regex "a" "a{,1}" "aa") + (should-regex "aa" "a{,2}" "aa") + (should-regex "aa" "a{,3}" "aa") + + (should-regex "a" "a{1,2}" "a") + (should-regex "aa" "a{1,2}" "aa") + (should-regex "aa" "a{1,2}" "aaa") + )) + +(test: "Regular Expressions [Groups]" + (test-all (should-regex ["abc" "b"] "a(.)c" "abc") + (should-regex ["abbbbbc" "bbbbb"] "a(b+)c" "abbbbbc") + (should-regex ["809-345-6789" "809" "345" "6789"] "(\\d{3})-(\\d{3})-(\\d{4})" "809-345-6789") + (should-regex ["809-345-6789" "809" "6789"] "(\\d{3})-(?:\\d{3})-(\\d{4})" "809-345-6789") + (should-regex ["809-809-6789" "809" "6789"] "(\\d{3})-\\0-(\\d{4})" "809-809-6789") + (should-regex ["809-809-6789" "809" "6789"] "(?<code>\\d{3})-\\k<code>-(\\d{4})" "809-809-6789") + (should-regex ["809-809-6789-6789" "809" "6789"] "(?<code>\\d{3})-\\k<code>-(\\d{4})-\\0" "809-809-6789-6789") + + (should-regex ["809-345-6789" "809" ["345-6789" "345" "6789"]] "(\\d{3})-((\\d{3})-(\\d{4}))" "809-345-6789") + )) + +(test: "Regular Expressions [Alternation]" + (test-all (should-regex ["a" (+0 [])] "a|b" "a") + (should-regex ["b" (+1 [])] "a|b" "b") + (should-regex false "a|b" "c") + + (should-regex ["abc" (+0 "b")] "a(.)c|b(.)d" "abc") + (should-regex ["bcd" (+1 "c")] "a(.)c|b(.)d" "bcd") + (should-regex false "a(.)c|b(.)d" "cde") + + (should-regex ["abc" (+0 ["b" "c"])] "a(.)(.)|b(.)(.)" "abc") + (should-regex ["bcd" (+1 ["c" "d"])] "a(.)(.)|b(.)(.)" "bcd") + (should-regex false "a(.)(.)|b(.)(.)" "cde") + + (should-regex ["809-345-6789" (+0 ["809" "345-6789" "345" "6789"])] + "(\\d{3})-((\\d{3})-(\\d{4}))|b(.)d" + "809-345-6789") + )) diff --git a/stdlib/test/test/lux/type.lux b/stdlib/test/test/lux/type.lux new file mode 100644 index 000000000..8fa871e70 --- /dev/null +++ b/stdlib/test/test/lux/type.lux @@ -0,0 +1,41 @@ +(;module: + lux + (lux (codata [io]) + (control monad) + (data [text "Text/" Monoid<Text>] + [number]) + type + (codata function)) + lux/test) + +(test: "lux/type exports" + (let% [<eq-tests> (do-template [<type>] + [(match true (:: Eq<Type> = <type> <type>))] + + [(#;HostT "java.util.List" (list Int))] + [#;UnitT] + [#;VoidT] + [(#;VarT +123)] + [(#;ExT +123)] + [(#;BoundT +123)] + [(#;LambdaT Bool Int)] + [(#;AppT List Int)] + [(#;NamedT ["" "Int-List"] (#;AppT List Int))] + [(#;SumT Bool Int)] + [(#;ProdT Bool Int)] + [(#;UnivQ (list) (#;ProdT Bool (#;BoundT +1)))] + [(#;ExQ (list) (#;ProdT Bool (#;BoundT +1)))] + )] + (test-all <eq-tests> + (match (^=> (#;Some _type) (:: Eq<Type> = _type (#;ProdT Bool Int))) + (apply-type (type (Meta Bool)) Int)) + (match #;None (apply-type Text Bool)) + (match true + (:: Eq<Type> = + (#;NamedT ["" "a"] + (#;ProdT Bool Int)) + (un-alias (#;NamedT ["" "c"] + (#;NamedT ["" "b"] + (#;NamedT ["" "a"] + (#;ProdT Bool Int))))))) + ))) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux new file mode 100644 index 000000000..7b760c0f1 --- /dev/null +++ b/stdlib/test/tests.lux @@ -0,0 +1,84 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + +(;module: + lux + (lux (control monad) + (codata [io]) + (concurrency [promise]) + [cli #+ program:] + [test]) + (test lux + (lux (data [bit] + [bool] + [char] + [error] + [ident] + [identity] + [log] + [maybe] + [number] + [product] + [sum] + [text] + [text/format] + (struct [array] + [dict] + [list] + [queue] + [set] + [stack] + [tree] + [vector] + [zipper] + ) + ) + ## (codata ["_;" io] + ## [env] + ## [state] + ## (struct [stream])) + ## (macro [ast] + ## [syntax]) + ## [type] + ## (concurrency ["_;" promise] + ## [frp] + ## [stm] + ## [actor] + ## ) + ## [host] + ## ["_;" cli] + ## [math] + ## [pipe] + ## [lexer] + ## [regex] + ## (data (format [json])) + ) + ) + ## (lux ## (codata [cont]) + ## ## (data (struct [stack] + ## ## [tree] + ## ## [zipper]) + ## ## (error exception)) + ## ## (concurrency [atom]) + ## ## [macro] + ## ## (macro [template] + ## ## [poly] + ## ## (poly ["poly_;" eq] + ## ## ["poly_;" text-encoder] + ## ## ["poly_;" functor])) + ## ## (math [ratio] + ## ## [complex] + ## ## [random]) + ## ## (type [check] [auto]) + ## ## (control [effect]) + ## ["_;" lexer] + ## ["_;" regex] + ## (data (format ["_;" json])) + ## ) + ) + +## [Program] +(program: args + (test;run)) |