diff options
Diffstat (limited to 'stdlib/source/test/lux/data')
-rw-r--r-- | stdlib/source/test/lux/data/collection.lux | 2 | ||||
-rw-r--r-- | stdlib/source/test/lux/data/collection/tree/finger.lux | 133 |
2 files changed, 135 insertions, 0 deletions
diff --git a/stdlib/source/test/lux/data/collection.lux b/stdlib/source/test/lux/data/collection.lux index 497123614..bcbda46b9 100644 --- a/stdlib/source/test/lux/data/collection.lux +++ b/stdlib/source/test/lux/data/collection.lux @@ -17,6 +17,7 @@ ["#/." multi] ["#/." ordered]] ["#." tree + ["#/." finger] ["#/." zipper]]]) (def: dictionary @@ -46,6 +47,7 @@ Test ($_ _.and /tree.test + /tree/finger.test /tree/zipper.test )) diff --git a/stdlib/source/test/lux/data/collection/tree/finger.lux b/stdlib/source/test/lux/data/collection/tree/finger.lux new file mode 100644 index 000000000..a0dfabb54 --- /dev/null +++ b/stdlib/source/test/lux/data/collection/tree/finger.lux @@ -0,0 +1,133 @@ +(.module: + [lux #* + ["_" test (#+ Test)] + [abstract + [monad (#+ do)]] + [data + ["." maybe ("#@." functor)] + ["." text ("#@." equivalence monoid)] + [number + ["n" nat]]] + [math + ["." random]] + [type (#+ :by-example)]] + {1 + ["." /]}) + +(def: builder + (/.builder text.monoid)) + +(def: :@: + (:by-example [@] + {(/.Builder @ Text) + ..builder} + @)) + +(def: #export test + Test + (<| (_.covering /._) + (_.with-cover [/.Tree]) + (do {! random.monad} + [tag-left (random.ascii/alpha-num 1) + tag-right (random.filter (|>> (text@= tag-left) not) + (random.ascii/alpha-num 1)) + expected-left random.nat + expected-right random.nat] + ($_ _.and + (_.cover [/.Builder /.builder] + (exec (/.builder text.monoid) + true)) + (_.cover [/.tag] + (and (text@= tag-left + (/.tag (:: ..builder leaf tag-left expected-left))) + (text@= (text@compose tag-left tag-right) + (/.tag (:: ..builder branch + (:: ..builder leaf tag-left expected-left) + (:: ..builder leaf tag-right expected-right)))))) + (_.cover [/.root] + (and (case (/.root (:: ..builder leaf tag-left expected-left)) + (#.Left actual) + (n.= expected-left actual) + + (#.Right _) + false) + (case (/.root (:: ..builder branch + (:: ..builder leaf tag-left expected-left) + (:: ..builder leaf tag-right expected-right))) + (#.Left _) + false + + (#.Right [left right]) + (case [(/.root left) + (/.root right)] + [(#.Left actual-left) (#.Left actual-right)] + (and (n.= expected-left actual-left) + (n.= expected-right actual-right)) + + _ + false)))) + (_.cover [/.value] + (and (n.= expected-left + (/.value (:: ..builder leaf tag-left expected-left))) + (n.= expected-left + (/.value (:: ..builder branch + (:: ..builder leaf tag-left expected-left) + (:: ..builder leaf tag-right expected-right)))))) + (_.cover [/.search] + (let [can-find-correct-one! + (|> (:: ..builder leaf tag-left expected-left) + (/.search (text.contains? tag-left)) + (maybe@map (n.= expected-left)) + (maybe.default false)) + + cannot-find-incorrect-one! + (|> (:: ..builder leaf tag-right expected-right) + (/.search (text.contains? tag-left)) + (maybe@map (n.= expected-left)) + (maybe.default false) + not) + + can-find-left! + (|> (:: ..builder branch + (:: ..builder leaf tag-left expected-left) + (:: ..builder leaf tag-right expected-right)) + (/.search (text.contains? tag-left)) + (maybe@map (n.= expected-left)) + (maybe.default false)) + + can-find-right! + (|> (:: ..builder branch + (:: ..builder leaf tag-left expected-left) + (:: ..builder leaf tag-right expected-right)) + (/.search (text.contains? tag-right)) + (maybe@map (n.= expected-right)) + (maybe.default false))] + (and can-find-correct-one! + cannot-find-incorrect-one! + can-find-left! + can-find-right!))) + (_.cover [/.found?] + (let [can-find-correct-one! + (/.found? (text.contains? tag-left) + (:: ..builder leaf tag-left expected-left)) + + cannot-find-incorrect-one! + (not (/.found? (text.contains? tag-left) + (:: ..builder leaf tag-right expected-right))) + + can-find-left! + (/.found? (text.contains? tag-left) + (:: ..builder branch + (:: ..builder leaf tag-left expected-left) + (:: ..builder leaf tag-right expected-right))) + + can-find-right! + (/.found? (text.contains? tag-right) + (:: ..builder branch + (:: ..builder leaf tag-left expected-left) + (:: ..builder leaf tag-right expected-right)))] + (and can-find-correct-one! + cannot-find-incorrect-one! + can-find-left! + can-find-right!))) + )))) |