From 9d64d85cbd5a892368cd2c48147753e76ce13dc4 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 14 Dec 2016 14:55:58 -0400 Subject: - Updated lux/pipe, lux/lexer and lux/regex tests. --- stdlib/source/lux/data/format/json.lux | 20 +- stdlib/source/lux/lexer.lux | 34 ++-- stdlib/source/lux/macro/syntax.lux | 2 +- stdlib/source/lux/pipe.lux | 10 +- stdlib/source/lux/regex.lux | 100 ++++----- stdlib/test/test/lux/lexer.lux | 349 ++++++++++++++++++++----------- stdlib/test/test/lux/pipe.lux | 105 ++++++---- stdlib/test/test/lux/regex.lux | 361 +++++++++++++++++++-------------- stdlib/test/tests.lux | 7 +- 9 files changed, 599 insertions(+), 389 deletions(-) (limited to 'stdlib') diff --git a/stdlib/source/lux/data/format/json.lux b/stdlib/source/lux/data/format/json.lux index 280aab24b..e8189a594 100644 --- a/stdlib/source/lux/data/format/json.lux +++ b/stdlib/source/lux/data/format/json.lux @@ -217,19 +217,19 @@ (def: data-sep (Lexer [Text Char Text]) - ($_ lexer;seq space~ (lexer;this-char #",") space~)) + ($_ lexer;seq space~ (lexer;char #",") space~)) (def: null~ (Lexer Null) (do Monad - [_ (lexer;this "null")] + [_ (lexer;text "null")] (wrap []))) (do-template [ ] [(def: (Lexer Boolean) (do Monad - [_ (lexer;this )] + [_ (lexer;text )] (wrap )))] [t~ "true" true] @@ -244,12 +244,12 @@ (Lexer Number) (do Monad [?sign (: (Lexer (Maybe Text)) - (lexer;opt (lexer;this "-"))) + (lexer;opt (lexer;text "-"))) digits (: (Lexer Text) (lexer;many' lexer;digit)) ?decimals (: (Lexer (Maybe Text)) (lexer;opt (do @ - [_ (lexer;this ".")] + [_ (lexer;text ".")] (lexer;many' lexer;digit))))] (case (: (Error Real) (Real/decode (format (default "" ?sign) @@ -290,9 +290,9 @@ (def: string~ (Lexer String) (do Monad - [_ (lexer;this "\"") + [_ (lexer;text "\"") string-body string-body~ - _ (lexer;this "\"")] + _ (lexer;text "\"")] (wrap string-body))) (def: (kv~ json~) @@ -300,7 +300,7 @@ (do Monad [key string~ _ space~ - _ (lexer;this-char #":") + _ (lexer;char #":") _ space~ value (json~ [])] (wrap [key value]))) @@ -309,11 +309,11 @@ [(def: ( json~) (-> (-> Unit (Lexer JSON)) (Lexer )) (do Monad - [_ (lexer;this-char ) + [_ (lexer;char ) _ space~ elems (lexer;sep-by data-sep ) _ space~ - _ (lexer;this-char )] + _ (lexer;char )] (wrap ( elems))))] [array~ Array #"[" #"]" (json~ []) vector;from-list] diff --git a/stdlib/source/lux/lexer.lux b/stdlib/source/lux/lexer.lux index 6d54f2614..e27e1925a 100644 --- a/stdlib/source/lux/lexer.lux +++ b/stdlib/source/lux/lexer.lux @@ -147,8 +147,8 @@ output output))) -(def: #export (assert test message) - (-> Bool Text (Lexer Unit)) +(def: #export (assert message test) + (-> Text Bool (Lexer Unit)) (lambda [input] (if test (#;Right [input []]) @@ -225,14 +225,14 @@ (#;Right [input (#;Some value)]) ))) -(def: #export (this text) +(def: #export (text test) (-> Text (Lexer Text)) (lambda [input] - (if (text;starts-with? text input) - (case (text;split (text;size text) input) + (if (text;starts-with? test input) + (case (text;split (text;size test) input) #;None (#;Left "") - (#;Some [_ input']) (#;Right [input' text])) - (#;Left (format "Invalid match: " text " @ " (:: text;Codec encode input)))) + (#;Some [_ input']) (#;Right [input' test])) + (#;Left (format "Invalid match: " test " @ " (:: text;Codec encode input)))) )) (def: #export (sep-by sep p) @@ -268,15 +268,15 @@ (#;Left "Can't peek character from empty text.")) )) -(def: #export (this-char char) +(def: #export (char test) (-> Char (Lexer Char)) (lambda [input] (case [(text;at +0 input) (text;split +1 input)] [(#;Some char') (#;Some [_ input'])] - (if (Char/= char char') - (#;Right [input' char]) - (#;Left (format "Expected " (:: char;Codec encode char) " @ " (:: text;Codec encode input) - " " (Int/encode (c2l char))" " (Int/encode (c2l [char']))))) + (if (Char/= test char') + (#;Right [input' test]) + (#;Left (format "Expected " (:: char;Codec encode test) " @ " (:: text;Codec encode input) + " " (Int/encode (c2l test))" " (Int/encode (c2l [char']))))) _ (#;Left "Can't parse character from empty text.")) @@ -292,9 +292,9 @@ (do Monad [input get-input char any - _ (assert (and (Char/>= bottom char) - (Char/<= top char)) - (format "Character is not within range: " (:: char;Codec encode bottom) "-" (:: char;Codec encode top) " @ " (:: text;Codec encode input)))] + _ (assert (format "Character is not within range: " (:: char;Codec encode bottom) "-" (:: char;Codec encode top) " @ " (:: text;Codec encode input)) + (and (Char/>= bottom char) + (Char/<= top char)))] (wrap char))) (do-template [ ] @@ -434,6 +434,6 @@ (def: #export (enclosed [start end] lexer) (All [a] (-> [Text Text] (Lexer a) (Lexer a))) - (_& (this start) + (_& (text start) (&_ lexer - (this end)))) + (text end)))) diff --git a/stdlib/source/lux/macro/syntax.lux b/stdlib/source/lux/macro/syntax.lux index 00a2ba96e..ce36cef19 100644 --- a/stdlib/source/lux/macro/syntax.lux +++ b/stdlib/source/lux/macro/syntax.lux @@ -446,7 +446,7 @@ (wrap [(ast;symbol var-name) (` any)]) _ - (compiler;fail "Syntax pattern expects records or symbols.")))) + (compiler;fail "Syntax pattern expects tuples or symbols.")))) args) #let [g!state (ast;symbol ["" "*compiler*"]) g!end (ast;symbol ["" ""]) diff --git a/stdlib/source/lux/pipe.lux b/stdlib/source/lux/pipe.lux index 95167f7f2..5c553b7ec 100644 --- a/stdlib/source/lux/pipe.lux +++ b/stdlib/source/lux/pipe.lux @@ -31,13 +31,17 @@ _ (undefined))) -(syntax: #export (@> [body body^] +(syntax: #export (@> [name (s;default "@" s;local-symbol)] + [body body^] prev) {#;doc (doc "Gives the name '@' to the piped-argument, within the given expression." (|> 5 - (@> [(i.+ @ @)])))} + (@> [(i.+ @ @)])) + + (|> 5 + (@> X [(i.+ X X)])))} (wrap (list (fold (lambda [next prev] - (` (let% [(~' @) (~ prev)] + (` (let% [(~ (ast;symbol ["" name])) (~ prev)] (~ next)))) prev body)))) diff --git a/stdlib/source/lux/regex.lux b/stdlib/source/lux/regex.lux index 95599852c..e3cd95811 100644 --- a/stdlib/source/lux/regex.lux +++ b/stdlib/source/lux/regex.lux @@ -31,7 +31,7 @@ (def: escaped-char^ (Lexer Char) (do Monad - [? (&;opt (&;this-char #"\\")) + [? (&;opt (&;char #"\\")) char (case ? (#;Some _) &;any #;None regex-char^)] @@ -57,7 +57,7 @@ (def: #hidden word^ (Lexer Char) (&;either &;alpha-num - (&;this-char #"_"))) + (&;char #"_"))) (def: #hidden (join-text^ part^) (-> (Lexer (List Text)) (Lexer Text)) @@ -82,9 +82,9 @@ (do Monad [] ($_ &;either - (&;seq (wrap current-module) (&;_& (&;this ";;") identifier-part^)) - (&;seq identifier-part^ (&;_& (&;this ";") identifier-part^)) - (&;seq (wrap "lux") (&;_& (&;this ";") identifier-part^)) + (&;seq (wrap current-module) (&;_& (&;text ";;") identifier-part^)) + (&;seq identifier-part^ (&;_& (&;text ";") identifier-part^)) + (&;seq (wrap "lux") (&;_& (&;text ";") identifier-part^)) (&;seq (wrap "") identifier-part^)))) (def: (re-var^ current-module) @@ -97,7 +97,7 @@ (Lexer AST) (do Monad [from regex-char^ - _ (&;this-char #"-") + _ (&;char #"-") to regex-char^] (wrap (` (&;char-range (~ (ast;char from)) (~ (ast;char to))))))) @@ -105,7 +105,7 @@ (Lexer AST) (do Monad [char escaped-char^] - (wrap (` (&;this-char (~ (ast;char char))))))) + (wrap (` (&;char (~ (ast;char char))))))) (def: re-char+^ (Lexer AST) @@ -122,7 +122,7 @@ (def: re-user-class^' (Lexer AST) (do Monad - [negate? (&;opt (&;this-char #"^")) + [negate? (&;opt (&;char #"^")) parts (&;many ($_ &;either re-char-range^ re-char-options^))] @@ -135,7 +135,7 @@ (do Monad [_ (wrap []) init re-user-class^' - rest (&;some (&;_& (&;this "&&") (&;enclosed ["[" "]"] re-user-class^')))] + rest (&;some (&;_& (&;text "&&") (&;enclosed ["[" "]"] re-user-class^')))] (wrap (fold (lambda [refinement base] (` (refine^ (~ refinement) (~ base)))) init @@ -152,7 +152,7 @@ (def: #hidden control^ (Lexer Char) (&;either (&;char-range #"\u0000" #"\u001F") - (&;this-char #"\u007F"))) + (&;char #"\u007F"))) (def: #hidden punct^ (Lexer Char) @@ -165,36 +165,36 @@ (def: #hidden print^ (Lexer Char) (&;either graph^ - (&;this-char #"\u0020"))) + (&;char #"\u0020"))) (def: re-system-class^ (Lexer AST) (do Monad [] ($_ &;either - (&;_& (&;this-char #".") (wrap (` (->Text &;any)))) - (&;_& (&;this "\\d") (wrap (` (->Text &;digit)))) - (&;_& (&;this "\\D") (wrap (` (->Text (&;not &;digit))))) - (&;_& (&;this "\\s") (wrap (` (->Text &;space)))) - (&;_& (&;this "\\S") (wrap (` (->Text (&;not &;space))))) - (&;_& (&;this "\\w") (wrap (` (->Text word^)))) - (&;_& (&;this "\\W") (wrap (` (->Text (&;not word^))))) - (&;_& (&;this "\\d") (wrap (` (->Text &;digit)))) - - (&;_& (&;this "\\p{Lower}") (wrap (` (->Text &;lower)))) - (&;_& (&;this "\\p{Upper}") (wrap (` (->Text &;upper)))) - (&;_& (&;this "\\p{Alpha}") (wrap (` (->Text &;alpha)))) - (&;_& (&;this "\\p{Digit}") (wrap (` (->Text &;digit)))) - (&;_& (&;this "\\p{Alnum}") (wrap (` (->Text &;alpha-num)))) - (&;_& (&;this "\\p{Space}") (wrap (` (->Text &;space)))) - (&;_& (&;this "\\p{HexDigit}") (wrap (` (->Text &;hex-digit)))) - (&;_& (&;this "\\p{OctDigit}") (wrap (` (->Text &;oct-digit)))) - (&;_& (&;this "\\p{Blank}") (wrap (` (->Text blank^)))) - (&;_& (&;this "\\p{ASCII}") (wrap (` (->Text ascii^)))) - (&;_& (&;this "\\p{Contrl}") (wrap (` (->Text control^)))) - (&;_& (&;this "\\p{Punct}") (wrap (` (->Text punct^)))) - (&;_& (&;this "\\p{Graph}") (wrap (` (->Text graph^)))) - (&;_& (&;this "\\p{Print}") (wrap (` (->Text print^)))) + (&;_& (&;char #".") (wrap (` (->Text &;any)))) + (&;_& (&;text "\\d") (wrap (` (->Text &;digit)))) + (&;_& (&;text "\\D") (wrap (` (->Text (&;not &;digit))))) + (&;_& (&;text "\\s") (wrap (` (->Text &;space)))) + (&;_& (&;text "\\S") (wrap (` (->Text (&;not &;space))))) + (&;_& (&;text "\\w") (wrap (` (->Text word^)))) + (&;_& (&;text "\\W") (wrap (` (->Text (&;not word^))))) + (&;_& (&;text "\\d") (wrap (` (->Text &;digit)))) + + (&;_& (&;text "\\p{Lower}") (wrap (` (->Text &;lower)))) + (&;_& (&;text "\\p{Upper}") (wrap (` (->Text &;upper)))) + (&;_& (&;text "\\p{Alpha}") (wrap (` (->Text &;alpha)))) + (&;_& (&;text "\\p{Digit}") (wrap (` (->Text &;digit)))) + (&;_& (&;text "\\p{Alnum}") (wrap (` (->Text &;alpha-num)))) + (&;_& (&;text "\\p{Space}") (wrap (` (->Text &;space)))) + (&;_& (&;text "\\p{HexDigit}") (wrap (` (->Text &;hex-digit)))) + (&;_& (&;text "\\p{OctDigit}") (wrap (` (->Text &;oct-digit)))) + (&;_& (&;text "\\p{Blank}") (wrap (` (->Text blank^)))) + (&;_& (&;text "\\p{ASCII}") (wrap (` (->Text ascii^)))) + (&;_& (&;text "\\p{Contrl}") (wrap (` (->Text control^)))) + (&;_& (&;text "\\p{Punct}") (wrap (` (->Text punct^)))) + (&;_& (&;text "\\p{Graph}") (wrap (` (->Text graph^)))) + (&;_& (&;text "\\p{Print}") (wrap (` (->Text print^)))) ))) (def: re-class^ @@ -209,14 +209,14 @@ (def: re-back-reference^ (Lexer AST) (&;either (do Monad - [_ (&;this-char #"\\") + [_ (&;char #"\\") id int^] - (wrap (` (&;this (~ (ast;symbol ["" (Int/encode id)])))))) + (wrap (` (&;text (~ (ast;symbol ["" (Int/encode id)])))))) (do Monad - [_ (&;this "\\k<") + [_ (&;text "\\k<") captured-name identifier-part^ - _ (&;this ">")] - (wrap (` (&;this (~ (ast;symbol ["" captured-name])))))))) + _ (&;text ">")] + (wrap (` (&;text (~ (ast;symbol ["" captured-name])))))))) (def: (re-simple^ current-module) (-> Text (Lexer AST)) @@ -250,15 +250,15 @@ (&;enclosed ["{" "}"] ($_ &;either (do @ - [[from to] (&;seq int^ (&;_& (&;this-char #",") int^))] + [[from to] (&;seq int^ (&;_& (&;char #",") int^))] (wrap (` (join-text^ (&;between (~ (ast;nat (int-to-nat from))) (~ (ast;nat (int-to-nat to))) (~ base)))))) (do @ - [limit (&;_& (&;this-char #",") int^)] + [limit (&;_& (&;char #",") int^)] (wrap (` (join-text^ (&;at-most (~ (ast;nat (int-to-nat limit))) (~ base)))))) (do @ - [limit (&;&_ int^ (&;this-char #","))] + [limit (&;&_ int^ (&;char #","))] (wrap (` (join-text^ (&;at-least (~ (ast;nat (int-to-nat limit))) (~ base)))))) (do @ [limit int^] @@ -382,7 +382,7 @@ (do Monad [#let [sub^ (re-sequential^ capturing? re-scoped^ current-module)] head sub^ - tail (&;some (&;_& (&;this-char #"|") sub^)) + tail (&;some (&;_& (&;char #"|") sub^)) #let [g!op (if capturing? (` |||^) (` |||_^))]] @@ -395,24 +395,24 @@ (-> Text (Lexer [Re-Group AST])) ($_ &;either (do Monad - [_ (&;this "(?:") + [_ (&;text "(?:") [_ scoped] (re-alternative^ false re-scoped^ current-module) - _ (&;this-char #")")] + _ (&;char #")")] (wrap [#Non-Capturing scoped])) (do Monad [complex (re-complex^ current-module)] (wrap [#Non-Capturing complex])) (do Monad - [_ (&;this "(?<") + [_ (&;text "(?<") captured-name identifier-part^ - _ (&;this ">") + _ (&;text ">") [num-captures pattern] (re-alternative^ true re-scoped^ current-module) - _ (&;this-char #")")] + _ (&;char #")")] (wrap [(#Capturing [(#;Some captured-name) num-captures]) pattern])) (do Monad - [_ (&;this-char #"(") + [_ (&;char #"(") [num-captures pattern] (re-alternative^ true re-scoped^ current-module) - _ (&;this-char #")")] + _ (&;char #")")] (wrap [(#Capturing [#;None num-captures]) pattern])))) (def: (regex^ current-module) diff --git a/stdlib/test/test/lux/lexer.lux b/stdlib/test/test/lux/lexer.lux index d0b17fe4b..fc51deafd 100644 --- a/stdlib/test/test/lux/lexer.lux +++ b/stdlib/test/test/lux/lexer.lux @@ -4,130 +4,247 @@ ## You can obtain one at http://mozilla.org/MPL/2.0/. (;module: - [lux #- not] + lux (lux (control monad) (codata [io]) - (data error) - [test #- fail assert] - lexer)) + (data [error #- fail] + [text "T/" Eq] + text/format + [char "C/" Eq] + (struct [list])) + (math ["R" random]) + pipe + ["&" lexer]) + lux/test) + +## [Utils] +(def: (should-fail input) + (All [a] (-> (Error a) Bool)) + (case input + (#;Left _) true + _ false)) + +(def: (should-passC test input) + (-> Char (Error Char) Bool) + (case input + (#;Right output) + (C/= test output) + + _ + false)) + +(def: (should-passT test input) + (-> Text (Error Text) Bool) + (case input + (#;Right output) + (T/= test output) + + _ + false)) + +(def: (should-passL test input) + (-> (List Char) (Error (List Char)) Bool) + (let [(^open "L/") (list;Eq char;Eq)] + (case input + (#;Right output) + (L/= test output) + + _ + false))) + +(def: (should-passE test input) + (-> (Either Char Char) (Error (Either Char Char)) Bool) + (case input + (#;Right output) + (case [test output] + [(#;Left test) (#;Left output)] + (C/= test output) + + [(#;Right test) (#;Right output)] + (C/= test output) + + _ + false) + + _ + false)) ## [Tests] -(test: "Lexer end works" - (test-all (should-pass (run end "")) - (should-fail (run end "YOLO")))) +(test: "End" + ($_ seq + (assert "Can detect the end of the input." + (|> (&;run &;end "") + (case> (#;Right _) true _ false))) + + (assert "Won't mistake non-empty text for no more input." + (|> (&;run &;end "YOLO") + (case> (#;Left _) true _ false))) + )) -(test: "Simple text lexers" - (test-all (match (#;Right "YO") - (run (this "YO") "YOLO")) - (should-fail (run (this "YO") "MEME")))) +(test: "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)))] + ($_ seq + (assert "Can find literal text fragments." + (and (|> (&;run (&;text pre) (format pre post)) + (case> (#;Right found) (T/= pre found) _ false)) + (|> (&;run (&;text pre) post) + (case> (#;Left _) true _ false)))) + )) (test: "Char lexers" - (test-all (match (#;Right #"Y") - (run (this-char #"Y") "YOLO")) - (should-fail (run (this-char #"Y") "MEME")) - (match (#;Right #"Y") - (run (char-range #"X" #"Z") "YOLO")) - (should-fail (run (char-range #"X" #"Z") "MEME")) - (match (#;Right #"Y") - (run upper "YOLO")) - (should-fail (run upper "meme")) - (match (#;Right #"y") - (run lower "yolo")) - (should-fail (run lower "MEME")) - (match (#;Right #"1") - (run digit "1")) - (should-fail (run digit " ")) - (match (#;Right #"7") - (run oct-digit "7")) - (should-fail (run oct-digit "8")) - (match (#;Right #"A") - (run any "A")) - (should-fail (run any "")))) + ($_ seq + (assert "Can lex characters." + (and (|> (&;run (&;char #"Y") "YOLO") + (case> (#;Right #"Y") true _ false)) + (|> (&;run (&;char #"Y") "MEME") + (case> (#;Left _) true _ false)))) + + (assert "Can lex characters ranges." + (and (should-passC #"Y" (&;run (&;char-range #"X" #"Z") "YOLO")) + (should-fail (&;run (&;char-range #"X" #"Z") "MEME")))) + )) + +(test: "Custom lexers" + ($_ seq + (assert "Can lex anything" + (and (should-passC #"A" (&;run &;any "A")) + (should-fail (&;run &;any "")))) + + (assert "Can lex upper-case and &;lower-case letters." + (and (should-passC #"Y" (&;run &;upper "YOLO")) + (should-fail (&;run &;upper "meme")) + + (should-passC #"y" (&;run &;lower "yolo")) + (should-fail (&;run &;lower "MEME")))) + + (assert "Can lex numbers." + (and (should-passC #"1" (&;run &;digit "1")) + (should-fail (&;run &;digit " ")) + + (should-passC #"7" (&;run &;oct-digit "7")) + (should-fail (&;run &;oct-digit "8")) + + (should-passC #"1" (&;run &;hex-digit "1")) + (should-passC #"a" (&;run &;hex-digit "a")) + (should-passC #"A" (&;run &;hex-digit "A")) + (should-fail (&;run &;hex-digit " ")) + )) + + (assert "Can lex alphabetic characters." + (and (should-passC #"A" (&;run &;alpha "A")) + (should-passC #"a" (&;run &;alpha "a")) + (should-fail (&;run &;alpha "1")))) + + (assert "Can lex alphanumeric characters." + (and (should-passC #"A" (&;run &;alpha-num "A")) + (should-passC #"a" (&;run &;alpha-num "a")) + (should-passC #"1" (&;run &;alpha-num "1")) + (should-fail (&;run &;alpha-num " ")))) + + (assert "Can lex white-space." + (and (should-passC #" " (&;run &;space " ")) + (should-fail (&;run &;space "8")))) + )) (test: "Combinators" - (test-all (match (#;Right [#"Y" #"O"]) - (run (seq any any) "YOLO")) - (should-fail (run (seq any any) "Y")) - (match+ (#;Left #"0") - (should-pass (run (alt digit upper) "0"))) - (match+ (#;Right #"A") - (should-pass (run (alt digit upper) "A"))) - (should-fail (run (alt digit upper) "a")) - (should-pass (run (not (alt digit upper)) "a")) - (should-fail (run (not (alt digit upper)) "A")) - (match (#;Right #"0") - (run (either digit upper) "0")) - (match (#;Right #"A") - (run (either digit upper) "A")) - (should-fail (run (either digit upper) "a")) - (match (#;Right #"A") - (run alpha "A")) - (match (#;Right #"a") - (run alpha "a")) - (should-fail (run alpha "1")) - (match (#;Right #"A") - (run alpha-num "A")) - (match (#;Right #"a") - (run alpha-num "a")) - (match (#;Right #"1") - (run alpha-num "1")) - (should-fail (run alpha-num " ")) - (match (#;Right #"1") - (run hex-digit "1")) - (match (#;Right #"a") - (run hex-digit "a")) - (match (#;Right #"A") - (run hex-digit "A")) - (should-fail (run hex-digit " ")) - (match (#;Right #" ") - (run space " ")) - (should-fail (run space "8")) - (match (#;Right #"C") - (run (one-of "ABC") "C")) - (should-fail (run (one-of "ABC") "D")) - (match (#;Right #"D") - (run (none-of "ABC") "D")) - (should-fail (run (none-of "ABC") "C")) - (match (#;Right #"D") - (run (satisfies (lambda [c] true)) "D")) - (should-fail (run (satisfies (lambda [c] false)) "C")) - (match (#;Right "0123456789ABCDEF") - (run (many' hex-digit) "0123456789ABCDEF yolo")) - (should-fail (run (many' hex-digit) "yolo")) - (match (#;Right "") - (run (some' hex-digit) "yolo")) - )) + ($_ seq + (assert "Can combine lexers sequentially." + (and (|> (&;run (&;seq &;any &;any) "YOLO") + (case> (#;Right [#"Y" #"O"]) true + _ false)) + (should-fail (&;run (&;seq &;any &;any) "Y")))) + + (assert "Can combine lexers alternatively." + (and (should-passE (#;Left #"0") (&;run (&;alt &;digit &;upper) "0")) + (should-passE (#;Right #"A") (&;run (&;alt &;digit &;upper) "A")) + (should-fail (&;run (&;alt &;digit &;upper) "a")))) + + (assert "Can create the opposite of a lexer." + (and (should-passC #"a" (&;run (&;not (&;alt &;digit &;upper)) "a")) + (should-fail (&;run (&;not (&;alt &;digit &;upper)) "A")))) + + (assert "Can use either lexer." + (and (should-passC #"0" (&;run (&;either &;digit &;upper) "0")) + (should-passC #"A" (&;run (&;either &;digit &;upper) "A")) + (should-fail (&;run (&;either &;digit &;upper) "a")))) + + (assert "Can select from among a set of characters." + (and (should-passC #"C" (&;run (&;one-of "ABC") "C")) + (should-fail (&;run (&;one-of "ABC") "D")))) + + (assert "Can avoid a set of characters." + (and (should-passC #"D" (&;run (&;none-of "ABC") "D")) + (should-fail (&;run (&;none-of "ABC") "C")))) + + (assert "Can lex using arbitrary predicates." + (and (should-passC #"D" (&;run (&;satisfies (lambda [c] true)) "D")) + (should-fail (&;run (&;satisfies (lambda [c] false)) "C")))) + + (assert "Can apply a lexer multiple times." + (and (should-passT "0123456789ABCDEF" (&;run (&;many' &;hex-digit) "0123456789ABCDEF yolo")) + (should-fail (&;run (&;many' &;hex-digit) "yolo")) + + (should-passT "" (&;run (&;some' &;hex-digit) "yolo")))) + )) (test: "Yet more combinators..." - (test-all (should-fail (run (fail "Well, it really SHOULD fail...") "yolo")) - (should-fail (run (assert false "Well, it really SHOULD fail...") "yolo")) - (should-pass (run (assert true "GO, GO, GO!") "yolo")) - (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F"))) - (run (many hex-digit) "0123456789ABCDEF yolo")) - (should-fail (run (many hex-digit) "yolo")) - (match (^ (#;Right (list))) - (run (some hex-digit) "yolo")) - (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F"))) - (run (exactly +16 hex-digit) "0123456789ABCDEF yolo")) - (match (^ (#;Right (list #"0" #"1" #"2"))) - (run (exactly +3 hex-digit) "0123456789ABCDEF yolo")) - (should-fail (run (exactly +17 hex-digit) "0123456789ABCDEF yolo")) - (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F"))) - (run (at-most +16 hex-digit) "0123456789ABCDEF yolo")) - (match (^ (#;Right (list #"0" #"1" #"2"))) - (run (at-most +3 hex-digit) "0123456789ABCDEF yolo")) - (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F"))) - (run (at-most +17 hex-digit) "0123456789ABCDEF yolo")) - (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F"))) - (run (between +0 +16 hex-digit) "0123456789ABCDEF yolo")) - (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F"))) - (run (between +3 +16 hex-digit) "0123456789ABCDEF yolo")) - (should-fail (run (between +17 +100 hex-digit) "0123456789ABCDEF yolo")) - (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F"))) - (run (between +15 +20 hex-digit) "0123456789ABCDEF yolo")) - (match (#;Right (#;Some #"1")) (run (opt hex-digit) "123abc")) - (match (#;Right #;None) (run (opt hex-digit) "yolo")) - (match (^ (#;Right (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"a" #"b" #"c" #"d" #"e" #"f"))) - (run (sep-by space hex-digit) "0 1 2 3 4 5 6 7 8 9 a b c d e f YOLO")) - (match (#;Right "yolo") (run get-input "yolo")) - )) + ($_ seq + (assert "Can fail at will." + (should-fail (&;run (&;fail "Well, it really SHOULD fail...") "yolo"))) + + (assert "Can make assertions." + (and (should-fail (&;run (&;assert "Well, it really SHOULD fail..." false) "yolo")) + (|> (&;run (&;assert "GO, GO, GO!" true) "yolo") + (case> (#;Right []) true + _ false)))) + + (assert "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 (&;many &;hex-digit) "0123456789ABCDEF yolo")) + (should-fail (&;run (&;many &;hex-digit) "yolo")) + + (should-passL (list) + (&;run (&;some &;hex-digit) "yolo")))) + + (assert "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 (&;exactly +16 &;hex-digit) "0123456789ABCDEF yolo")) + (should-passL (list #"0" #"1" #"2") + (&;run (&;exactly +3 &;hex-digit) "0123456789ABCDEF yolo")) + (should-fail (&;run (&;exactly +17 &;hex-digit) "0123456789ABCDEF yolo")))) + + (assert "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 (&;at-most +16 &;hex-digit) "0123456789ABCDEF yolo")) + (should-passL (list #"0" #"1" #"2") + (&;run (&;at-most +3 &;hex-digit) "0123456789ABCDEF yolo")) + (should-passL (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F") + (&;run (&;at-most +17 &;hex-digit) "0123456789ABCDEF yolo")))) + + (assert "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 (&;between +0 +16 &;hex-digit) "0123456789ABCDEF yolo")) + (should-passL (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F") + (&;run (&;between +3 +16 &;hex-digit) "0123456789ABCDEF yolo")) + (should-fail (&;run (&;between +17 +100 &;hex-digit) "0123456789ABCDEF yolo")) + (should-passL (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F") + (&;run (&;between +15 +20 &;hex-digit) "0123456789ABCDEF yolo")))) + + (assert "Can optionally lex a token." + (and (|> (&;run (&;opt &;hex-digit) "123abc") + (case> (#;Right (#;Some #"1")) true + _ false)) + (|> (&;run (&;opt &;hex-digit) "yolo") + (case> (#;Right #;None) true + _ false)))) + + (assert "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 (&;sep-by &;space &;hex-digit) "0 1 2 3 4 5 6 7 8 9 a b c d e f YOLO"))) + + (assert "Can obtain the whole of the remaining input." + (should-passT "yolo" (&;run &;get-input "yolo"))) + )) diff --git a/stdlib/test/test/lux/pipe.lux b/stdlib/test/test/lux/pipe.lux index 681c4bf71..92ca205b8 100644 --- a/stdlib/test/test/lux/pipe.lux +++ b/stdlib/test/test/lux/pipe.lux @@ -1,3 +1,8 @@ +## Copyright (c) Eduardo Julian. All rights reserved. +## This Source Code Form is subject to the terms of the Mozilla Public License, v. 2.0. +## If a copy of the MPL was not distributed with this file, +## You can obtain one at http://mozilla.org/MPL/2.0/. + (;module: lux (lux (codata [io]) @@ -5,43 +10,71 @@ (data text/format [number] [product] - identity) + identity + [text "T/" Eq]) (codata function) + (math ["R" random]) pipe) lux/test) -(test: "lux/pipe exports" - (test-all (match 1 (|> 20 - (i.* 3) - (i.+ 4) - (_> 0 i.inc))) - (match 10 (|> 5 - (@> [(i.+ @ @)]))) - (match 15 (|> 5 - (?> [i.even?] [(i.* 2)] - [i.odd?] [(i.* 3)] - [(_> -1)]))) - (match 15 (|> 5 - (?> [i.even?] [(i.* 2)] - [i.odd?] [(i.* 3)]))) - (match 10 (|> 1 - (!> [(i.< 10)] - [i.inc]))) - (match 20 (|> 5 - (%> Monad - [(i.* 3)] - [(i.+ 4)] - [i.inc]))) - (match "five" (|> 5 - (case> 0 "zero" - 1 "one" - 2 "two" - 3 "three" - 4 "four" - 5 "five" - 6 "six" - 7 "seven" - 8 "eight" - 9 "nine" - _ "???"))) - )) +(test: "Pipes" + ($_ seq + (assert "Can dismiss previous pipeline results and begin a new line." + (|> 20 + (i.* 3) + (i.+ 4) + (_> 0 i.inc) + (i.= 1))) + + (assert "Can give names to piped values within a pipeline's scope." + (and (|> 5 + (@> [(i.+ @ @)]) + (i.= 10)) + (|> 5 + (@> X [(i.+ X X)]) + (i.= 10)))) + + (assert "Can do branching in pipelines." + (and (|> 5 + (?> [i.even?] [(i.* 2)] + [i.odd?] [(i.* 3)] + [(_> -1)]) + (i.= 15)) + (|> 4 + (?> [i.even?] [(i.* 2)] + [i.odd?] [(i.* 3)]) + (i.= 8)) + (|> 5 + (?> [i.even?] [(i.* 2)] + [(_> -1)]) + (i.= -1)))) + + (assert "Can loop within pipelines." + (|> 1 + (!> [(i.< 10)] + [i.inc]) + (i.= 10))) + + (assert "Can use monads within pipelines." + (|> 5 + (%> Monad + [(i.* 3)] + [(i.+ 4)] + [i.inc]) + (i.= 20))) + + (assert "Can pattern-match against piped values." + (|> 5 + (case> 0 "zero" + 1 "one" + 2 "two" + 3 "three" + 4 "four" + 5 "five" + 6 "six" + 7 "seven" + 8 "eight" + 9 "nine" + _ "???") + (T/= "five"))) + )) diff --git a/stdlib/test/test/lux/regex.lux b/stdlib/test/test/lux/regex.lux index 66355bdca..bb366ac90 100644 --- a/stdlib/test/test/lux/regex.lux +++ b/stdlib/test/test/lux/regex.lux @@ -7,194 +7,251 @@ lux (lux (codata [io]) (control monad) - (data error - [product]) + (data [error #- fail] + [product] + [text "T/" Eq] + text/format) [compiler] (macro [ast] ["s" syntax #+ syntax:]) - test + (math ["R" random]) + pipe [lexer] - regex)) - -(syntax: (should-regex {veredict (s;alt s;bool s;any)} {regex s;text} {input s;text}) - (case veredict - (+0 ?) - (if ? - (wrap (list (` (match+ (~ (ast;text input)) - (should-pass (lexer;run (regex (~ (ast;text regex))) - (~ (ast;text input)))))))) - (wrap (list (` (should-fail (lexer;run (regex (~ (ast;text regex))) - (~ (ast;text input)))))))) - - (+1 result) - (wrap (list (` (match+ (~ result) - (should-pass (lexer;run (regex (~ (ast;text regex))) - (~ (ast;text input)))))))))) + ["&" regex]) + lux/test) -## [Tests] -(test: "Regular Expressions [Basics]" - (test-all (should-regex true "a" "a") - (should-regex false "a" ".") - (should-regex true "\\." ".") - (should-regex false "\\." "a") - )) +## [Utils] +(def: (should-pass regex input) + (-> (lexer;Lexer Text) Text Bool) + (|> (lexer;run regex input) + (case> (#;Right parsed) + (T/= parsed input) -(test: "Regular Expressions [System character classes]" - (test-all (should-regex true "." "a") + _ + false))) - (should-regex true "\\d" "0") - (should-regex false "\\d" "m") - (should-regex true "\\D" "m") - (should-regex false "\\D" "0") +(def: (should-passT test regex input) + (-> Text (lexer;Lexer Text) Text Bool) + (|> (lexer;run regex input) + (case> (#;Right parsed) + (T/= test parsed) - (should-regex true "\\s" " ") - (should-regex false "\\s" "m") - (should-regex true "\\S" "m") - (should-regex false "\\S" " ") + _ + false))) - (should-regex true "\\w" "_") - (should-regex false "\\w" "^") - (should-regex true "\\W" ".") - (should-regex false "\\W" "a") +(def: (should-fail regex input) + (All [a] (-> (lexer;Lexer a) Text Bool)) + (|> (lexer;run regex input) + (case> (#;Left _) true _ false))) - (should-regex true "\\p{Lower}" "m") - (should-regex false "\\p{Lower}" "M") +(syntax: (should-check pattern regex input) + (wrap (list (` (|> (lexer;run (~ regex) (~ input)) + (case> (^ (#;Right (~ pattern))) + true - (should-regex true "\\p{Upper}" "M") - (should-regex false "\\p{Upper}" "m") + (~' _) + false)))))) - (should-regex true "\\p{Alpha}" "M") - (should-regex false "\\p{Alpha}" "0") +## [Tests] +(test: "Regular Expressions [Basics]" + (assert "Can parse character literals." + (and (should-pass (&;regex "a") "a") + (should-fail (&;regex "a") ".") + (should-pass (&;regex "\\.") ".") + (should-fail (&;regex "\\.") "a")))) - (should-regex true "\\p{Digit}" "1") - (should-regex false "\\p{Digit}" "n") +(test: "Regular Expressions [System character classes]" + ($_ seq + (assert "Can parse anything." + (should-pass (&;regex ".") "a")) - (should-regex true "\\p{Alnum}" "1") - (should-regex false "\\p{Alnum}" ".") + (assert "Can parse digits." + (and (should-pass (&;regex "\\d") "0") + (should-fail (&;regex "\\d") "m"))) + + (assert "Can parse non digits." + (and (should-pass (&;regex "\\D") "m") + (should-fail (&;regex "\\D") "0"))) - (should-regex true "\\p{Space}" " ") - (should-regex false "\\p{Space}" ".") + (assert "Can parse white-space." + (and (should-pass (&;regex "\\s") " ") + (should-fail (&;regex "\\s") "m"))) + + (assert "Can parse non white-space." + (and (should-pass (&;regex "\\S") "m") + (should-fail (&;regex "\\S") " "))) - (should-regex true "\\p{HexDigit}" "a") - (should-regex false "\\p{HexDigit}" ".") + (assert "Can parse word characters." + (and (should-pass (&;regex "\\w") "_") + (should-fail (&;regex "\\w") "^"))) + + (assert "Can parse non word characters." + (and (should-pass (&;regex "\\W") ".") + (should-fail (&;regex "\\W") "a"))) - (should-regex true "\\p{OctDigit}" "6") - (should-regex false "\\p{OctDigit}" ".") + (assert "Can parse using special character classes." + (and (and (should-pass (&;regex "\\p{Lower}") "m") + (should-fail (&;regex "\\p{Lower}") "M")) - (should-regex true "\\p{Blank}" "\t") - (should-regex false "\\p{Blank}" ".") + (and (should-pass (&;regex "\\p{Upper}") "M") + (should-fail (&;regex "\\p{Upper}") "m")) - (should-regex true "\\p{ASCII}" "\t") - (should-regex false "\\p{ASCII}" "\u1234") + (and (should-pass (&;regex "\\p{Alpha}") "M") + (should-fail (&;regex "\\p{Alpha}") "0")) - (should-regex true "\\p{Contrl}" "\u0012") - (should-regex false "\\p{Contrl}" "a") + (and (should-pass (&;regex "\\p{Digit}") "1") + (should-fail (&;regex "\\p{Digit}") "n")) - (should-regex true "\\p{Punct}" "@") - (should-regex false "\\p{Punct}" "a") + (and (should-pass (&;regex "\\p{Alnum}") "1") + (should-fail (&;regex "\\p{Alnum}") ".")) - (should-regex true "\\p{Graph}" "@") - (should-regex false "\\p{Graph}" " ") + (and (should-pass (&;regex "\\p{Space}") " ") + (should-fail (&;regex "\\p{Space}") ".")) - (should-regex true "\\p{Print}" "\u0020") - (should-regex false "\\p{Print}" "\u1234") - )) + (and (should-pass (&;regex "\\p{HexDigit}") "a") + (should-fail (&;regex "\\p{HexDigit}") ".")) -(test: "Regular Expressions [Custom character classes]" - (test-all (should-regex true "[abc]" "a") - (should-regex false "[abc]" "m") + (and (should-pass (&;regex "\\p{OctDigit}") "6") + (should-fail (&;regex "\\p{OctDigit}") ".")) - (should-regex true "[a-z]" "a") - (should-regex true "[a-z]" "m") - (should-regex true "[a-z]" "z") + (and (should-pass (&;regex "\\p{Blank}") "\t") + (should-fail (&;regex "\\p{Blank}") ".")) - (should-regex true "[a-zA-Z]" "a") - (should-regex true "[a-zA-Z]" "m") - (should-regex true "[a-zA-Z]" "z") - (should-regex true "[a-zA-Z]" "A") - (should-regex true "[a-zA-Z]" "M") - (should-regex true "[a-zA-Z]" "Z") + (and (should-pass (&;regex "\\p{ASCII}") "\t") + (should-fail (&;regex "\\p{ASCII}") "\u1234")) - (should-regex false "[^abc]" "a") - (should-regex true "[^abc]" "m") + (and (should-pass (&;regex "\\p{Contrl}") "\u0012") + (should-fail (&;regex "\\p{Contrl}") "a")) - (should-regex false "[^a-z]" "a") - (should-regex true "[^a-z]" "0") - (should-regex false "[^a-zA-Z]" "a") - (should-regex true "[^a-zA-Z]" "0") + (and (should-pass (&;regex "\\p{Punct}") "@") + (should-fail (&;regex "\\p{Punct}") "a")) - (should-regex false "[a-z&&[def]]" "a") - (should-regex true "[a-z&&[def]]" "d") + (and (should-pass (&;regex "\\p{Graph}") "@") + (should-fail (&;regex "\\p{Graph}") " ")) - (should-regex true "[a-z&&[^bc]]" "a") - (should-regex false "[a-z&&[^bc]]" "b") + (and (should-pass (&;regex "\\p{Print}") "\u0020") + (should-fail (&;regex "\\p{Print}") "\u1234")))) + )) - (should-regex true "[a-z&&[^m-p]]" "a") - (should-regex false "[a-z&&[^m-p]]" "m") - (should-regex false "[a-z&&[^m-p]]" "p") - )) +(test: "Regular Expressions [Custom character classes]" + ($_ seq + (assert "Can parse using custom character classes." + (and (should-pass (&;regex "[abc]") "a") + (should-fail (&;regex "[abc]") "m"))) + + (assert "Can parse using character ranges." + (and (should-pass (&;regex "[a-z]") "a") + (should-pass (&;regex "[a-z]") "m") + (should-pass (&;regex "[a-z]") "z"))) + + (assert "Can combine character ranges." + (and (should-pass (&;regex "[a-zA-Z]") "a") + (should-pass (&;regex "[a-zA-Z]") "m") + (should-pass (&;regex "[a-zA-Z]") "z") + (should-pass (&;regex "[a-zA-Z]") "A") + (should-pass (&;regex "[a-zA-Z]") "M") + (should-pass (&;regex "[a-zA-Z]") "Z"))) + + (assert "Can negate custom character classes." + (and (should-fail (&;regex "[^abc]") "a") + (should-pass (&;regex "[^abc]") "m"))) + + (assert "Can negate character ranges.." + (and (should-fail (&;regex "[^a-z]") "a") + (should-pass (&;regex "[^a-z]") "0"))) + + (assert "Can parse negate combinations of character ranges." + (and (should-fail (&;regex "[^a-zA-Z]") "a") + (should-pass (&;regex "[^a-zA-Z]") "0"))) + + (assert "Can make custom character classes more specific." + (and (and (should-fail (&;regex "[a-z&&[def]]") "a") + (should-pass (&;regex "[a-z&&[def]]") "d")) + + (and (should-pass (&;regex "[a-z&&[^bc]]") "a") + (should-fail (&;regex "[a-z&&[^bc]]") "b")) + + (and (should-pass (&;regex "[a-z&&[^m-p]]") "a") + (should-fail (&;regex "[a-z&&[^m-p]]") "m") + (should-fail (&;regex "[a-z&&[^m-p]]") "p")))) + )) (test: "Regular Expressions [Reference]" - (test-all (let [number (regex "\\d+")] - (should-regex ["809-345-6789" "809" "345" "6789"] "(\\@)-(\\@)-(\\@)" "809-345-6789")) - )) + (let [number (&;regex "\\d+")] + (assert "Can build complex regexs by combining simpler ones." + (should-check ["809-345-6789" "809" "345" "6789"] (&;regex "(\\@)-(\\@)-(\\@)") "809-345-6789")))) (test: "Regular Expressions [Quantifiers]" - (test-all (should-regex "aa" "aa" "aa") - - (should-regex "a" "a?" "a") - (should-regex "" "a?" "") - - (should-regex "aaa" "a*" "aaa") - (should-regex "" "a*" "") - - (should-regex "aaa" "a+" "aaa") - (should-regex "a" "a+" "a") - (should-regex false "a+" "") - - (should-regex "aa" "a{2}" "aa") - (should-regex "a" "a{1}" "aa") - (should-regex false "a{3}" "aa") - - (should-regex "aa" "a{1,}" "aa") - (should-regex "aa" "a{2,}" "aa") - (should-regex false "a{3,}" "aa") - - (should-regex "a" "a{,1}" "aa") - (should-regex "aa" "a{,2}" "aa") - (should-regex "aa" "a{,3}" "aa") - - (should-regex "a" "a{1,2}" "a") - (should-regex "aa" "a{1,2}" "aa") - (should-regex "aa" "a{1,2}" "aaa") - )) + ($_ seq + (assert "Can sequentially combine patterns." + (should-passT "aa" (&;regex "aa") "aa")) + + (assert "Can match patterns optionally." + (and (should-passT "a" (&;regex "a?") "a") + (should-passT "" (&;regex "a?") ""))) + + (assert "Can match a pattern 0 or more times." + (and (should-passT "aaa" (&;regex "a*") "aaa") + (should-passT "" (&;regex "a*") ""))) + + (assert "Can match a pattern 1 or more times." + (and (should-passT "aaa" (&;regex "a+") "aaa") + (should-passT "a" (&;regex "a+") "a") + (should-fail (&;regex "a+") ""))) + + (assert "Can match a pattern N times." + (and (should-passT "aa" (&;regex "a{2}") "aa") + (should-passT "a" (&;regex "a{1}") "aa") + (should-fail (&;regex "a{3}") "aa"))) + + (assert "Can match a pattern at-least N times." + (and (should-passT "aa" (&;regex "a{1,}") "aa") + (should-passT "aa" (&;regex "a{2,}") "aa") + (should-fail (&;regex "a{3,}") "aa"))) + + (assert "Can match a pattern at-most N times." + (and (should-passT "a" (&;regex "a{,1}") "aa") + (should-passT "aa" (&;regex "a{,2}") "aa") + (should-passT "aa" (&;regex "a{,3}") "aa"))) + + (assert "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"))) + )) (test: "Regular Expressions [Groups]" - (test-all (should-regex ["abc" "b"] "a(.)c" "abc") - (should-regex ["abbbbbc" "bbbbb"] "a(b+)c" "abbbbbc") - (should-regex ["809-345-6789" "809" "345" "6789"] "(\\d{3})-(\\d{3})-(\\d{4})" "809-345-6789") - (should-regex ["809-345-6789" "809" "6789"] "(\\d{3})-(?:\\d{3})-(\\d{4})" "809-345-6789") - (should-regex ["809-809-6789" "809" "6789"] "(\\d{3})-\\0-(\\d{4})" "809-809-6789") - (should-regex ["809-809-6789" "809" "6789"] "(?\\d{3})-\\k-(\\d{4})" "809-809-6789") - (should-regex ["809-809-6789-6789" "809" "6789"] "(?\\d{3})-\\k-(\\d{4})-\\0" "809-809-6789-6789") - - (should-regex ["809-345-6789" "809" ["345-6789" "345" "6789"]] "(\\d{3})-((\\d{3})-(\\d{4}))" "809-345-6789") - )) + ($_ seq + (assert "Can extract groups of sub-matches specified in a pattern." + (and (should-check ["abc" "b"] (&;regex "a(.)c") "abc") + (should-check ["abbbbbc" "bbbbb"] (&;regex "a(b+)c") "abbbbbc") + (should-check ["809-345-6789" "809" "345" "6789"] (&;regex "(\\d{3})-(\\d{3})-(\\d{4})") "809-345-6789") + (should-check ["809-345-6789" "809" "6789"] (&;regex "(\\d{3})-(?:\\d{3})-(\\d{4})") "809-345-6789") + (should-check ["809-809-6789" "809" "6789"] (&;regex "(\\d{3})-\\0-(\\d{4})") "809-809-6789") + (should-check ["809-809-6789" "809" "6789"] (&;regex "(?\\d{3})-\\k-(\\d{4})") "809-809-6789") + (should-check ["809-809-6789-6789" "809" "6789"] (&;regex "(?\\d{3})-\\k-(\\d{4})-\\0") "809-809-6789-6789"))) + + (assert "Can specify groups within groups." + (should-check ["809-345-6789" "809" ["345-6789" "345" "6789"]] (&;regex "(\\d{3})-((\\d{3})-(\\d{4}))") "809-345-6789")) + )) (test: "Regular Expressions [Alternation]" - (test-all (should-regex ["a" (+0 [])] "a|b" "a") - (should-regex ["b" (+1 [])] "a|b" "b") - (should-regex false "a|b" "c") - - (should-regex ["abc" (+0 "b")] "a(.)c|b(.)d" "abc") - (should-regex ["bcd" (+1 "c")] "a(.)c|b(.)d" "bcd") - (should-regex false "a(.)c|b(.)d" "cde") - - (should-regex ["abc" (+0 ["b" "c"])] "a(.)(.)|b(.)(.)" "abc") - (should-regex ["bcd" (+1 ["c" "d"])] "a(.)(.)|b(.)(.)" "bcd") - (should-regex false "a(.)(.)|b(.)(.)" "cde") - - (should-regex ["809-345-6789" (+0 ["809" "345-6789" "345" "6789"])] - "(\\d{3})-((\\d{3})-(\\d{4}))|b(.)d" - "809-345-6789") - )) + ($_ seq + (assert "Can specify alternative patterns." + (and (should-check ["a" (+0 [])] (&;regex "a|b") "a") + (should-check ["b" (+1 [])] (&;regex "a|b") "b") + (should-fail (&;regex "a|b") "c"))) + + (assert "Can have groups within alternations." + (and (should-check ["abc" (+0 "b")] (&;regex "a(.)c|b(.)d") "abc") + (should-check ["bcd" (+1 "c")] (&;regex "a(.)c|b(.)d") "bcd") + (should-fail (&;regex "a(.)c|b(.)d") "cde") + + (should-check ["abc" (+0 ["b" "c"])] (&;regex "a(.)(.)|b(.)(.)") "abc") + (should-check ["bcd" (+1 ["c" "d"])] (&;regex "a(.)(.)|b(.)(.)") "bcd") + (should-fail (&;regex "a(.)(.)|b(.)(.)") "cde") + + (should-check ["809-345-6789" (+0 ["809" "345-6789" "345" "6789"])] + (&;regex "(\\d{3})-((\\d{3})-(\\d{4}))|b(.)d") + "809-345-6789"))) + )) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index 4b46a7cd5..857d5c25c 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -13,6 +13,9 @@ (test lux (lux ["_;" cli] ["_;" host] + ["_;" pipe] + ["_;" lexer] + ["_;" regex] (codata ["_;" io] [env] [state] @@ -52,10 +55,6 @@ ## ["_;" random] ["_;" simple] ) - ## ["_;" pipe] - ## ["_;" lexer] - ## ["_;" regex] - ## (macro [ast] ## [syntax]) ## [type] -- cgit v1.2.3