From 7406fbf75e7f81b466c02ed07d65e62c86e3230a Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Tue, 21 May 2019 23:40:48 -0400 Subject: Fixes & tweaks in tests (and relevant code) due to latest changes in the stdlib. --- stdlib/source/test/lux/control/parser.lux | 106 ++++++++-------- stdlib/source/test/lux/control/parser/cli.lux | 18 +-- stdlib/source/test/lux/control/parser/text.lux | 168 ++++++++++++------------- stdlib/source/test/lux/data/format/xml.lux | 19 ++- stdlib/source/test/lux/data/text/regex.lux | 12 +- stdlib/source/test/lux/macro/syntax.lux | 74 +++++------ 6 files changed, 200 insertions(+), 197 deletions(-) (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/control/parser.lux b/stdlib/source/test/lux/control/parser.lux index 01dbd1415..c0bd6d92e 100644 --- a/stdlib/source/test/lux/control/parser.lux +++ b/stdlib/source/test/lux/control/parser.lux @@ -39,7 +39,7 @@ (def: (enforced? parser input) (All [s] (-> (Parser s Any) s Bit)) - (case (/.run input parser) + (case (/.run parser input) (#error.Success [_ []]) #1 @@ -48,7 +48,7 @@ (def: (found? parser input) (All [s] (-> (Parser s Bit) s Bit)) - (case (/.run input parser) + (case (/.run parser input) (#error.Success [_ #1]) #1 @@ -83,53 +83,53 @@ not0 r.bit] ($_ _.and (_.test "Can optionally succeed with some parser." - (and (|> (/.maybe s.nat) - (/.run (list (code.nat expected0))) + (and (|> (list (code.nat expected0)) + (/.run (/.maybe s.nat)) (match (#.Some actual) (n/= expected0 actual))) - (|> (/.maybe s.nat) - (/.run (list (code.int (.int expected0)))) + (|> (list (code.int (.int expected0))) + (/.run (/.maybe s.nat)) (match #.None #1)))) (_.test "Can apply a parser 0 or more times." - (and (|> (/.some s.nat) - (/.run (list;map code.nat expected+)) + (and (|> (list;map code.nat expected+) + (/.run (/.some s.nat)) (match actual (:: (list.equivalence nat.equivalence) = expected+ actual))) - (|> (/.some s.nat) - (/.run (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 (|> (/.many s.nat) - (/.run (list;map code.nat expected+)) + (and (|> (list;map code.nat expected+) + (/.run (/.many s.nat)) (match actual (:: (list.equivalence nat.equivalence) = expected+ actual))) - (|> (/.many s.nat) - (/.run (list (code.nat expected0))) + (|> (list (code.nat expected0)) + (/.run (/.many s.nat)) (match (list actual) (n/= expected0 actual))) - (|> (/.many s.nat) - (/.run (list;map (|>> .int code.int) expected+)) + (|> (list;map (|>> .int code.int) expected+) + (/.run (/.many s.nat)) fails?))) (_.test "Can use either parser." (let [even (/.filter n/even? s.nat) odd (/.filter n/odd? s.nat)] - (and (|> (/.either even odd) - (/.run (list (code.nat even0))) + (and (|> (list (code.nat even0)) + (/.run (/.either even odd)) (match actual (n/= even0 actual))) - (|> (/.either even odd) - (/.run (list (code.nat odd0))) + (|> (list (code.nat odd0)) + (/.run (/.either even odd)) (match actual (n/= odd0 actual))) - (|> (/.either even odd) - (/.run (list (code.bit not0))) + (|> (list (code.bit not0)) + (/.run (/.either even odd)) fails?)))) (_.test "Can create the opposite/negation of any parser." - (and (|> (/.not s.nat) - (/.run (list (code.nat expected0))) + (and (|> (list (code.nat expected0)) + (/.run (/.not s.nat)) fails?) - (|> (/.not s.nat) - (/.run (list (code.bit not0))) + (|> (list (code.bit not0)) + (/.run (/.not s.nat)) (match [] #1)))) ))) @@ -143,65 +143,65 @@ separator (r.ascii 1)] ($_ _.and (_.test "Can fail at will." - (|> (/.fail failure) - (/.run (list)) + (|> (list) + (/.run (/.fail failure)) (should-fail failure))) (_.test "Can apply a parser N times." - (and (|> (/.exactly times s.nat) - (/.run (list;map code.nat expected+)) + (and (|> (list;map code.nat expected+) + (/.run (/.exactly times s.nat)) (match actual (:: (list.equivalence nat.equivalence) = (list.take times expected+) actual))) - (|> (/.exactly (inc variadic) s.nat) - (/.run (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 (|> (/.at-least times s.nat) - (/.run (list;map code.nat expected+)) + (and (|> (list;map code.nat expected+) + (/.run (/.at-least times s.nat)) (match actual (:: (list.equivalence nat.equivalence) = expected+ actual))) - (|> (/.at-least (inc variadic) s.nat) - (/.run (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 (|> (/.at-most times s.nat) - (/.run (list;map code.nat expected+)) + (and (|> (list;map code.nat expected+) + (/.run (/.at-most times s.nat)) (match actual (:: (list.equivalence nat.equivalence) = (list.take times expected+) actual))) - (|> (/.at-most (inc variadic) s.nat) - (/.run (list;map code.nat expected+)) + (|> (list;map code.nat expected+) + (/.run (/.at-most (inc variadic) s.nat)) (match actual (:: (list.equivalence nat.equivalence) = expected+ actual))))) (_.test "Can apply a parser between N and M times." - (and (|> (/.between times variadic s.nat) - (/.run (list;map code.nat expected+)) + (and (|> (list;map code.nat expected+) + (/.run (/.between times variadic s.nat)) (match actual (:: (list.equivalence nat.equivalence) = expected+ actual))) - (|> (/.between times variadic s.nat) - (/.run (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 nat.equivalence) = (list.take times expected+) actual))))) (_.test "Can parse while taking separators into account." - (|> (/.sep-by (s.this (code.text separator)) s.nat) - (/.run (list.interpose (code.text separator) (list;map code.nat expected+))) + (|> (list.interpose (code.text separator) (list;map code.nat expected+)) + (/.run (/.sep-by (s.this! (code.text separator)) s.nat)) (match actual (:: (list.equivalence nat.equivalence) = expected+ actual)))) (_.test "Can obtain the whole of the remaining input." - (|> /.remaining - (/.run (list;map code.nat expected+)) + (|> (list;map code.nat expected+) + (/.run /.remaining) (match actual (:: (list.equivalence code.equivalence) = (list;map code.nat expected+) @@ -215,7 +215,7 @@ (def: comparison (Comparison (All [a i] (Parser i a))) (function (_ == left right) - (case [(/.run [] left) (/.run [] right)] + (case [(/.run left []) (/.run right [])] [(#error.Success [_ left]) (#error.Success [_ right])] (== left right) @@ -233,11 +233,11 @@ ($monad.spec ..injection ..comparison /.monad) (_.test "Can make assertions while parsing." - (and (|> (/.assert assertion #1) - (/.run (list (code.bit #1) (code.int +123))) + (and (|> (list (code.bit #1) (code.int +123)) + (/.run (/.assert assertion #1)) (match [] #1)) - (|> (/.assert assertion #0) - (/.run (list (code.bit #1) (code.int +123))) + (|> (list (code.bit #1) (code.int +123)) + (/.run (/.assert assertion #0)) fails?))) ..combinators-0 ..combinators-1 diff --git a/stdlib/source/test/lux/control/parser/cli.lux b/stdlib/source/test/lux/control/parser/cli.lux index a476c97c6..aab4c5158 100644 --- a/stdlib/source/test/lux/control/parser/cli.lux +++ b/stdlib/source/test/lux/control/parser/cli.lux @@ -33,27 +33,27 @@ post-ignore (r.list 5 gen-ignore)] ($_ _.and (_.test "Can read any argument." - (|> (/.run (list yes) /.any) + (|> (/.run /.any (list yes)) (case> (#error.Failure _) #0 (#error.Success arg) (text@= arg yes)))) (_.test "Can test tokens." - (and (|> (/.run (list yes) (/.this yes)) + (and (|> (/.run (/.this yes) (list yes)) (case> (#error.Failure _) #0 (#error.Success _) #1)) - (|> (/.run (list no) (/.this yes)) + (|> (/.run (/.this yes) (list no)) (case> (#error.Failure _) #1 (#error.Success _) #0)))) (_.test "Can use custom token parsers." - (|> (/.run (list yes) (/.parse nat@decode)) + (|> (/.run (/.parse nat@decode) (list yes)) (case> (#error.Failure _) #0 @@ -61,14 +61,14 @@ (text@= (nat@encode parsed) yes)))) (_.test "Can query if there are any more inputs." - (and (|> (/.run (list) /.end) + (and (|> (/.run /.end (list)) (case> (#error.Success []) #1 _ #0)) - (|> (/.run (list yes) (p.not /.end)) + (|> (/.run (p.not /.end) (list yes)) (case> (#error.Success []) #0 _ #1)))) (_.test "Can parse CLI input anywhere." - (|> (/.run (list.concat (list pre-ignore (list yes) post-ignore)) - (|> (/.somewhere (/.this yes)) - (p.before (p.some /.any)))) + (|> (/.run (|> (/.somewhere (/.this yes)) + (p.before (p.some /.any))) + (list.concat (list pre-ignore (list yes) post-ignore))) (case> (#error.Failure _) #0 diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux index 1686bb27c..ae2c448c7 100644 --- a/stdlib/source/test/lux/control/parser/text.lux +++ b/stdlib/source/test/lux/control/parser/text.lux @@ -38,8 +38,8 @@ (<| (_.context (name.module (name-of /._))) ($_ _.and (_.test "Can detect the end of the input." - (|> (/.run "" - /.end) + (|> (/.run /.end + "") (case> (#.Right _) true _ false))) (do r.monad [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) @@ -48,126 +48,126 @@ (r.filter (|>> (text@= sample) not)))] ($_ _.and (_.test "Won't mistake non-empty text for no more input." - (|> (/.run sample - /.end) + (|> (/.run /.end + sample) (case> (#.Left _) true _ false))) (_.test "Can find literal text fragments." - (and (|> (/.run sample - (/.this sample)) + (and (|> (/.run (/.this sample) + sample) (case> (#.Right []) true _ false)) - (|> (/.run non-sample - (/.this sample)) + (|> (/.run (/.this sample) + non-sample) (case> (#.Left _) true _ false)))) )) ($_ _.and (_.test "Can lex anything" - (and (should-pass "A" (/.run "A" - /.any)) - (should-fail (/.run "" - /.any)))) + (and (should-pass "A" (/.run /.any + "A")) + (should-fail (/.run /.any + "")))) (_.test "Can lex characters ranges." - (and (should-pass "Y" (/.run "Y" - (/.range (char "X") (char "Z")))) - (should-fail (/.run "M" - (/.range (char "X") (char "Z")))))) + (and (should-pass "Y" (/.run (/.range (char "X") (char "Z")) + "Y")) + (should-fail (/.run (/.range (char "X") (char "Z")) + "M")))) (_.test "Can lex upper-case and lower-case letters." - (and (should-pass "Y" (/.run "Y" - /.upper)) - (should-fail (/.run "m" - /.upper)) + (and (should-pass "Y" (/.run /.upper + "Y")) + (should-fail (/.run /.upper + "m")) - (should-pass "y" (/.run "y" - /.lower)) - (should-fail (/.run "M" - /.lower)))) + (should-pass "y" (/.run /.lower + "y")) + (should-fail (/.run /.lower + "M")))) (_.test "Can lex numbers." - (and (should-pass "1" (/.run "1" - /.decimal)) - (should-fail (/.run " " - /.decimal)) + (and (should-pass "1" (/.run /.decimal + "1")) + (should-fail (/.run /.decimal + " ")) - (should-pass "7" (/.run "7" - /.octal)) - (should-fail (/.run "8" - /.octal)) + (should-pass "7" (/.run /.octal + "7")) + (should-fail (/.run /.octal + "8")) - (should-pass "1" (/.run "1" - /.hexadecimal)) - (should-pass "a" (/.run "a" - /.hexadecimal)) - (should-pass "A" (/.run "A" - /.hexadecimal)) - (should-fail (/.run " " - /.hexadecimal)) + (should-pass "1" (/.run /.hexadecimal + "1")) + (should-pass "a" (/.run /.hexadecimal + "a")) + (should-pass "A" (/.run /.hexadecimal + "A")) + (should-fail (/.run /.hexadecimal + " ")) )) (_.test "Can lex alphabetic characters." - (and (should-pass "A" (/.run "A" - /.alpha)) - (should-pass "a" (/.run "a" - /.alpha)) - (should-fail (/.run "1" - /.alpha)))) + (and (should-pass "A" (/.run /.alpha + "A")) + (should-pass "a" (/.run /.alpha + "a")) + (should-fail (/.run /.alpha + "1")))) (_.test "Can lex alphanumeric characters." - (and (should-pass "A" (/.run "A" - /.alpha-num)) - (should-pass "a" (/.run "a" - /.alpha-num)) - (should-pass "1" (/.run "1" - /.alpha-num)) - (should-fail (/.run " " - /.alpha-num)))) + (and (should-pass "A" (/.run /.alpha-num + "A")) + (should-pass "a" (/.run /.alpha-num + "a")) + (should-pass "1" (/.run /.alpha-num + "1")) + (should-fail (/.run /.alpha-num + " ")))) (_.test "Can lex white-space." - (and (should-pass " " (/.run " " - /.space)) - (should-fail (/.run "8" - /.space)))) + (and (should-pass " " (/.run /.space + " ")) + (should-fail (/.run /.space + "8")))) ) ($_ _.and (_.test "Can combine lexers sequentially." - (and (|> (/.run "YO" - (p.and /.any /.any)) + (and (|> (/.run (p.and /.any /.any) + "YO") (case> (#.Right ["Y" "O"]) true _ false)) - (should-fail (/.run "Y" - (p.and /.any /.any))))) + (should-fail (/.run (p.and /.any /.any) + "Y")))) (_.test "Can create the opposite of a lexer." - (and (should-pass "a" (/.run "a" - (/.not (p.or /.decimal /.upper)))) - (should-fail (/.run "A" - (/.not (p.or /.decimal /.upper)))))) + (and (should-pass "a" (/.run (/.not (p.or /.decimal /.upper)) + "a")) + (should-fail (/.run (/.not (p.or /.decimal /.upper)) + "A")))) (_.test "Can select from among a set of characters." - (and (should-pass "C" (/.run "C" - (/.one-of "ABC"))) - (should-fail (/.run "D" - (/.one-of "ABC"))))) + (and (should-pass "C" (/.run (/.one-of "ABC") + "C")) + (should-fail (/.run (/.one-of "ABC") + "D")))) (_.test "Can avoid a set of characters." - (and (should-pass "D" (/.run "D" - (/.none-of "ABC"))) - (should-fail (/.run "C" - (/.none-of "ABC"))))) + (and (should-pass "D" (/.run (/.none-of "ABC") + "D")) + (should-fail (/.run (/.none-of "ABC") + "C")))) (_.test "Can lex using arbitrary predicates." - (and (should-pass "D" (/.run "D" - (/.satisfies (function (_ c) true)))) - (should-fail (/.run "C" - (/.satisfies (function (_ c) false)))))) + (and (should-pass "D" (/.run (/.satisfies (function (_ c) true)) + "D")) + (should-fail (/.run (/.satisfies (function (_ c) false)) + "C")))) (_.test "Can apply a lexer multiple times." - (and (should-pass "0123456789ABCDEF" (/.run "0123456789ABCDEF" - (/.many /.hexadecimal))) - (should-fail (/.run "yolo" - (/.many /.hexadecimal))) + (and (should-pass "0123456789ABCDEF" (/.run (/.many /.hexadecimal) + "0123456789ABCDEF")) + (should-fail (/.run (/.many /.hexadecimal) + "yolo")) - (should-pass "" (/.run "" - (/.some /.hexadecimal))))) + (should-pass "" (/.run (/.some /.hexadecimal) + "")))) ) ))) diff --git a/stdlib/source/test/lux/data/format/xml.lux b/stdlib/source/test/lux/data/format/xml.lux index 48ca29d92..0ad940971 100644 --- a/stdlib/source/test/lux/data/format/xml.lux +++ b/stdlib/source/test/lux/data/format/xml.lux @@ -85,28 +85,27 @@ (_.test "Can parse text." (E.default #0 (do E.monad - [output (.run (#/.Text text) - .text)] + [output (.run .text + (#/.Text text))] (wrap (text@= text output))))) (_.test "Can parse attributes." (E.default #0 (do E.monad - [output (|> (.attr attr) - (p.before .ignore) - (.run node))] + [output (.run (p.before .ignore + (.attr attr)) + node)] (wrap (text@= value output))))) (_.test "Can parse nodes." (E.default #0 (do E.monad - [_ (|> (.node tag) - (p.before .ignore) - (.run node))] + [_ (.run (p.before .ignore + (.node tag)) + node)] (wrap #1)))) (_.test "Can parse children." (E.default #0 (do E.monad - [outputs (|> (.children (p.some .text)) - (.run node))] + [outputs (.run (.children (p.some .text)) node)] (wrap (:: (list.equivalence text.equivalence) = children outputs))))) diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index 3a9fc740d..03f1e2f9c 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -21,7 +21,8 @@ (def: (should-pass regex input) (-> (Parser Text) Text Bit) - (|> (.run input regex) + (|> input + (.run regex) (case> (#error.Success parsed) (text@= parsed input) @@ -30,7 +31,8 @@ (def: (text-should-pass test regex input) (-> Text (Parser Text) Text Bit) - (|> (.run input regex) + (|> input + (.run regex) (case> (#error.Success parsed) (text@= test parsed) @@ -39,7 +41,8 @@ (def: (should-fail regex input) (All [a] (-> (Parser a) Text Bit)) - (|> (.run input regex) + (|> input + (.run regex) (case> (#error.Failure _) true @@ -48,7 +51,8 @@ (syntax: (should-check pattern regex input) (macro.with-gensyms [g!message g!_] - (wrap (list (` (|> (.run (~ input) (~ regex)) + (wrap (list (` (|> (~ input) + (.run (~ regex)) (case> (^ (#error.Success (~ pattern))) true diff --git a/stdlib/source/test/lux/macro/syntax.lux b/stdlib/source/test/lux/macro/syntax.lux index 8422bb4e1..65e0c1280 100644 --- a/stdlib/source/test/lux/macro/syntax.lux +++ b/stdlib/source/test/lux/macro/syntax.lux @@ -26,7 +26,7 @@ (def: (enforced? parser input) (-> (Parser []) (List Code) Bit) - (case (p.run input parser) + (case (p.run parser input) (#.Right [_ []]) #1 @@ -35,7 +35,7 @@ (def: (found? parser input) (-> (Parser Bit) (List Code) Bit) - (case (p.run input parser) + (case (p.run parser input) (#.Right [_ #1]) #1 @@ -44,7 +44,7 @@ (def: (equals? Equivalence reference parser input) (All [a] (-> (Equivalence a) a (Parser a) (List Code) Bit)) - (case (p.run input parser) + (case (p.run parser input) (#.Right [_ output]) (:: Equivalence = reference output) @@ -74,8 +74,8 @@ (~~ (template [ ] [(_.test (and (equals? (list ( ))) - (found? (s.this? ( )) (list ( ))) - (enforced? (s.this ( )) (list ( )))))] + (found? (p.parses? (s.this! ( ))) (list ( ))) + (enforced? (s.this! ( )) (list ( )))))] ["Can parse Bit syntax." #1 code.bit bit.equivalence s.bit] ["Can parse Nat syntax." 123 code.nat nat.equivalence s.nat] @@ -88,16 +88,16 @@ )) (_.test "Can parse identifiers belonging to the current namespace." (and (match "yolo" - (p.run (list (code.local-identifier "yolo")) - s.local-identifier)) - (fails? (p.run (list (code.identifier ["yolo" "lol"])) - s.local-identifier)))) + (p.run s.local-identifier + (list (code.local-identifier "yolo")))) + (fails? (p.run s.local-identifier + (list (code.identifier ["yolo" "lol"])))))) (_.test "Can parse tags belonging to the current namespace." (and (match "yolo" - (p.run (list (code.local-tag "yolo")) - s.local-tag)) - (fails? (p.run (list (code.tag ["yolo" "lol"])) - s.local-tag)))) + (p.run s.local-tag + (list (code.local-tag "yolo")))) + (fails? (p.run s.local-tag + (list (code.tag ["yolo" "lol"])))))) ))) (def: complex-values @@ -106,28 +106,28 @@ (~~ (template [ ] [(_.test (format "Can parse " " syntax.") (and (match [#1 +123] - (p.run (list ( (list (code.bit #1) (code.int +123)))) - ( (p.and s.bit s.int)))) + (p.run ( (p.and s.bit s.int)) + (list ( (list (code.bit #1) (code.int +123)))))) (match #1 - (p.run (list ( (list (code.bit #1)))) - ( s.bit))) - (fails? (p.run (list ( (list (code.bit #1) (code.int +123)))) - ( s.bit))) + (p.run ( s.bit) + (list ( (list (code.bit #1)))))) + (fails? (p.run ( s.bit) + (list ( (list (code.bit #1) (code.int +123)))))) (match (#.Left #1) - (p.run (list ( (list (code.bit #1)))) - ( (p.or s.bit s.int)))) + (p.run ( (p.or s.bit s.int)) + (list ( (list (code.bit #1)))))) (match (#.Right +123) - (p.run (list ( (list (code.int +123)))) - ( (p.or s.bit s.int)))) - (fails? (p.run (list ( (list (code.frac +123.0)))) - ( (p.or s.bit s.int))))))] + (p.run ( (p.or s.bit s.int)) + (list ( (list (code.int +123)))))) + (fails? (p.run ( (p.or s.bit s.int)) + (list ( (list (code.frac +123.0))))))))] ["form" s.form code.form] ["tuple" s.tuple code.tuple])) (_.test "Can parse record syntax." (match [#1 +123] - (p.run (list (code.record (list [(code.bit #1) (code.int +123)]))) - (s.record (p.and s.bit s.int))))) + (p.run (s.record (p.and s.bit s.int)) + (list (code.record (list [(code.bit #1) (code.int +123)])))))) ))) (def: #export test @@ -139,19 +139,19 @@ ($_ _.and (_.test "Can parse any Code." (match [_ (#.Bit #1)] - (p.run (list (code.bit #1) (code.int +123)) - s.any))) + (p.run s.any + (list (code.bit #1) (code.int +123))))) (_.test "Can check whether the end has been reached." (and (match #1 - (p.run (list) - s.end?)) + (p.run s.end? + (list))) (match #0 - (p.run (list (code.bit #1)) - s.end?)))) + (p.run s.end? + (list (code.bit #1)))))) (_.test "Can ensure the end has been reached." (and (match [] - (p.run (list) - s.end!)) - (fails? (p.run (list (code.bit #1)) - s.end!)))) + (p.run s.end! + (list))) + (fails? (p.run s.end! + (list (code.bit #1)))))) )))) -- cgit v1.2.3