diff options
Diffstat (limited to 'stdlib/test')
| -rw-r--r-- | stdlib/test/test/lux/data/coll/tree/zipper.lux | 73 | ||||
| -rw-r--r-- | stdlib/test/test/lux/data/format/xml.lux | 49 | ||||
| -rw-r--r-- | stdlib/test/test/lux/math.lux | 33 | ||||
| -rw-r--r-- | stdlib/test/tests.lux | 11 |
4 files changed, 108 insertions, 58 deletions
diff --git a/stdlib/test/test/lux/data/coll/tree/zipper.lux b/stdlib/test/test/lux/data/coll/tree/zipper.lux index b7936b140..9154459b9 100644 --- a/stdlib/test/test/lux/data/coll/tree/zipper.lux +++ b/stdlib/test/test/lux/data/coll/tree/zipper.lux @@ -3,23 +3,23 @@ (lux [io] (control [monad #+ do Monad] pipe) - (data (coll [list "List/" Fold<List> Functor<List>] + (data (coll [list "L/" Fold<List> Functor<List>] (tree ["&" zipper] [rose])) - [text "Text/" Monoid<Text>] + [text] text/format [number]) - ["R" math/random]) + ["r" math/random]) lux/test) (def: gen-tree - (R;Random (rose;Tree Nat)) - (R;rec (function [gen-tree] - (do R;Monad<Random> + (r;Random (rose;Tree Nat)) + (r;rec (function [gen-tree] + (do r;Monad<Random> ## Each branch can have, at most, 1 child. - [size (|> R;nat (:: @ map (n.% +2)))] - (R;seq R;nat - (R;list size gen-tree)))))) + [size (|> r;nat (:: @ map (n.% +2)))] + (r;seq r;nat + (r;list size gen-tree)))))) (def: (to-end zipper) (All [a] (-> (&;Zipper a) (&;Zipper a))) @@ -28,35 +28,34 @@ zipper (recur (&;next zipper))))) -(context: "Zippers" +(context: "Zippers." [sample gen-tree - new-val R;nat - pre-val R;nat - post-val R;nat - #let [(^open "Tree/") (rose;Eq<Tree> number;Eq<Nat>) - (^open "List/") (list;Eq<List> number;Eq<Nat>)]] + new-val r;nat + pre-val r;nat + post-val r;nat + #let [(^open "tree/") (rose;Eq<Tree> number;Eq<Nat>) + (^open "L/") (list;Eq<List> number;Eq<Nat>)]] ($_ seq (test "Trees can be converted to/from zippers." (|> sample - &;from-tree &;to-tree - (Tree/= sample))) + &;zip &;unzip + (tree/= sample))) (test "Creating a zipper gives you a root node." - (|> sample &;from-tree &;root?)) + (|> sample &;zip &;root?)) (test "Can move down inside branches. Can move up from lower nodes." - (let [zipper (&;from-tree sample)] + (let [zipper (&;zip sample)] (if (&;branch? zipper) (let [child (|> zipper &;down)] - (and (not (Tree/= sample (&;to-tree child))) - (|> child &;parent (default (undefined)) (is zipper)) + (and (not (tree/= sample (&;unzip child))) (|> child &;up (is zipper) not) (|> child &;root (is zipper) not))) (and (&;leaf? zipper) (|> zipper (&;prepend-child new-val) &;branch?))))) (test "Can prepend and append children." - (let [zipper (&;from-tree sample)] + (let [zipper (&;zip sample)] (if (&;branch? zipper) (let [mid-val (|> zipper &;down &;value) zipper (|> zipper @@ -71,7 +70,7 @@ true))) (test "Can insert children around a node (unless it's root)." - (let [zipper (&;from-tree sample)] + (let [zipper (&;zip sample)] (if (&;branch? zipper) (let [mid-val (|> zipper &;down &;value) zipper (|> zipper @@ -93,26 +92,26 @@ #;None true)))))) (test "Can set and update the value of a node." - (|> sample &;from-tree (&;set new-val) &;value (n.= new-val))) + (|> sample &;zip (&;set new-val) &;value (n.= new-val))) (test "Zipper traversal follows the outline of the tree depth-first." - (List/= (rose;flatten sample) - (loop [zipper (&;from-tree sample)] - (if (&;end? zipper) - (list (&;value zipper)) - (#;Cons (&;value zipper) - (recur (&;next zipper))))))) + (L/= (rose;flatten sample) + (loop [zipper (&;zip sample)] + (if (&;end? zipper) + (list (&;value zipper)) + (#;Cons (&;value zipper) + (recur (&;next zipper))))))) (test "Backwards zipper traversal yield reverse tree flatten." - (List/= (list;reverse (rose;flatten sample)) - (loop [zipper (to-end (&;from-tree sample))] - (if (&;root? zipper) - (list (&;value zipper)) - (#;Cons (&;value zipper) - (recur (&;prev zipper))))))) + (L/= (list;reverse (rose;flatten sample)) + (loop [zipper (to-end (&;zip sample))] + (if (&;root? zipper) + (list (&;value zipper)) + (#;Cons (&;value zipper) + (recur (&;prev zipper))))))) (test "Can remove nodes (except root nodes)." - (let [zipper (&;from-tree sample)] + (let [zipper (&;zip sample)] (if (&;branch? zipper) (and (|> zipper &;down &;root? not) (|> zipper &;down &;remove (case> #;None false diff --git a/stdlib/test/test/lux/data/format/xml.lux b/stdlib/test/test/lux/data/format/xml.lux index 1910caf3e..382659ab0 100644 --- a/stdlib/test/test/lux/data/format/xml.lux +++ b/stdlib/test/test/lux/data/format/xml.lux @@ -2,13 +2,15 @@ lux (lux [io] (control [monad #+ do Monad] + ["p" parser] pipe) - (data [text "Text/" Monoid<Text>] + (data [text "text/" Eq<Text>] text/format [ident] + ["R" result] (format ["&" xml]) (coll [dict] - [list])) + [list "L/" Functor<List>])) ["r" math/random "r/" Monad<Random>] test) ) @@ -52,7 +54,7 @@ (r;dict ident;Hash<Ident> size xml-identifier^ (xml-text^ +0 +10)) (r;list size gen-xml))))))) -(context: "XML" +(context: "XML." [sample gen-xml #let [(^open "&/") &;Eq<XML> (^open "&/") &;Codec<Text,XML>]] @@ -68,3 +70,44 @@ (#;Left error) false))) )) + +(context: "Parsing." + [text (xml-text^ +1 +10) + num-children (|> r;nat (:: @ map (n.% +5))) + children (r;list num-children (xml-text^ +1 +10)) + tag xml-identifier^ + attr xml-identifier^ + value (xml-text^ +1 +10) + #let [node (#&;Node tag + (dict;put attr value &;attrs) + (L/map (|>. #&;Text) children))]] + ($_ seq + (test "Can parse text." + (R;default false + (do R;Monad<Result> + [output (&;run (#&;Text text) + &;text)] + (wrap (text/= text output))))) + (test "Can parse attributes." + (R;default false + (do R;Monad<Result> + [output (|> (&;attr attr) + (p;before &;ignore) + (&;run node))] + (wrap (text/= value output))))) + (test "Can parse nodes." + (R;default false + (do R;Monad<Result> + [_ (|> (&;node tag) + (p;before &;ignore) + (&;run node))] + (wrap true)))) + (test "Can parse children." + (R;default false + (do R;Monad<Result> + [outputs (|> (&;children (p;some &;text)) + (&;run node))] + (wrap (:: (list;Eq<List> text;Eq<Text>) = + children + outputs))))) + )) diff --git a/stdlib/test/test/lux/math.lux b/stdlib/test/test/lux/math.lux index 63a449965..701790886 100644 --- a/stdlib/test/test/lux/math.lux +++ b/stdlib/test/test/lux/math.lux @@ -8,7 +8,7 @@ [number "f/" Number<Frac>] (coll [list "List/" Fold<List> Functor<List>]) [product]) - ["R" math/random] + ["r" math/random] ["&" math]) lux/test) @@ -23,7 +23,7 @@ ## ## I won't be testing this, until I can figure out what's going on, or ## ## come up with my own implementation ## (context: "Trigonometry" -## [angle (|> R;frac (:: @ map (f.* &;tau)))] +## [angle (|> r;frac (:: @ map (f.* &;tau)))] ## ($_ seq ## (test "Sine and arc-sine are inverse functions." ## (|> angle &;sin &;asin (within? margin angle))) @@ -36,11 +36,11 @@ ## )) (context: "Roots" - [factor (|> R;nat (:: @ map (|>. (n.% +1000) + [factor (|> r;nat (:: @ map (|>. (n.% +1000) (n.max +1) nat-to-int int-to-frac))) - base (|> R;frac (:: @ map (f.* factor)))] + base (|> r;frac (:: @ map (f.* factor)))] ($_ seq (test "Square-root is inverse of square." (|> base (&;pow 2.0) &;root2 (f.= base))) @@ -50,7 +50,7 @@ )) (context: "Rounding" - [sample (|> R;frac (:: @ map (f.* 1000.0)))] + [sample (|> r;frac (:: @ map (f.* 1000.0)))] ($_ seq (test "The ceiling will be an integer value, and will be >= the original." (let [ceil'd (&;ceil sample)] @@ -71,12 +71,12 @@ )) (context: "Exponentials and logarithms" - [sample (|> R;frac (:: @ map (f.* 10.0)))] + [sample (|> r;frac (:: @ map (f.* 10.0)))] (test "Logarithm is the inverse of exponential." (|> sample &;exp &;log (within? 1.0e-15 sample)))) (context: "Greatest-Common-Divisor and Least-Common-Multiple" - [#let [gen-nat (|> R;nat (:: @ map (|>. (n.% +1000) (n.max +1))))] + [#let [gen-nat (|> r;nat (:: @ map (|>. (n.% +1000) (n.max +1))))] x gen-nat y gen-nat] ($_ (test "GCD" @@ -93,17 +93,24 @@ )) (context: "Infix syntax" - [x R;nat - y R;nat - z R;nat + [x r;nat + y r;nat + z r;nat + theta r;frac #let [top (|> x (n.max y) (n.max z)) bottom (|> x (n.min y) (n.min z))]] ($_ seq (test "Constant values don't change." - (n.= x (&;infix x))) + (n.= x + (&;infix x))) - (test "Can call infix functions." - (n.= (&;gcd y x) (&;infix [x &;gcd y]))) + (test "Can call binary functions." + (n.= (&;gcd y x) + (&;infix [x &;gcd y]))) + + (test "Can call unary functions." + (f.= (&;sin theta) + (&;infix [&;sin theta]))) (test "Can use regular syntax in the middle of infix code." (n.= (&;gcd +450 (n.* +3 +9)) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 598c488fd..62683aea5 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -52,10 +52,10 @@ ["_;" seq] ["_;" priority-queue] ["_;" stream] - (tree ["_;" rose] - ["_;" zipper]) - (ordered ["_o;" dict] - ["_o;" set])) + (tree ["tree_;" rose] + ["tree_;" zipper]) + (ordered ["ordered_;" dict] + ["ordered_;" set])) (text ["_;" format] ["_;" lexer] ["_;" regex])) @@ -85,7 +85,8 @@ [tainted] (format [context] [html] - [css])) + [css]) + (coll (tree ["tree_;" parser]))) [macro] (math [random]) (type [unit]) |