aboutsummaryrefslogtreecommitdiff
path: root/stdlib/source/test
diff options
context:
space:
mode:
Diffstat (limited to 'stdlib/source/test')
-rw-r--r--stdlib/source/test/lux/control/parser.lux213
1 files changed, 159 insertions, 54 deletions
diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux
index 58a35ae02..bcb958210 100644
--- a/stdlib/source/test/lux/control/parser.lux
+++ b/stdlib/source/test/lux/control/parser.lux
@@ -14,14 +14,15 @@
[parser
["s" code]]]
[data
+ ["." name]
[number
["n" nat]]
- ["." text ("#;." equivalence)
+ ["." text ("#@." equivalence)
["%" format (#+ format)]]
[collection
- ["." list ("#;." functor)]]]
+ ["." list ("#@." functor)]]]
[math
- ["r" random]]
+ ["." random]]
[macro
["." code]
[syntax (#+ syntax:)]]]
@@ -32,7 +33,7 @@
(All [a] (-> Text (Try a) Bit))
(case input
(#try.Failure actual)
- (text;= expected actual)
+ (text@= expected actual)
_
#0))
@@ -74,15 +75,15 @@
(def: combinators-0
Test
- (do r.monad
- [expected0 r.nat
- variadic (:: @ map (|>> (n.max 1) (n.min 20)) r.nat)
- expected+ (r.list variadic r.nat)
- even0 (r.filter n.even? r.nat)
- odd0 (r.filter n.odd? r.nat)
- not0 r.bit]
+ (do random.monad
+ [expected0 random.nat
+ variadic (:: @ map (|>> (n.max 1) (n.min 20)) random.nat)
+ expected+ (random.list variadic random.nat)
+ even0 (random.filter n.even? random.nat)
+ odd0 (random.filter n.odd? random.nat)
+ not0 random.bit]
($_ _.and
- (_.test "Can optionally succeed with some parser."
+ (_.test (%.name (name-of /.maybe))
(and (|> (list (code.nat expected0))
(/.run (/.maybe s.nat))
(match (#.Some actual)
@@ -91,17 +92,17 @@
(/.run (/.maybe s.nat))
(match #.None
#1))))
- (_.test "Can apply a parser 0 or more times."
- (and (|> (list;map code.nat expected+)
+ (_.test (%.name (name-of /.some))
+ (and (|> (list@map code.nat expected+)
(/.run (/.some s.nat))
(match actual
(:: (list.equivalence n.equivalence) = expected+ actual)))
- (|> (list;map (|>> .int code.int) expected+)
+ (|> (list@map (|>> .int code.int) expected+)
(/.run (/.some s.nat))
(match #.Nil
#1))))
- (_.test "Can apply a parser 1 or more times."
- (and (|> (list;map code.nat expected+)
+ (_.test (%.name (name-of /.many))
+ (and (|> (list@map code.nat expected+)
(/.run (/.many s.nat))
(match actual
(:: (list.equivalence n.equivalence) = expected+ actual)))
@@ -109,10 +110,40 @@
(/.run (/.many s.nat))
(match (list actual)
(n.= expected0 actual)))
- (|> (list;map (|>> .int code.int) expected+)
+ (|> (list@map (|>> .int code.int) expected+)
(/.run (/.many s.nat))
fails?)))
- (_.test "Can use either parser."
+ (_.test (%.name (name-of /.filter))
+ (and (|> (list (code.nat even0))
+ (/.run (/.filter n.even? s.nat))
+ (match actual (n.= even0 actual)))
+ (|> (list (code.nat odd0))
+ (/.run (/.filter n.even? s.nat))
+ fails?)))
+ (_.test (%.name (name-of /.and))
+ (let [even (/.filter n.even? s.nat)
+ odd (/.filter n.odd? s.nat)]
+ (and (|> (list (code.nat even0) (code.nat odd0))
+ (/.run (/.and even odd))
+ (match [left right]
+ (and (n.= even0 left)
+ (n.= odd0 right))))
+ (|> (list (code.nat odd0) (code.nat even0))
+ (/.run (/.and even odd))
+ fails?))))
+ (_.test (%.name (name-of /.or))
+ (let [even (/.filter n.even? s.nat)
+ odd (/.filter n.odd? s.nat)]
+ (and (|> (list (code.nat even0))
+ (/.run (/.or even odd))
+ (match (#.Left actual) (n.= even0 actual)))
+ (|> (list (code.nat odd0))
+ (/.run (/.or even odd))
+ (match (#.Right actual) (n.= odd0 actual)))
+ (|> (list (code.bit not0))
+ (/.run (/.or even odd))
+ fails?))))
+ (_.test (%.name (name-of /.either))
(let [even (/.filter n.even? s.nat)
odd (/.filter n.odd? s.nat)]
(and (|> (list (code.nat even0))
@@ -124,7 +155,7 @@
(|> (list (code.bit not0))
(/.run (/.either even odd))
fails?))))
- (_.test "Can create the opposite/negation of any parser."
+ (_.test (%.name (name-of /.not))
(and (|> (list (code.nat expected0))
(/.run (/.not s.nat))
fails?)
@@ -135,82 +166,139 @@
(def: combinators-1
Test
- (do r.monad
- [failure (r.ascii 1)
- variadic (:: @ map (|>> (n.max 1) (n.min 20)) r.nat)
- times (:: @ map (n.% variadic) r.nat)
- expected+ (r.list variadic r.nat)
- separator (r.ascii 1)]
+ (do random.monad
+ [variadic (:: @ map (|>> (n.max 1) (n.min 20)) random.nat)
+ times (:: @ map (n.% variadic) random.nat)
+ expected random.nat
+ wrong (|> random.nat (random.filter (|>> (n.= expected) not)))
+ expected+ (random.list variadic random.nat)
+ separator (random.ascii 1)]
($_ _.and
- (_.test "Can fail at will."
- (|> (list)
- (/.run (/.fail failure))
- (should-fail failure)))
- (_.test "Can apply a parser N times."
- (and (|> (list;map code.nat expected+)
+ (_.test (%.name (name-of /.exactly))
+ (and (|> (list@map code.nat expected+)
(/.run (/.exactly times s.nat))
(match actual
(:: (list.equivalence n.equivalence) =
(list.take times expected+)
actual)))
- (|> (list;map code.nat expected+)
+ (|> (list@map code.nat expected+)
(/.run (/.exactly (inc variadic) s.nat))
fails?)))
- (_.test "Can apply a parser at-least N times."
- (and (|> (list;map code.nat expected+)
+ (_.test (%.name (name-of /.at-least))
+ (and (|> (list@map code.nat expected+)
(/.run (/.at-least times s.nat))
(match actual
(:: (list.equivalence n.equivalence) =
expected+
actual)))
- (|> (list;map code.nat expected+)
+ (|> (list@map code.nat expected+)
(/.run (/.at-least (inc variadic) s.nat))
fails?)))
- (_.test "Can apply a parser at-most N times."
- (and (|> (list;map code.nat expected+)
+ (_.test (%.name (name-of /.at-most))
+ (and (|> (list@map code.nat expected+)
(/.run (/.at-most times s.nat))
(match actual
(:: (list.equivalence n.equivalence) =
(list.take times expected+)
actual)))
- (|> (list;map code.nat expected+)
+ (|> (list@map code.nat expected+)
(/.run (/.at-most (inc variadic) s.nat))
(match actual
(:: (list.equivalence n.equivalence) =
expected+
actual)))))
- (_.test "Can apply a parser between N and M times."
- (and (|> (list;map code.nat expected+)
+ (_.test (%.name (name-of /.between))
+ (and (|> (list@map code.nat expected+)
(/.run (/.between times variadic s.nat))
(match actual
(:: (list.equivalence n.equivalence) =
expected+
actual)))
- (|> (list;map code.nat (list.take times expected+))
+ (|> (list@map code.nat (list.take times expected+))
(/.run (/.between times variadic s.nat))
(match actual
(:: (list.equivalence n.equivalence) =
(list.take times expected+)
actual)))))
- (_.test "Can parse while taking separators into account."
- (|> (list.interpose (code.text separator) (list;map code.nat expected+))
+ (_.test (%.name (name-of /.sep-by))
+ (|> (list.interpose (code.text separator) (list@map code.nat expected+))
(/.run (/.sep-by (s.this! (code.text separator)) s.nat))
(match actual
(:: (list.equivalence n.equivalence) =
expected+
actual))))
- (_.test "Can obtain the whole of the remaining input."
- (|> (list;map code.nat expected+)
+ (_.test (%.name (name-of /.remaining))
+ (|> (list@map code.nat expected+)
(/.run /.remaining)
(match actual
(:: (list.equivalence code.equivalence) =
- (list;map code.nat expected+)
+ (list@map code.nat expected+)
actual))))
+ (_.test (%.name (name-of /.default))
+ (and (|> (/.run (/.default wrong (:: /.monad wrap expected)) (list))
+ (match actual (n.= expected actual)))
+ (|> (/.run (/.default expected (: (Parser (List Code) Nat)
+ (/.fail "yolo")))
+ (list))
+ (match actual (n.= expected actual)))
+ ))
+ )))
+
+(def: combinators-2
+ Test
+ (do random.monad
+ [expected random.nat
+ even (random.filter n.even? random.nat)
+ odd (random.filter n.odd? random.nat)
+ #let [even^ (/.filter n.even? s.nat)
+ odd^ (/.filter n.odd? s.nat)]]
+ ($_ _.and
+ (_.test (%.name (name-of /.rec))
+ (let [parser (/.rec (function (_ self)
+ (/.either s.nat
+ (s.tuple self))))
+ level-0 (code.nat expected)
+ level-up (: (-> Code Code)
+ (|>> list code.tuple))]
+ (and (|> (list level-0)
+ (/.run parser)
+ (match actual (n.= expected actual)))
+ (|> (list (level-up level-0))
+ (/.run parser)
+ (match actual (n.= expected actual)))
+ (|> (list (level-up (level-up level-0)))
+ (/.run parser)
+ (match actual (n.= expected actual))))))
+ (_.test (%.name (name-of /.after))
+ (and (|> (/.run (/.after even^ s.nat)
+ (list (code.nat even) (code.nat expected)))
+ (match actual (n.= expected actual)))
+ (|> (/.run (/.after even^ s.nat)
+ (list (code.nat odd) (code.nat expected)))
+ fails?)))
+ (_.test (%.name (name-of /.before))
+ (and (|> (/.run (/.before even^ s.nat)
+ (list (code.nat expected) (code.nat even)))
+ (match actual (n.= expected actual)))
+ (|> (/.run (/.before even^ s.nat)
+ (list (code.nat expected) (code.nat odd)))
+ fails?)))
+ (_.test (%.name (name-of /.parses?))
+ (and (|> (/.run (/.parses? even^)
+ (list (code.nat even)))
+ (match verdict verdict))
+ (|> (/.run (/.parses? even^)
+ (list (code.nat odd)))
+ (match verdict (not verdict)))))
+ (_.test (%.name (name-of /.codec))
+ (|> (/.run (/.codec n.decimal s.text)
+ (list (code.text (%.nat expected))))
+ (match actual (n.= expected actual))))
)))
-(def: (injection value)
+(def: injection
(Injection (All [a i] (Parser i a)))
- (:: /.monad wrap value))
+ (:: /.monad wrap))
(def: comparison
(Comparison (All [a i] (Parser i a)))
@@ -224,21 +312,38 @@
(def: #export test
Test
- (do r.monad
- [assertion (r.ascii 1)]
- (<| (_.context (%.name (name-of /.Parser)))
+ (do random.monad
+ [expected random.nat
+ failure (random.ascii 1)
+ assertion (random.ascii 1)]
+ (<| (_.context (name.module (name-of /._)))
($_ _.and
($functor.spec ..injection ..comparison /.functor)
($apply.spec ..injection ..comparison /.apply)
($monad.spec ..injection ..comparison /.monad)
- (_.test "Can make assertions while parsing."
+ (_.test (%.name (name-of /.run))
+ (|> (/.run (:: /.monad wrap expected) (list))
+ (match actual (n.= expected actual))))
+ (_.test (%.name (name-of /.fail))
+ (|> (list)
+ (/.run (/.fail failure))
+ (should-fail failure)))
+ (_.test (%.name (name-of /.lift))
+ (and (|> (list)
+ (/.run (/.lift (#try.Success expected)))
+ (match actual (n.= expected actual)))
+ (|> (list)
+ (/.run (/.lift (#try.Failure failure)))
+ (should-fail failure))))
+ (_.test (%.name (name-of /.assert))
(and (|> (list (code.bit #1) (code.int +123))
(/.run (/.assert assertion #1))
- (match [] #1))
+ (match [] true))
(|> (list (code.bit #1) (code.int +123))
(/.run (/.assert assertion #0))
fails?)))
..combinators-0
..combinators-1
+ ..combinators-2
))))
generated by cgit v1.2.3 (git 2.25.1) at 2024-12-26 13:00:35 +0000