From d0ec271e90a2be17d2ad5f5e23b0bb3006602bc8 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 21 Jun 2017 19:10:24 -0400 Subject: - CLI, Syntax and Lexer are now based upon a common Parser type. --- stdlib/test/test/lux/cli.lux | 70 ++++-------- stdlib/test/test/lux/control/parser.lux | 183 +++++++++++++++++++++++++++++++ stdlib/test/test/lux/data/text/lexer.lux | 161 +++++---------------------- stdlib/test/test/lux/data/text/regex.lux | 11 +- stdlib/test/test/lux/macro/syntax.lux | 153 +++++--------------------- stdlib/test/tests.lux | 9 +- 6 files changed, 267 insertions(+), 320 deletions(-) create mode 100644 stdlib/test/test/lux/control/parser.lux (limited to 'stdlib/test') diff --git a/stdlib/test/test/lux/cli.lux b/stdlib/test/test/lux/cli.lux index b19a9d345..8e1188a02 100644 --- a/stdlib/test/test/lux/cli.lux +++ b/stdlib/test/test/lux/cli.lux @@ -2,7 +2,8 @@ lux (lux [io] (control monad - pipe) + pipe + ["p" parser]) (data text/format [text "Text/" Eq] [number] @@ -18,77 +19,44 @@ #let [(^open "Nat/") number;Codec gen-arg (:: @ map Nat/encode R;nat)] option-name (R;text +5) - args (R;list num-args gen-arg)] + singleton gen-arg] ($_ seq (test "Can read any argument." - (|> (&;run &;any args) + (|> (&;run (list singleton) &;any) (case> (#;Left _) - (n.= +0 num-args) + false (#;Right arg) - (and (not (n.= +0 num-args)) - (Text/= arg (default (undefined) - (list;head args))))))) - - (test "Can safely fail parsing an argument." - (|> (&;run (&;opt &;any) args) - (case> (#;Right (#;Some arg)) - (and (not (n.= +0 num-args)) - (Text/= arg (default (undefined) - (list;head args)))) - - (#;Right #;None) - (n.= +0 num-args) - - _ - false))) - - (test "Can read multiple arguments." - (and (|> (&;run (&;some &;any) args) - (case> (#;Left _) - false - - (#;Right args') - (n.= num-args (list;size args')))) - (|> (&;run (&;many &;any) args) - (case> (#;Left _) - (n.= +0 num-args) - - (#;Right args') - (n.= num-args (list;size args')))))) + (Text/= arg singleton)))) (test "Can use custom token parsers." - (|> (&;run (&;parse Nat/decode) args) + (|> (&;run (list singleton) (&;parse Nat/decode)) (case> (#;Left _) - (n.= +0 num-args) + false (#;Right parsed) (Text/= (Nat/encode parsed) - (default (undefined) - (list;head args)))))) + singleton)))) (test "Can obtain option values." - (and (|> (&;run (&;option (list option-name)) (list& option-name args)) + (and (|> (&;run (list option-name singleton) (&;option (list option-name))) (case> (#;Left _) - (n.= +0 num-args) + false (#;Right value) - (Text/= value (default (undefined) - (list;head args))))) - (|> (&;run (&;option (list option-name)) args) + (Text/= value singleton))) + (|> (&;run (list singleton) (&;option (list option-name))) (case> (#;Left _) true (#;Right _) false)))) (test "Can check flags." - (and (|> (&;run (&;flag (list option-name)) (list& option-name args)) + (and (|> (&;run (list option-name) (&;flag (list option-name))) (case> (#;Right true) true _ false)) - (|> (&;run (&;flag (list option-name)) args) + (|> (&;run (list) (&;flag (list option-name))) (case> (#;Right false) true _ false)))) (test "Can query if there are any more inputs." - (and (|> (&;run &;end args) - (case> (#;Right []) (n.= +0 num-args) - _ (n.> +0 num-args))) - (|> (&;run (&;not &;end) args) - (case> (#;Right []) (n.> +0 num-args) - _ (n.= +0 num-args))))) + (and (|> (&;run (list) &;end) + (case> (#;Right []) true _ false)) + (|> (&;run (list singleton) (p;not &;end)) + (case> (#;Right []) false _ true)))) )) diff --git a/stdlib/test/test/lux/control/parser.lux b/stdlib/test/test/lux/control/parser.lux new file mode 100644 index 000000000..5c4f5851c --- /dev/null +++ b/stdlib/test/test/lux/control/parser.lux @@ -0,0 +1,183 @@ +(;module: + lux + (lux [io] + (control monad + eq + ["&" parser] + pipe) + (data [text "Text/" Monoid] + text/format + [number] + [bool] + [char] + [ident] + ["R" result]) + ["r" math/random] + [macro] + (macro [code] + ["s" syntax #+ syntax:])) + lux/test) + +## [Utils] +(def: (should-fail input) + (All [a] (-> (R;Result a) Bool)) + (case input + (#R;Error _) true + _ false)) + +(def: (enforced? parser input) + (All [s] (-> (&;Parser s Unit) s Bool)) + (case (&;run input parser) + (#R;Success [_ []]) + true + + _ + false)) + +(def: (found? parser input) + (All [s] (-> (&;Parser s Bool) s Bool)) + (case (&;run input parser) + (#R;Success [_ true]) + true + + _ + false)) + +(def: (is? Eq test parser input) + (All [s a] (-> (Eq a) a (&;Parser s a) s Bool)) + (case (&;run input parser) + (#R;Success [_ output]) + (:: Eq = test output) + + _ + false)) + +(def: (fails? input) + (All [a] (-> (R;Result a) Bool)) + (case input + (#R;Error _) + true + + _ + false)) + +(syntax: (match pattern input) + (wrap (list (` (case (~ input) + (^ (#R;Success [(~' _) (~ pattern)])) + true + + (~' _) + false))))) + +## [Tests] +(context: "Assertions" + (test "Can make assertions while parsing." + (and (match [] + (&;run (list (code;bool true) (code;int 123)) + (&;assert "yolo" true))) + (fails? (&;run (list (code;bool true) (code;int 123)) + (&;assert "yolo" false)))))) + +(context: "Combinators [Part 1]" + ($_ seq + (test "Can optionally succeed with some parser." + (and (match (#;Some +123) + (&;run (list (code;nat +123)) + (&;opt s;nat))) + (match #;None + (&;run (list (code;int -123)) + (&;opt s;nat))))) + + (test "Can apply a parser 0 or more times." + (and (match (list +123 +456 +789) + (&;run (list (code;nat +123) (code;nat +456) (code;nat +789)) + (&;some s;nat))) + (match (list) + (&;run (list (code;int -123)) + (&;some s;nat))))) + + (test "Can apply a parser 1 or more times." + (and (match (list +123 +456 +789) + (&;run (list (code;nat +123) (code;nat +456) (code;nat +789)) + (&;many s;nat))) + (match (list +123) + (&;run (list (code;nat +123)) + (&;many s;nat))) + (fails? (&;run (list (code;int -123)) + (&;many s;nat))))) + + (test "Can use either parser." + (and (match 123 + (&;run (list (code;int 123) (code;int 456) (code;int 789)) + (&;either s;pos-int s;int))) + (match -123 + (&;run (list (code;int -123) (code;int 456) (code;int 789)) + (&;either s;pos-int s;int))) + (fails? (&;run (list (code;bool true) (code;int 456) (code;int 789)) + (&;either s;pos-int s;int))))) + + (test "Can create the opposite/negation of any parser." + (and (fails? (&;run (list (code;int 123) (code;int 456) (code;int 789)) + (&;not s;int))) + (match [] + (&;run (list (code;bool true) (code;int 456) (code;int 789)) + (&;not s;int))))) + )) + +(context: "Combinators Part [2]" + ($_ seq + (test "Can fail at will." + (should-fail (&;run (list) + (&;fail "Well, it really SHOULD fail...")))) + + (test "Can apply a parser N times." + (and (match (list 123 456 789) + (&;run (list (code;int 123) (code;int 456) (code;int 789)) + (&;exactly +3 s;int))) + (match (list 123 456) + (&;run (list (code;int 123) (code;int 456) (code;int 789)) + (&;exactly +2 s;int))) + (fails? (&;run (list (code;int 123) (code;int 456) (code;int 789)) + (&;exactly +4 s;int))))) + + (test "Can apply a parser at-least N times." + (and (match (list 123 456 789) + (&;run (list (code;int 123) (code;int 456) (code;int 789)) + (&;at-least +3 s;int))) + (match (list 123 456 789) + (&;run (list (code;int 123) (code;int 456) (code;int 789)) + (&;at-least +2 s;int))) + (fails? (&;run (list (code;int 123) (code;int 456) (code;int 789)) + (&;at-least +4 s;int))))) + + (test "Can apply a parser at-most N times." + (and (match (list 123 456 789) + (&;run (list (code;int 123) (code;int 456) (code;int 789)) + (&;at-most +3 s;int))) + (match (list 123 456) + (&;run (list (code;int 123) (code;int 456) (code;int 789)) + (&;at-most +2 s;int))) + (match (list 123 456 789) + (&;run (list (code;int 123) (code;int 456) (code;int 789)) + (&;at-most +4 s;int))))) + + (test "Can apply a parser between N and M times." + (and (match (list 123 456 789) + (&;run (list (code;int 123) (code;int 456) (code;int 789)) + (&;between +3 +10 s;int))) + (fails? (&;run (list (code;int 123) (code;int 456) (code;int 789)) + (&;between +4 +10 s;int))))) + + (test "Can parse while taking separators into account." + (and (match (list 123 456 789) + (&;run (list (code;int 123) (code;text "YOLO") (code;int 456) (code;text "YOLO") (code;int 789)) + (&;sep-by (s;this (' "YOLO")) s;int))) + (match (list 123 456) + (&;run (list (code;int 123) (code;text "YOLO") (code;int 456) (code;int 789)) + (&;sep-by (s;this (' "YOLO")) s;int))))) + + (test "Can obtain the whole of the remaining input." + (|> &;remaining + (&;run (list (code;int 123) (code;int 456) (code;int 789))) + (match (list [_ (#;Int 123)] [_ (#;Int 456)] [_ (#;Int 789)])))) + )) diff --git a/stdlib/test/test/lux/data/text/lexer.lux b/stdlib/test/test/lux/data/text/lexer.lux index 8f1d94185..76eadfbb0 100644 --- a/stdlib/test/test/lux/data/text/lexer.lux +++ b/stdlib/test/test/lux/data/text/lexer.lux @@ -1,7 +1,8 @@ (;module: lux (lux (control monad - pipe) + pipe + ["p" parser]) [io] (data ["R" result] [text "T/" Eq] @@ -70,36 +71,19 @@ (context: "Literals" [size (|> r;nat (:: @ map (|>. (n.% +100) (n.max +10)))) - pre (r;text size) - post (|> (r;text size) - (r;filter (|>. (text;starts-with? pre) not)))] + sample (r;text size) + non-sample (|> (r;text size) + (r;filter (|>. (T/= sample) not)))] ($_ seq (test "Can find literal text fragments." - (and (|> (&;run (format pre post) - (&;this pre)) + (and (|> (&;run sample + (&;this sample)) (case> (#;Right []) true _ false)) - (|> (&;run post - (&;this pre)) + (|> (&;run non-sample + (&;this sample)) (case> (#;Left _) true _ false)))) )) -(context: "Char lexers" - ($_ seq - (test "Can lex characters." - (and (|> (&;run "YOLO" - (&;this "Y")) - (case> (#;Right []) true _ false)) - (|> (&;run "MEME" - (&;this "Y")) - (case> (#;Left _) true _ false)))) - - (test "Can lex characters ranges." - (and (should-passT "Y" (&;run "YOLO" - (&;char-range #"X" #"Z"))) - (should-fail (&;run "MEME" - (&;char-range #"X" #"Z"))))) - )) - (context: "Custom lexers" ($_ seq (test "Can lex anything" @@ -107,16 +91,22 @@ &;any)) (should-fail (&;run "" &;any)))) + + (test "Can lex characters ranges." + (and (should-passT "Y" (&;run "Y" + (&;char-range #"X" #"Z"))) + (should-fail (&;run "M" + (&;char-range #"X" #"Z"))))) (test "Can lex upper-case and &;lower-case letters." - (and (should-passT "Y" (&;run "YOLO" + (and (should-passT "Y" (&;run "Y" &;upper)) - (should-fail (&;run "meme" + (should-fail (&;run "m" &;upper)) - (should-passT "y" (&;run "yolo" + (should-passT "y" (&;run "y" &;lower)) - (should-fail (&;run "MEME" + (should-fail (&;run "M" &;lower)))) (test "Can lex numbers." @@ -168,34 +158,18 @@ (context: "Combinators" ($_ seq (test "Can combine lexers sequentially." - (and (|> (&;run "YOLO" - (&;seq &;any &;any)) + (and (|> (&;run "YO" + (p;seq &;any &;any)) (case> (#;Right ["Y" "O"]) true _ false)) (should-fail (&;run "Y" - (&;seq &;any &;any))))) + (p;seq &;any &;any))))) - (test "Can combine lexers alternatively." - (and (should-passE (#;Left "0") (&;run "0" - (&;alt &;digit &;upper))) - (should-passE (#;Right "A") (&;run "A" - (&;alt &;digit &;upper))) - (should-fail (&;run "a" - (&;alt &;digit &;upper))))) - (test "Can create the opposite of a lexer." (and (should-passT "a" (&;run "a" - (&;not (&;alt &;digit &;upper)))) + (&;not (p;alt &;digit &;upper)))) (should-fail (&;run "A" - (&;not (&;alt &;digit &;upper)))))) - - (test "Can use either lexer." - (and (should-passT "0" (&;run "0" - (&;either &;digit &;upper))) - (should-passT "A" (&;run "A" - (&;either &;digit &;upper))) - (should-fail (&;run "a" - (&;either &;digit &;upper))))) + (&;not (p;alt &;digit &;upper)))))) (test "Can select from among a set of characters." (and (should-passT "C" (&;run "C" @@ -216,90 +190,11 @@ (&;satisfies (function [c] false)))))) (test "Can apply a lexer multiple times." - (and (should-passT "0123456789ABCDEF" (&;run "0123456789ABCDEF yolo" - (&;many' &;hex-digit))) - (should-fail (&;run "yolo" - (&;many' &;hex-digit))) - - (should-passT "" (&;run "yolo" - (&;some' &;hex-digit))))) - )) - -(context: "Yet more combinators..." - ($_ seq - (test "Can fail at will." - (should-fail (&;run "yolo" - (&;fail "Well, it really SHOULD fail...")))) - - (test "Can make assertions." - (and (should-fail (&;run "yolo" - (&;assert "Well, it really SHOULD fail..." false))) - (|> (&;run "yolo" - (&;assert "GO, GO, GO!" true)) - (case> (#;Right []) true - _ false)))) - - (test "Can apply a lexer multiple times." - (and (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") - (&;run "0123456789ABCDEF yolo" - (&;many &;hex-digit))) + (and (should-passT "0123456789ABCDEF" (&;run "0123456789ABCDEF" + (&;many &;hex-digit))) (should-fail (&;run "yolo" (&;many &;hex-digit))) - (should-passL (list) - (&;run "yolo" - (&;some &;hex-digit))))) - - (test "Can lex exactly N elements." - (and (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") - (&;run "0123456789ABCDEF yolo" - (&;exactly +16 &;hex-digit))) - (should-passL (list "0" "1" "2") - (&;run "0123456789ABCDEF yolo" - (&;exactly +3 &;hex-digit))) - (should-fail (&;run "0123456789ABCDEF yolo" - (&;exactly +17 &;hex-digit))))) - - (test "Can lex at-most N elements." - (and (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") - (&;run "0123456789ABCDEF yolo" - (&;at-most +16 &;hex-digit))) - (should-passL (list "0" "1" "2") - (&;run "0123456789ABCDEF yolo" - (&;at-most +3 &;hex-digit))) - (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") - (&;run "0123456789ABCDEF yolo" - (&;at-most +17 &;hex-digit))))) - - (test "Can lex tokens between lower and upper boundaries of quantity." - (and (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") - (&;run "0123456789ABCDEF yolo" - (&;between +0 +16 &;hex-digit))) - (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") - (&;run "0123456789ABCDEF yolo" - (&;between +3 +16 &;hex-digit))) - (should-fail (&;run "0123456789ABCDEF yolo" - (&;between +17 +100 &;hex-digit))) - (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") - (&;run "0123456789ABCDEF yolo" - (&;between +15 +20 &;hex-digit))))) - - (test "Can optionally lex a token." - (and (|> (&;run "123abc" - (&;opt &;hex-digit)) - (case> (#;Right (#;Some "1")) true - _ false)) - (|> (&;run "yolo" - (&;opt &;hex-digit)) - (case> (#;Right #;None) true - _ false)))) - - (test "Can take into account separators during lexing." - (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "a" "b" "c" "d" "e" "f") - (&;run "0 1 2 3 4 5 6 7 8 9 a b c d e f YOLO" - (&;sep-by &;space &;hex-digit)))) - - (test "Can obtain the whole of the remaining input." - (should-passT "yolo" (&;run "yolo" - &;get-input))) + (should-passT "" (&;run "" + (&;some &;hex-digit))))) )) diff --git a/stdlib/test/test/lux/data/text/regex.lux b/stdlib/test/test/lux/data/text/regex.lux index bef24c0bf..ce18c0539 100644 --- a/stdlib/test/test/lux/data/text/regex.lux +++ b/stdlib/test/test/lux/data/text/regex.lux @@ -2,7 +2,8 @@ lux (lux [io] (control monad - pipe) + pipe + ["p" parser]) (data [product] [text "T/" Eq] text/format @@ -216,7 +217,7 @@ ($_ seq (test "Can match a pattern N times." (and (should-passT "aa" (&;regex "a{2}") "aa") - (should-passT "a" (&;regex "a{1}") "aa") + (should-passT "a" (&;regex "a{1}") "a") (should-fail (&;regex "a{3}") "aa"))) (test "Can match a pattern at-least N times." @@ -225,14 +226,12 @@ (should-fail (&;regex "a{3,}") "aa"))) (test "Can match a pattern at-most N times." - (and (should-passT "a" (&;regex "a{,1}") "aa") - (should-passT "aa" (&;regex "a{,2}") "aa") + (and (should-passT "aa" (&;regex "a{,2}") "aa") (should-passT "aa" (&;regex "a{,3}") "aa"))) (test "Can match a pattern between N and M times." (and (should-passT "a" (&;regex "a{1,2}") "a") - (should-passT "aa" (&;regex "a{1,2}") "aa") - (should-passT "aa" (&;regex "a{1,2}") "aaa"))) + (should-passT "aa" (&;regex "a{1,2}") "aa"))) )) (context: "Regular Expressions [Groups]" diff --git a/stdlib/test/test/lux/macro/syntax.lux b/stdlib/test/test/lux/macro/syntax.lux index 5f84f5c26..fa53e4596 100644 --- a/stdlib/test/test/lux/macro/syntax.lux +++ b/stdlib/test/test/lux/macro/syntax.lux @@ -2,7 +2,8 @@ lux (lux [io] (control monad - eq) + eq + ["p" parser]) (data [text "Text/" Monoid] text/format [number] @@ -19,7 +20,7 @@ ## [Utils] (def: (enforced? parser input) (-> (Syntax []) (List Code) Bool) - (case (s;run input parser) + (case (p;run input parser) (#;Right [_ []]) true @@ -28,7 +29,7 @@ (def: (found? parser input) (-> (Syntax Bool) (List Code) Bool) - (case (s;run input parser) + (case (p;run input parser) (#;Right [_ true]) true @@ -37,7 +38,7 @@ (def: (is? Eq test parser input) (All [a] (-> (Eq a) a (Syntax a) (List Code) Bool)) - (case (s;run input parser) + (case (p;run input parser) (#;Right [_ output]) (:: Eq = test output) @@ -85,16 +86,16 @@ (test "Can parse symbols belonging to the current namespace." (and (match "yolo" - (s;run (list (code;local-symbol "yolo")) + (p;run (list (code;local-symbol "yolo")) s;local-symbol)) - (fails? (s;run (list (code;symbol ["yolo" "lol"])) + (fails? (p;run (list (code;symbol ["yolo" "lol"])) s;local-symbol)))) (test "Can parse tags belonging to the current namespace." (and (match "yolo" - (s;run (list (code;local-tag "yolo")) + (p;run (list (code;local-tag "yolo")) s;local-tag)) - (fails? (s;run (list (code;tag ["yolo" "lol"])) + (fails? (p;run (list (code;tag ["yolo" "lol"])) s;local-tag)))) ))) @@ -103,21 +104,21 @@ [ (do-template [ ] [(test (format "Can parse " " syntax.") (and (match [true 123] - (s;run (list ( (list (code;bool true) (code;int 123)))) - ( (s;seq s;bool s;int)))) + (p;run (list ( (list (code;bool true) (code;int 123)))) + ( (p;seq s;bool s;int)))) (match true - (s;run (list ( (list (code;bool true)))) + (p;run (list ( (list (code;bool true)))) ( s;bool))) - (fails? (s;run (list ( (list (code;bool true) (code;int 123)))) + (fails? (p;run (list ( (list (code;bool true) (code;int 123)))) ( s;bool))) (match (#;Left true) - (s;run (list ( (list (code;bool true)))) - ( (s;alt s;bool s;int)))) + (p;run (list ( (list (code;bool true)))) + ( (p;alt s;bool s;int)))) (match (#;Right 123) - (s;run (list ( (list (code;int 123)))) - ( (s;alt s;bool s;int)))) - (fails? (s;run (list ( (list (code;real 123.0)))) - ( (s;alt s;bool s;int))))))] + (p;run (list ( (list (code;int 123)))) + ( (p;alt s;bool s;int)))) + (fails? (p;run (list ( (list (code;real 123.0)))) + ( (p;alt s;bool s;int))))))] ["form" s;form code;form] ["tuple" s;tuple code;tuple])] @@ -126,129 +127,29 @@ (test "Can parse record syntax." (match [true 123] - (s;run (list (code;record (list [(code;bool true) (code;int 123)]))) - (s;record (s;seq s;bool s;int))))) + (p;run (list (code;record (list [(code;bool true) (code;int 123)]))) + (s;record (p;seq s;bool s;int))))) ))) -(context: "Assertions" - (test "Can make assertions while parsing." - (and (match [] - (s;run (list (code;bool true) (code;int 123)) - (s;assert "yolo" true))) - (fails? (s;run (list (code;bool true) (code;int 123)) - (s;assert "yolo" false)))))) - -(context: "Combinators [Part 1]" +(context: "Combinators" ($_ seq (test "Can parse any Code." (match [_ (#;Bool true)] - (s;run (list (code;bool true) (code;int 123)) + (p;run (list (code;bool true) (code;int 123)) s;any))) - (test "Can optionally succeed with some parser." - (and (match (#;Some +123) - (s;run (list (code;nat +123)) - (s;opt s;nat))) - (match #;None - (s;run (list (code;int -123)) - (s;opt s;nat))))) - - (test "Can apply a parser 0 or more times." - (and (match (list +123 +456 +789) - (s;run (list (code;nat +123) (code;nat +456) (code;nat +789)) - (s;some s;nat))) - (match (list) - (s;run (list (code;int -123)) - (s;some s;nat))))) - - (test "Can apply a parser 1 or more times." - (and (match (list +123 +456 +789) - (s;run (list (code;nat +123) (code;nat +456) (code;nat +789)) - (s;many s;nat))) - (match (list +123) - (s;run (list (code;nat +123)) - (s;many s;nat))) - (fails? (s;run (list (code;int -123)) - (s;many s;nat))))) - - (test "Can use either parser." - (and (match 123 - (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;either s;pos-int s;int))) - (match -123 - (s;run (list (code;int -123) (code;int 456) (code;int 789)) - (s;either s;pos-int s;int))) - (fails? (s;run (list (code;bool true) (code;int 456) (code;int 789)) - (s;either s;pos-int s;int))))) - - (test "Can create the opposite/negation of any parser." - (and (fails? (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;not s;int))) - (match [] - (s;run (list (code;bool true) (code;int 456) (code;int 789)) - (s;not s;int))))) - )) - -(context: "Combinators Part [2]" - ($_ seq (test "Can check whether the end has been reached." (and (match true - (s;run (list) + (p;run (list) s;end?)) (match false - (s;run (list (code;bool true)) + (p;run (list (code;bool true)) s;end?)))) (test "Can ensure the end has been reached." (and (match [] - (s;run (list) + (p;run (list) s;end!)) - (fails? (s;run (list (code;bool true)) + (fails? (p;run (list (code;bool true)) s;end!)))) - - (test "Can apply a parser N times." - (and (match (list 123 456 789) - (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;exactly +3 s;int))) - (match (list 123 456) - (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;exactly +2 s;int))) - (fails? (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;exactly +4 s;int))))) - - (test "Can apply a parser at-least N times." - (and (match (list 123 456 789) - (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;at-least +3 s;int))) - (match (list 123 456 789) - (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;at-least +2 s;int))) - (fails? (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;at-least +4 s;int))))) - - (test "Can apply a parser at-most N times." - (and (match (list 123 456 789) - (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;at-most +3 s;int))) - (match (list 123 456) - (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;at-most +2 s;int))) - (match (list 123 456 789) - (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;at-most +4 s;int))))) - - (test "Can apply a parser between N and M times." - (and (match (list 123 456 789) - (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;between +3 +10 s;int))) - (fails? (s;run (list (code;int 123) (code;int 456) (code;int 789)) - (s;between +4 +10 s;int))))) - - (test "Can parse while taking separators into account." - (and (match (list 123 456 789) - (s;run (list (code;int 123) (code;text "YOLO") (code;int 456) (code;text "YOLO") (code;int 789)) - (s;sep-by (s;this (' "YOLO")) s;int))) - (match (list 123 456) - (s;run (list (code;int 123) (code;text "YOLO") (code;int 456) (code;int 789)) - (s;sep-by (s;this (' "YOLO")) s;int))))) )) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 0a609ce13..a663db7bf 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -21,7 +21,8 @@ ["_;" cont] ["_;" reader] ["_;" state] - ["_;" thunk]) + ["_;" thunk] + ["_;" parser]) (data ["_;" bit] ["_;" bool] ["_;" char] @@ -31,11 +32,11 @@ ["_;" log] ["_;" maybe] ["_;" number] - (number ["_;" ratio] - ["_;" complex]) ["_;" product] ["_;" sum] ["_;" text] + (number ["_;" ratio] + ["_;" complex]) (format ["_;" json] ["_;" xml]) (coll ["_;" array] @@ -67,7 +68,7 @@ ["_;" type] (type ["_;" check] ["_;" auto]) - (paradigm ["_;" object]) + ## (paradigm ["_;" object]) )) (lux (control [contract]) (data [env] -- cgit v1.2.3