aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--stdlib/source/test/lux/control.lux4
-rw-r--r--stdlib/source/test/lux/control/parser/text.lux55
-rw-r--r--stdlib/source/test/lux/control/parser/tree.lux172
3 files changed, 214 insertions, 17 deletions
diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux
index f51e07767..9beb884b4 100644
--- a/stdlib/source/test/lux/control.lux
+++ b/stdlib/source/test/lux/control.lux
@@ -25,7 +25,8 @@
["#/." code]
["#/." json]
["#/." synthesis]
- ["#/." text]]
+ ["#/." text]
+ ["#/." tree]]
["#." pipe]
["#." reader]
["#." region]
@@ -69,6 +70,7 @@
/parser/json.test
/parser/synthesis.test
/parser/text.test
+ /parser/tree.test
))
(def: security
diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux
index 860d4b7bc..30ebe0cad 100644
--- a/stdlib/source/test/lux/control/parser/text.lux
+++ b/stdlib/source/test/lux/control/parser/text.lux
@@ -5,7 +5,7 @@
[monad (#+ do)]]
[control
["." try (#+ Try)]
- ["." exception]
+ ["." exception (#+ Exception)]
["." function]]
[data
["." maybe]
@@ -34,6 +34,15 @@
_
false))
+(def: (should-fail' sample parser exception)
+ (All [a e] (-> Text (/.Parser a) (Exception e) Bit))
+ (case (/.run parser sample)
+ (#try.Failure error)
+ (exception.match? exception error)
+
+ _
+ false))
+
(def: (should-fail sample parser)
(All [a] (-> Text (/.Parser a) Bit))
(case (/.run parser sample)
@@ -153,12 +162,16 @@
(text.contains? options)
not)
(random.char unicode.full))]
- (_.cover [/.one-of /.one-of!]
+ (_.cover [/.one-of /.one-of! /.character-should-be]
(and (..should-pass (text.from-code expected) (/.one-of options))
(..should-fail (text.from-code invalid) (/.one-of options))
+ (..should-fail' (text.from-code invalid) (/.one-of options)
+ /.character-should-be)
(..should-pass! (text.from-code expected) (/.one-of! options))
- (..should-fail (text.from-code invalid) (/.one-of options)))))
+ (..should-fail (text.from-code invalid) (/.one-of! options))
+ (..should-fail' (text.from-code invalid) (/.one-of! options)
+ /.character-should-be))))
(do {@ random.monad}
[#let [num-options 3]
options (|> (random.char unicode.full)
@@ -175,12 +188,16 @@
(text.contains? options)
not)
(random.char unicode.full))]
- (_.cover [/.none-of /.none-of!]
+ (_.cover [/.none-of /.none-of! /.character-should-not-be]
(and (..should-pass (text.from-code expected) (/.none-of options))
(..should-fail (text.from-code invalid) (/.none-of options))
+ (..should-fail' (text.from-code invalid) (/.none-of options)
+ /.character-should-not-be)
(..should-pass! (text.from-code expected) (/.none-of! options))
- (..should-fail (text.from-code invalid) (/.none-of! options)))))
+ (..should-fail (text.from-code invalid) (/.none-of! options))
+ (..should-fail' (text.from-code invalid) (/.none-of! options)
+ /.character-should-not-be))))
))
(def: runs
@@ -288,19 +305,23 @@
expected (random.unicode size)
dummy (|> (random.unicode size)
(random.filter (|>> (text@= expected) not)))]
- (_.cover [/.this]
+ (_.cover [/.this /.cannot-match]
(and (|> (/.run (/.this expected)
expected)
(!expect (#try.Success [])))
(|> (/.run (/.this expected)
dummy)
- (!expect (#try.Failure _))))))
- (do {@ random.monad}
- [expected (random.unicode 1)]
- (_.cover [/.Slice /.slice /.cannot-slice]
- (|> ""
- (/.run (/.slice /.any!))
- (!expect (^multi (#try.Failure error)
+ (!expect (^multi (#try.Failure error)
+ (exception.match? /.cannot-match error)))))))
+ (_.cover [/.Slice /.slice /.cannot-slice]
+ (|> ""
+ (/.run (do <>.monad
+ [#let [_ (log! " PRE SLICE")]
+ slice (/.slice /.any!)
+ #let [_ (log! "POST SLICE")]]
+ (wrap slice)))
+ (!expect (^multi (#try.Failure error)
+ (exec (log! (format "error = " error))
(exception.match? /.cannot-slice error))))))
(do {@ random.monad}
[expected (random.unicode 1)]
@@ -344,7 +365,8 @@
(/.run (do <>.monad
[pre /.get-input
_ /.any
- post /.get-input]
+ post /.get-input
+ _ /.any]
(wrap (and (text@= input pre)
(text@= right post)))))
(!expect (#try.Success #1)))))
@@ -411,9 +433,10 @@
(do {@ random.monad}
[expected (random.unicode 1)
invalid (random.unicode 1)]
- (_.cover [/.satisfies]
+ (_.cover [/.satisfies /.character-does-not-satisfy-predicate]
(and (..should-pass expected (/.satisfies (function.constant true)))
- (..should-fail invalid (/.satisfies (function.constant false))))))
+ (..should-fail' invalid (/.satisfies (function.constant false))
+ /.character-does-not-satisfy-predicate))))
..character-classes
..runs
)))
diff --git a/stdlib/source/test/lux/control/parser/tree.lux b/stdlib/source/test/lux/control/parser/tree.lux
new file mode 100644
index 000000000..d451e6298
--- /dev/null
+++ b/stdlib/source/test/lux/control/parser/tree.lux
@@ -0,0 +1,172 @@
+(.module:
+ [lux #*
+ ["_" test (#+ Test)]
+ [abstract
+ [monad (#+ do)]]
+ [control
+ ["." try]
+ ["." exception]]
+ [data
+ [number
+ ["n" nat]]
+ [collection
+ ["." tree
+ ["." zipper]]]]
+ [math
+ ["." random]]]
+ {1
+ ["." /
+ ["/#" //]]})
+
+(template: (!expect <pattern> <value>)
+ (case <value>
+ <pattern>
+ true
+
+ _
+ false))
+
+(template: (!cover <coverage> <parser> <sample>)
+ (do {@ random.monad}
+ [dummy random.nat
+ expected (|> random.nat (random.filter (|>> (n.= dummy) not)))]
+ (_.cover <coverage>
+ (|> (/.run <parser>
+ <sample>)
+ (!expect (^multi (#try.Success actual)
+ (n.= expected actual)))))))
+
+(template: (!cover2 <coverage> <parser> <sample0> <sample1>)
+ (do {@ random.monad}
+ [dummy random.nat
+ expected (|> random.nat (random.filter (|>> (n.= dummy) not)))]
+ (_.cover <coverage>
+ (and (|> (/.run <parser> <sample0>)
+ (!expect (^multi (#try.Success actual)
+ (n.= expected actual))))
+ (|> (/.run <parser> <sample1>)
+ (!expect (^multi (#try.Success actual)
+ (n.= expected actual))))))))
+
+(def: #export test
+ Test
+ (<| (_.covering /._)
+ (_.with-cover [/.Parser])
+ ($_ _.and
+ (!cover [/.run /.value]
+ /.value
+ (tree.leaf expected))
+ (do {@ random.monad}
+ [expected random.nat]
+ (_.cover [/.run']
+ (|> (/.run' /.value
+ (zipper.zip (tree.leaf expected)))
+ (!expect (^multi (#try.Success actual)
+ (n.= expected actual))))))
+ (!cover [/.down]
+ (do //.monad
+ [_ /.down]
+ /.value)
+ (tree.branch dummy
+ (list (tree.leaf expected))))
+ (!cover [/.up]
+ (do //.monad
+ [_ /.down
+ _ /.up]
+ /.value)
+ (tree.branch expected
+ (list (tree.leaf dummy))))
+ (!cover [/.right]
+ (do //.monad
+ [_ /.down
+ _ /.right]
+ /.value)
+ (tree.branch dummy
+ (list (tree.leaf dummy)
+ (tree.leaf expected))))
+ (!cover [/.left]
+ (do //.monad
+ [_ /.down
+ _ /.right
+ _ /.left]
+ /.value)
+ (tree.branch dummy
+ (list (tree.leaf expected)
+ (tree.leaf dummy))))
+ (!cover [/.rightmost]
+ (do //.monad
+ [_ /.down
+ _ /.rightmost]
+ /.value)
+ (tree.branch dummy
+ (list (tree.leaf dummy)
+ (tree.leaf dummy)
+ (tree.leaf expected))))
+ (!cover [/.leftmost]
+ (do //.monad
+ [_ /.down
+ _ /.rightmost
+ _ /.leftmost]
+ /.value)
+ (tree.branch dummy
+ (list (tree.leaf expected)
+ (tree.leaf dummy)
+ (tree.leaf dummy))))
+ (!cover2 [/.next]
+ (do //.monad
+ [_ /.next
+ _ /.next]
+ /.value)
+ (tree.branch dummy
+ (list (tree.branch dummy
+ (list (tree.leaf expected)))))
+ (tree.branch dummy
+ (list (tree.leaf dummy)
+ (tree.leaf expected))))
+ (!cover2 [/.prev]
+ (do //.monad
+ [_ /.next
+ _ /.next
+ _ /.prev]
+ /.value)
+ (tree.branch dummy
+ (list (tree.branch expected
+ (list (tree.leaf dummy)))))
+ (tree.branch dummy
+ (list (tree.leaf expected)
+ (tree.leaf dummy))))
+ (!cover2 [/.end]
+ (do //.monad
+ [_ /.end]
+ /.value)
+ (tree.branch dummy
+ (list (tree.branch dummy
+ (list (tree.leaf expected)))))
+ (tree.branch dummy
+ (list (tree.leaf dummy)
+ (tree.leaf expected))))
+ (!cover2 [/.start]
+ (do //.monad
+ [_ /.end
+ _ /.start]
+ /.value)
+ (tree.branch expected
+ (list (tree.branch dummy
+ (list (tree.leaf dummy)))))
+ (tree.branch expected
+ (list (tree.leaf dummy)
+ (tree.leaf dummy))))
+ (do {@ random.monad}
+ [dummy random.nat]
+ (_.cover [/.cannot-move-further]
+ (`` (and (~~ (template [<parser>]
+ [(|> (/.run <parser>
+ (tree.leaf dummy))
+ (!expect (^multi (#try.Failure error)
+ (exception.match? /.cannot-move-further error))))]
+
+ [/.down] [/.up]
+ [/.right] [/.left]
+ [/.next] [/.prev]
+ ))))))
+ )))
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-09 06:28:52 +0000