diff options
Diffstat (limited to '')
| -rw-r--r-- | stdlib/source/test/lux.lux | 9 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data.lux | 15 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/product.lux | 31 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/sum.lux | 56 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/text.lux | 233 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/text/format.lux | 21 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/text/lexer.lux | 340 | ||||
| -rw-r--r-- | stdlib/source/test/lux/data/text/regex.lux | 466 |
8 files changed, 564 insertions, 607 deletions
diff --git a/stdlib/source/test/lux.lux b/stdlib/source/test/lux.lux index 6543576a2..c61891996 100644 --- a/stdlib/source/test/lux.lux +++ b/stdlib/source/test/lux.lux @@ -28,6 +28,9 @@ [locale (#+) [language (#+)] [territory (#+)]] + [data + [text + [format (#+)]]] ## TODO: Test these modules [data [format @@ -117,12 +120,6 @@ ## ## [semaphore (#+)] ## ]] ## [data - ## [product (#+)] - ## [sum (#+)] - ## [text (#+) - ## ## [format (#+)] - ## [lexer (#+)] - ## [regex (#+)]] ## [format ## ## [json (#+)] ## [xml (#+)]] diff --git a/stdlib/source/test/lux/data.lux b/stdlib/source/test/lux/data.lux index 2f733d1d2..907082d99 100644 --- a/stdlib/source/test/lux/data.lux +++ b/stdlib/source/test/lux/data.lux @@ -9,6 +9,8 @@ ["#." lazy] ["#." maybe] ["#." name] + ["#." product] + ["#." sum] [number ["#." i64] ["#." nat] @@ -17,6 +19,9 @@ ["#." frac] ["#." ratio] ["#." complex]] + ["#." text + ["#/." lexer] + ["#/." regex]] ]) (def: #export number @@ -31,6 +36,13 @@ /complex.test )) +(def: #export text + ($_ _.and + /text.test + /text/lexer.test + /text/regex.test + )) + (def: #export test Test ($_ _.and @@ -41,5 +53,8 @@ /lazy.test /maybe.test /name.test + /product.test + /sum.test ..number + ..text )) diff --git a/stdlib/source/test/lux/data/product.lux b/stdlib/source/test/lux/data/product.lux index 86db80d0e..5e28aaf5e 100644 --- a/stdlib/source/test/lux/data/product.lux +++ b/stdlib/source/test/lux/data/product.lux @@ -1,17 +1,20 @@ (.module: [lux #* - [data - ["@" product]]] - lux/test) + ["_" test (#+ Test)] + data/text/format] + {1 + ["." /]}) -(context: "Products" - ($_ seq - (test "Can access the sides of a pair." - (and (i/= +1 (@.left [+1 +2])) - (i/= +2 (@.right [+1 +2])))) - - (test "Can swap the sides of a pair." - (let [[_left _right] (@.swap [+1 +2])] - (and (i/= +2 _left) - (i/= +1 _right)))) - )) +(def: #export test + Test + (<| (_.context (%name (name-of .&))) + ($_ _.and + (_.test "Can access the sides of a pair." + (and (i/= +1 (/.left [+1 +2])) + (i/= +2 (/.right [+1 +2])))) + + (_.test "Can swap the sides of a pair." + (let [[_left _right] (/.swap [+1 +2])] + (and (i/= +2 _left) + (i/= +1 _right)))) + ))) diff --git a/stdlib/source/test/lux/data/sum.lux b/stdlib/source/test/lux/data/sum.lux index d47922304..2a7fa889e 100644 --- a/stdlib/source/test/lux/data/sum.lux +++ b/stdlib/source/test/lux/data/sum.lux @@ -1,37 +1,39 @@ (.module: [lux #* + ["_" test (#+ Test)] + data/text/format [control pipe] [data - sum ["." text] [collection ["." list]]]] - lux/test) + {1 + ["." /]}) -(context: "Sum operations" - (let [(^open "List/.") (list.equivalence text.equivalence)] - ($_ seq - (test "Can inject values into Either." - (and (|> (left "Hello") (case> (0 "Hello") #1 _ #0)) - (|> (right "World") (case> (1 "World") #1 _ #0)))) +(def: #export test + Test + (<| (_.context (%name (name-of .|))) + (let [(^open "list/.") (list.equivalence text.equivalence)] + ($_ _.and + (_.test "Can inject values into Either." + (and (|> (/.left "Hello") (case> (0 "Hello") #1 _ #0)) + (|> (/.right "World") (case> (1 "World") #1 _ #0)))) + (_.test "Can discriminate eithers based on their cases." + (let [[_lefts _rights] (/.partition (: (List (| Text Text)) + (list (0 "0") (1 "1") (0 "2"))))] + (and (list/= _lefts + (/.lefts (: (List (| Text Text)) + (list (0 "0") (1 "1") (0 "2"))))) - (test "Can discriminate eithers based on their cases." - (let [[_lefts _rights] (partition (: (List (| Text Text)) - (list (0 "+0") (1 "+1") (0 "+2"))))] - (and (List/= _lefts - (lefts (: (List (| Text Text)) - (list (0 "+0") (1 "+1") (0 "+2"))))) - - (List/= _rights - (rights (: (List (| Text Text)) - (list (0 "+0") (1 "+1") (0 "+2")))))))) - - (test "Can apply a function to an Either value depending on the case." - (and (i/= +10 (either (function (_ _) +10) - (function (_ _) +20) - (: (| Text Text) (0 "")))) - (i/= +20 (either (function (_ _) +10) - (function (_ _) +20) - (: (| Text Text) (1 "")))))) - ))) + (list/= _rights + (/.rights (: (List (| Text Text)) + (list (0 "0") (1 "1") (0 "2")))))))) + (_.test "Can apply a function to an Either value depending on the case." + (and (n/= 10 (/.either (function (_ _) 10) + (function (_ _) 20) + (: (| Text Text) (0 "")))) + (n/= 20 (/.either (function (_ _) 10) + (function (_ _) 20) + (: (| Text Text) (1 "")))))) + )))) diff --git a/stdlib/source/test/lux/data/text.lux b/stdlib/source/test/lux/data/text.lux index ea9a36fe2..e3166dcd9 100644 --- a/stdlib/source/test/lux/data/text.lux +++ b/stdlib/source/test/lux/data/text.lux @@ -1,143 +1,134 @@ (.module: [lux #* + data/text/format + ["_" test (#+ Test)] [control + pipe [monad (#+ do Monad)] - pipe] + {[0 #test] + [/ + ["$." equivalence] + ["$." order]]}] [data - ["&" text - format] [collection ["." list]]] [math ["r" random]]] - lux/test) - -(context: "Size" - (<| (times 100) - (do @ - [size (:: @ map (n/% 100) r.nat) - sample (r.unicode size)] - (test "" (or (and (n/= 0 size) - (&.empty? sample)) - (n/= size (&.size sample))))))) + {1 + ["." /]}) (def: bounded-size (r.Random Nat) (|> r.nat (:: r.monad map (|>> (n/% 20) (n/+ 1))))) -(context: "Locations" - (<| (times 100) - (do @ - [size bounded-size - idx (:: @ map (n/% size) r.nat) - sample (r.unicode size)] - (test "" (|> sample - (&.nth idx) - (case> (^multi (#.Some char) - [(&.from-code char) char] - [[(&.index-of char sample) - (&.last-index-of char sample) - (&.index-of' char idx sample) - (&.last-index-of' char idx sample)] - [(#.Some io) (#.Some lio) - (#.Some io') (#.Some lio')]]) - (and (n/<= idx io) - (n/>= idx lio) - - (n/= idx io') - (n/>= idx lio') - - (&.contains? char sample)) +(def: #export test + Test + (<| (_.context (%name (name-of .Text))) + ($_ _.and + ($equivalence.spec /.equivalence (r.ascii 2)) + ($order.spec /.order (r.ascii 2)) - _ - #0 - )) - )))) + (do r.monad + [size (:: @ map (n/% 10) r.nat) + sample (r.unicode size)] + ($_ _.and + (_.test "Can get the size of text." + (n/= size (/.size sample))) + (_.test "Text with size 0 is considered 'empty'." + (or (not (n/= 0 size)) + (/.empty? sample))))) + (do r.monad + [size bounded-size + idx (:: @ map (n/% size) r.nat) + sample (r.unicode size)] + (_.test "Character locations." + (|> sample + (/.nth idx) + (case> (^multi (#.Some char) + [(/.from-code char) char] + [[(/.index-of char sample) + (/.last-index-of char sample) + (/.index-of' char idx sample) + (/.last-index-of' char idx sample)] + [(#.Some io) (#.Some lio) + (#.Some io') (#.Some lio')]]) + (and (n/<= idx io) + (n/>= idx lio) -(context: "Text functions" - (<| (times 100) - (do @ - [sizeL bounded-size - sizeR bounded-size - sampleL (r.unicode sizeL) - sampleR (r.unicode sizeR) - #let [sample (&.concat (list sampleL sampleR)) - fake-sample (&.join-with " " (list sampleL sampleR)) - dup-sample (&.join-with "" (list sampleL sampleR)) - enclosed-sample (&.enclose [sampleR sampleR] sampleL) - (^open ".") &.equivalence]] - (test "" (and (not (= sample fake-sample)) - (= sample dup-sample) - (&.starts-with? sampleL sample) - (&.ends-with? sampleR sample) - (= enclosed-sample - (&.enclose' sampleR sampleL)) - - (|> (&.split sizeL sample) - (case> (#.Right [_l _r]) - (and (= sampleL _l) - (= sampleR _r) - (= sample (&.concat (list _l _r)))) + (n/= idx io') + (n/>= idx lio') - _ - #0)) - - (|> [(&.clip 0 sizeL sample) - (&.clip sizeL (&.size sample) sample) - (&.clip' sizeL sample) - (&.clip' 0 sample)] - (case> [(#.Right _l) (#.Right _r) (#.Right _r') (#.Right _f)] - (and (= sampleL _l) - (= sampleR _r) - (= _r _r') - (= sample _f)) + (/.contains? char sample)) - _ - #0)) - ) - )))) + _ + #0 + )) + )) + (do r.monad + [sizeL bounded-size + sizeR bounded-size + sampleL (r.unicode sizeL) + sampleR (r.unicode sizeR) + #let [sample (/.concat (list sampleL sampleR)) + (^open "/@.") /.equivalence]] + ($_ _.and + (_.test "Can join text snippets." + (and (not (/@= sample + (/.join-with " " (list sampleL sampleR)))) + (/@= sample + (/.join-with "" (list sampleL sampleR))))) + (_.test "Can check sub-texts at the borders." + (and (/.starts-with? sampleL sample) + (/.ends-with? sampleR sample))) + (_.test "Can enclose text in another texts." + (/@= (/.enclose [sampleR sampleR] sampleL) + (/.enclose' sampleR sampleL))) + (_.test "Can split text." + (|> (/.split sizeL sample) + (case> (#.Right [_l _r]) + (and (/@= sampleL _l) + (/@= sampleR _r) + (/@= sample (/.concat (list _l _r)))) -(context: "More text functions" - (<| (times 100) - (do @ - [sizeP bounded-size - sizeL bounded-size - #let [## The wider unicode charset includes control characters that - ## can make text replacement work improperly. - ## Because of that, I restrict the charset. - normal-char-gen (|> r.nat (:: @ map (|>> (n/% 128) (n/max 1))))] - sep1 (r.text normal-char-gen 1) - sep2 (r.text normal-char-gen 1) - #let [part-gen (|> (r.text normal-char-gen sizeP) - (r.filter (|>> (&.contains? sep1) not)))] - parts (r.list sizeL part-gen) - #let [sample1 (&.concat (list.interpose sep1 parts)) - sample2 (&.concat (list.interpose sep2 parts)) - (^open "&;.") &.equivalence]] - ($_ seq - (test "Can split text through a separator." - (n/= (list.size parts) - (list.size (&.split-all-with sep1 sample1)))) + _ + #0))) + (_.test "Can clip text." + (|> [(/.clip 0 sizeL sample) + (/.clip sizeL (/.size sample) sample) + (/.clip' sizeL sample) + (/.clip' 0 sample)] + (case> [(#.Right _l) (#.Right _r) (#.Right _r') (#.Right _f)] + (and (/@= sampleL _l) + (/@= sampleR _r) + (/@= _r _r') + (/@= sample _f)) - (test "Can replace occurrences of a piece of text inside a larger text." - (&;= sample2 - (&.replace-all sep1 sep2 sample1))) - )))) + _ + #0))) + )) + (do r.monad + [sizeP bounded-size + sizeL bounded-size + #let [## The wider unicode charset includes control characters that + ## can make text replacement work improperly. + ## Because of that, I restrict the charset. + normal-char-gen (|> r.nat (:: @ map (|>> (n/% 128) (n/max 1))))] + sep1 (r.text normal-char-gen 1) + sep2 (r.text normal-char-gen 1) + #let [part-gen (|> (r.text normal-char-gen sizeP) + (r.filter (|>> (/.contains? sep1) not)))] + parts (r.list sizeL part-gen) + #let [sample1 (/.concat (list.interpose sep1 parts)) + sample2 (/.concat (list.interpose sep2 parts)) + (^open "/@.") /.equivalence]] + ($_ _.and + (_.test "Can split text multiple times through a separator." + (n/= (list.size parts) + (list.size (/.split-all-with sep1 sample1)))) -(context: "Structures" - (let [(^open "&;.") &.order] - ($_ seq - (test "" (&;< "bcd" "abc")) - (test "" (not (&;< "abc" "abc"))) - (test "" (not (&;< "abc" "bcd"))) - (test "" (&;<= "bcd" "abc")) - (test "" (&;<= "abc" "abc")) - (test "" (not (&;<= "abc" "bcd"))) - (test "" (&;> "abc" "bcd")) - (test "" (not (&;> "abc" "abc"))) - (test "" (not (&;> "bcd" "abc"))) - (test "" (&;>= "abc" "bcd")) - (test "" (&;>= "abc" "abc")) - (test "" (not (&;>= "bcd" "abc"))) - ))) + (_.test "Can replace occurrences of a piece of text inside a larger text." + (/@= sample2 + (/.replace-all sep1 sep2 sample1))) + )) + ))) diff --git a/stdlib/source/test/lux/data/text/format.lux b/stdlib/source/test/lux/data/text/format.lux deleted file mode 100644 index 1a7ab01cf..000000000 --- a/stdlib/source/test/lux/data/text/format.lux +++ /dev/null @@ -1,21 +0,0 @@ -(.module: - [lux #* - [control - [monad (#+ Monad do)]] - [data - ["." text - format]]] - lux/test) - -(context: "Formatters" - (let [(^open "&;.") text.equivalence] - ($_ seq - (test "Can format common values simply." - (and (&;= "#1" (%b #1)) - (&;= "123" (%n 123)) - (&;= "+123" (%i +123)) - (&;= "+123.456" (%f +123.456)) - (&;= ".5" (%r .5)) - (&;= (format text.double-quote "YOLO" text.double-quote) (%t "YOLO")) - (&;= "User-id: +123 -- Active: #1" (format "User-id: " (%i +123) " -- Active: " (%b #1))))) - ))) diff --git a/stdlib/source/test/lux/data/text/lexer.lux b/stdlib/source/test/lux/data/text/lexer.lux index 77419362a..b15a86846 100644 --- a/stdlib/source/test/lux/data/text/lexer.lux +++ b/stdlib/source/test/lux/data/text/lexer.lux @@ -1,205 +1,171 @@ (.module: [lux #* + data/text/format + ["_" test (#+ Test)] [control - [monad (#+ do Monad)] pipe + [monad (#+ do Monad)] ["p" parser]] [data ["." error (#+ Error)] - ["." text ("#;." equivalence) - format - ["&" lexer]] + ["." text ("#@." equivalence)] [collection ["." list]]] [math ["r" random]]] - lux/test) + {1 + ["." /]}) -## [Utils] (def: (should-fail input) (All [a] (-> (Error a) Bit)) (case input - (#.Left _) #1 - _ #0)) - -(def: (should-passT test input) - (-> Text (Error Text) Bit) - (case input - (#.Right output) - (text;= test output) + (#error.Failure _) + true _ - #0)) - -(def: (should-passL test input) - (-> (List Text) (Error (List Text)) Bit) - (let [(^open "list;.") (list.equivalence text.equivalence)] - (case input - (#.Right output) - (list;= test output) - - _ - #0))) - -(def: (should-passE test input) - (-> (Either Text Text) (Error (Either Text Text)) Bit) - (case input - (#.Right output) - (case [test output] - [(#.Left test) (#.Left output)] - (text;= test output) - - [(#.Right test) (#.Right output)] - (text;= test output) - - _ - #0) - - _ - #0)) - -## [Tests] -(context: "End" - ($_ seq - (test "Can detect the end of the input." - (|> (&.run "" - &.end) - (case> (#.Right _) #1 _ #0))) - - (test "Won't mistake non-empty text for no more input." - (|> (&.run "YOLO" - &.end) - (case> (#.Left _) #1 _ #0))) - )) + false)) -(context: "Literals" - (<| (times 100) - (do @ - [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) - sample (r.unicode size) - non-sample (|> (r.unicode size) - (r.filter (|>> (text;= sample) not)))] - ($_ seq - (test "Can find literal text fragments." - (and (|> (&.run sample - (&.this sample)) - (case> (#.Right []) #1 _ #0)) - (|> (&.run non-sample - (&.this sample)) - (case> (#.Left _) #1 _ #0)))) - )))) - -(context: "Custom lexers" - ($_ seq - (test "Can lex anything" - (and (should-passT "A" (&.run "A" - &.any)) - (should-fail (&.run "" - &.any)))) - - (test "Can lex characters ranges." - (and (should-passT "Y" (&.run "Y" - (&.range (char "X") (char "Z")))) - (should-fail (&.run "M" - (&.range (char "X") (char "Z")))))) - - (test "Can lex upper-case and lower-case letters." - (and (should-passT "Y" (&.run "Y" - &.upper)) - (should-fail (&.run "m" - &.upper)) - - (should-passT "y" (&.run "y" - &.lower)) - (should-fail (&.run "M" - &.lower)))) - - (test "Can lex numbers." - (and (should-passT "1" (&.run "1" - &.decimal)) - (should-fail (&.run " " - &.decimal)) - - (should-passT "7" (&.run "7" - &.octal)) - (should-fail (&.run "8" - &.octal)) - - (should-passT "1" (&.run "1" - &.hexadecimal)) - (should-passT "a" (&.run "a" - &.hexadecimal)) - (should-passT "A" (&.run "A" - &.hexadecimal)) - (should-fail (&.run " " - &.hexadecimal)) - )) - - (test "Can lex alphabetic characters." - (and (should-passT "A" (&.run "A" - &.alpha)) - (should-passT "a" (&.run "a" - &.alpha)) - (should-fail (&.run "1" - &.alpha)))) - - (test "Can lex alphanumeric characters." - (and (should-passT "A" (&.run "A" - &.alpha-num)) - (should-passT "a" (&.run "a" - &.alpha-num)) - (should-passT "1" (&.run "1" - &.alpha-num)) - (should-fail (&.run " " - &.alpha-num)))) - - (test "Can lex white-space." - (and (should-passT " " (&.run " " - &.space)) - (should-fail (&.run "8" - &.space)))) - )) - -(context: "Combinators" - ($_ seq - (test "Can combine lexers sequentially." - (and (|> (&.run "YO" - (p.and &.any &.any)) - (case> (#.Right ["Y" "O"]) #1 - _ #0)) - (should-fail (&.run "Y" - (p.and &.any &.any))))) - - (test "Can create the opposite of a lexer." - (and (should-passT "a" (&.run "a" - (&.not (p.or &.decimal &.upper)))) - (should-fail (&.run "A" - (&.not (p.or &.decimal &.upper)))))) - - (test "Can select from among a set of characters." - (and (should-passT "C" (&.run "C" - (&.one-of "ABC"))) - (should-fail (&.run "D" - (&.one-of "ABC"))))) - - (test "Can avoid a set of characters." - (and (should-passT "D" (&.run "D" - (&.none-of "ABC"))) - (should-fail (&.run "C" - (&.none-of "ABC"))))) - - (test "Can lex using arbitrary predicates." - (and (should-passT "D" (&.run "D" - (&.satisfies (function (_ c) #1)))) - (should-fail (&.run "C" - (&.satisfies (function (_ c) #0)))))) - - (test "Can apply a lexer multiple times." - (and (should-passT "0123456789ABCDEF" (&.run "0123456789ABCDEF" - (&.many &.hexadecimal))) - (should-fail (&.run "yolo" - (&.many &.hexadecimal))) - - (should-passT "" (&.run "" - (&.some &.hexadecimal))))) - )) +(def: (should-pass reference sample) + (-> Text (Error Text) Bit) + (|> sample + (:: error.functor map (text@= reference)) + (error.default false))) + +(def: #export test + Test + (<| (_.context (%name (name-of /.Lexer))) + ($_ _.and + (_.test "Can detect the end of the input." + (|> (/.run "" + /.end) + (case> (#.Right _) true _ false))) + (do r.monad + [size (|> r.nat (:: @ map (|>> (n/% 100) (n/max 10)))) + sample (r.unicode size) + non-sample (|> (r.unicode size) + (r.filter (|>> (text@= sample) not)))] + ($_ _.and + (_.test "Won't mistake non-empty text for no more input." + (|> (/.run sample + /.end) + (case> (#.Left _) true _ false))) + (_.test "Can find literal text fragments." + (and (|> (/.run sample + (/.this sample)) + (case> (#.Right []) true _ false)) + (|> (/.run non-sample + (/.this sample)) + (case> (#.Left _) true _ false)))) + )) + ($_ _.and + (_.test "Can lex anything" + (and (should-pass "A" (/.run "A" + /.any)) + (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")))))) + + (_.test "Can lex upper-case and lower-case letters." + (and (should-pass "Y" (/.run "Y" + /.upper)) + (should-fail (/.run "m" + /.upper)) + + (should-pass "y" (/.run "y" + /.lower)) + (should-fail (/.run "M" + /.lower)))) + + (_.test "Can lex numbers." + (and (should-pass "1" (/.run "1" + /.decimal)) + (should-fail (/.run " " + /.decimal)) + + (should-pass "7" (/.run "7" + /.octal)) + (should-fail (/.run "8" + /.octal)) + + (should-pass "1" (/.run "1" + /.hexadecimal)) + (should-pass "a" (/.run "a" + /.hexadecimal)) + (should-pass "A" (/.run "A" + /.hexadecimal)) + (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)))) + + (_.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)))) + + (_.test "Can lex white-space." + (and (should-pass " " (/.run " " + /.space)) + (should-fail (/.run "8" + /.space)))) + ) + ($_ _.and + (_.test "Can combine lexers sequentially." + (and (|> (/.run "YO" + (p.and /.any /.any)) + (case> (#.Right ["Y" "O"]) true + _ false)) + (should-fail (/.run "Y" + (p.and /.any /.any))))) + + (_.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)))))) + + (_.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"))))) + + (_.test "Can avoid a set of characters." + (and (should-pass "D" (/.run "D" + (/.none-of "ABC"))) + (should-fail (/.run "C" + (/.none-of "ABC"))))) + + (_.test "Can lex using arbitrary predicates." + (and (should-pass "D" (/.run "D" + (/.satisfies (function (_ c) true)))) + (should-fail (/.run "C" + (/.satisfies (function (_ c) false)))))) + + (_.test "Can apply a lexer multiple times." + (and (should-pass "0123456789ABCDEF" (/.run "0123456789ABCDEF" + (/.many /.hexadecimal))) + (should-fail (/.run "yolo" + (/.many /.hexadecimal))) + + (should-pass "" (/.run "" + (/.some /.hexadecimal))))) + ) + ))) diff --git a/stdlib/source/test/lux/data/text/regex.lux b/stdlib/source/test/lux/data/text/regex.lux index ffa5612da..059adff84 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -1,36 +1,36 @@ (.module: [lux #* + data/text/format + ["_" test (#+ Test)] [control [monad (#+ do Monad)] pipe ["p" parser]] [data [number (#+ hex)] - ["." text ("#;." equivalence) - format - ["." lexer (#+ Lexer)] - ["&" regex]]] + ["." text ("#@." equivalence) + ["." lexer (#+ Lexer)]]] [math ["r" random]] [macro ["s" syntax (#+ syntax:)]]] - lux/test) + {1 + ["." /]}) -## [Utils] (def: (should-pass regex input) (-> (Lexer Text) Text Bit) (|> (lexer.run input regex) (case> (#.Right parsed) - (text;= parsed input) + (text@= parsed input) _ #0))) -(def: (should-passT test regex input) +(def: (text-should-pass test regex input) (-> Text (Lexer Text) Text Bit) (|> (lexer.run input regex) (case> (#.Right parsed) - (text;= test parsed) + (text@= test parsed) _ #0))) @@ -48,239 +48,243 @@ (~' _) #0)))))) -## [Tests] -(context: "Regular Expressions [Basics]" - (test "Can parse character literals." - (and (should-pass (&.regex "a") "a") - (should-fail (&.regex "a") ".") - (should-pass (&.regex "\.") ".") - (should-fail (&.regex "\.") "a")))) - -(context: "Regular Expressions [System character classes]" - ($_ seq - (test "Can parse anything." - (should-pass (&.regex ".") "a")) - - (test "Can parse digits." - (and (should-pass (&.regex "\d") "0") - (should-fail (&.regex "\d") "m"))) - - (test "Can parse non digits." - (and (should-pass (&.regex "\D") "m") - (should-fail (&.regex "\D") "0"))) - - (test "Can parse white-space." - (and (should-pass (&.regex "\s") " ") - (should-fail (&.regex "\s") "m"))) - - (test "Can parse non white-space." - (and (should-pass (&.regex "\S") "m") - (should-fail (&.regex "\S") " "))) - - (test "Can parse word characters." - (and (should-pass (&.regex "\w") "_") - (should-fail (&.regex "\w") "^"))) - - (test "Can parse non word characters." - (and (should-pass (&.regex "\W") ".") - (should-fail (&.regex "\W") "a"))) +(def: basics + Test + (_.test "Can parse character literals." + (and (should-pass (/.regex "a") "a") + (should-fail (/.regex "a") ".") + (should-pass (/.regex "\.") ".") + (should-fail (/.regex "\.") "a")))) + +(def: system-character-classes + Test + ($_ _.and + (_.test "Can parse anything." + (should-pass (/.regex ".") "a")) + + (_.test "Can parse digits." + (and (should-pass (/.regex "\d") "0") + (should-fail (/.regex "\d") "m"))) + + (_.test "Can parse non digits." + (and (should-pass (/.regex "\D") "m") + (should-fail (/.regex "\D") "0"))) + + (_.test "Can parse white-space." + (and (should-pass (/.regex "\s") " ") + (should-fail (/.regex "\s") "m"))) + + (_.test "Can parse non white-space." + (and (should-pass (/.regex "\S") "m") + (should-fail (/.regex "\S") " "))) + + (_.test "Can parse word characters." + (and (should-pass (/.regex "\w") "_") + (should-fail (/.regex "\w") "^"))) + + (_.test "Can parse non word characters." + (and (should-pass (/.regex "\W") ".") + (should-fail (/.regex "\W") "a"))) )) -(context: "Regular Expressions [Special system character classes : Part 1]" - ($_ seq - (test "Can parse using special character classes." - (and (and (should-pass (&.regex "\p{Lower}") "m") - (should-fail (&.regex "\p{Lower}") "M")) - - (and (should-pass (&.regex "\p{Upper}") "M") - (should-fail (&.regex "\p{Upper}") "m")) - - (and (should-pass (&.regex "\p{Alpha}") "M") - (should-fail (&.regex "\p{Alpha}") "0")) - - (and (should-pass (&.regex "\p{Digit}") "1") - (should-fail (&.regex "\p{Digit}") "n")) - - (and (should-pass (&.regex "\p{Alnum}") "1") - (should-fail (&.regex "\p{Alnum}") ".")) - - (and (should-pass (&.regex "\p{Space}") " ") - (should-fail (&.regex "\p{Space}") ".")) - )) - )) - -(context: "Regular Expressions [Special system character classes : Part 2]" - ($_ seq - (test "Can parse using special character classes." - (and (and (should-pass (&.regex "\p{HexDigit}") "a") - (should-fail (&.regex "\p{HexDigit}") ".")) - - (and (should-pass (&.regex "\p{OctDigit}") "6") - (should-fail (&.regex "\p{OctDigit}") ".")) - - (and (should-pass (&.regex "\p{Blank}") text.tab) - (should-fail (&.regex "\p{Blank}") ".")) - - (and (should-pass (&.regex "\p{ASCII}") text.tab) - (should-fail (&.regex "\p{ASCII}") (text.from-code (hex "1234")))) - - (and (should-pass (&.regex "\p{Contrl}") (text.from-code (hex "12"))) - (should-fail (&.regex "\p{Contrl}") "a")) - - (and (should-pass (&.regex "\p{Punct}") "@") - (should-fail (&.regex "\p{Punct}") "a")) - - (and (should-pass (&.regex "\p{Graph}") "@") - (should-fail (&.regex "\p{Graph}") " ")) - - (and (should-pass (&.regex "\p{Print}") (text.from-code (hex "20"))) - (should-fail (&.regex "\p{Print}") (text.from-code (hex "1234")))) - )) - )) - -(context: "Regular Expressions [Custom character classes : Part 1]" - ($_ seq - (test "Can parse using custom character classes." - (and (should-pass (&.regex "[abc]") "a") - (should-fail (&.regex "[abc]") "m"))) - - (test "Can parse using character ranges." - (and (should-pass (&.regex "[a-z]") "a") - (should-pass (&.regex "[a-z]") "m") - (should-pass (&.regex "[a-z]") "z"))) - - (test "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"))) - )) - -(context: "Regular Expressions [Custom character classes : Part 2]" - ($_ seq - (test "Can negate custom character classes." - (and (should-fail (&.regex "[^abc]") "a") - (should-pass (&.regex "[^abc]") "m"))) - - (test "Can negate character ranges.." - (and (should-fail (&.regex "[^a-z]") "a") - (should-pass (&.regex "[^a-z]") "0"))) - - (test "Can parse negate combinations of character ranges." - (and (should-fail (&.regex "[^a-zA-Z]") "a") - (should-pass (&.regex "[^a-zA-Z]") "0"))) +(def: special-system-character-classes + Test + ($_ _.and + (_.test "Lower-case." + (and (should-pass (/.regex "\p{Lower}") "m") + (should-fail (/.regex "\p{Lower}") "M"))) + (_.test "Upper-case." + (and (should-pass (/.regex "\p{Upper}") "M") + (should-fail (/.regex "\p{Upper}") "m"))) + (_.test "Alphabetic." + (and (should-pass (/.regex "\p{Alpha}") "M") + (should-fail (/.regex "\p{Alpha}") "0"))) + (_.test "Numeric digits." + (and (should-pass (/.regex "\p{Digit}") "1") + (should-fail (/.regex "\p{Digit}") "n"))) + (_.test "Alphanumeric." + (and (should-pass (/.regex "\p{Alnum}") "1") + (should-fail (/.regex "\p{Alnum}") "."))) + (_.test "Whitespace." + (and (should-pass (/.regex "\p{Space}") " ") + (should-fail (/.regex "\p{Space}") "."))) + (_.test "Hexadecimal." + (and (should-pass (/.regex "\p{HexDigit}") "a") + (should-fail (/.regex "\p{HexDigit}") "."))) + (_.test "Octal." + (and (should-pass (/.regex "\p{OctDigit}") "6") + (should-fail (/.regex "\p{OctDigit}") "."))) + (_.test "Blank." + (and (should-pass (/.regex "\p{Blank}") text.tab) + (should-fail (/.regex "\p{Blank}") "."))) + (_.test "ASCII." + (and (should-pass (/.regex "\p{ASCII}") text.tab) + (should-fail (/.regex "\p{ASCII}") (text.from-code (hex "1234"))))) + (_.test "Control characters." + (and (should-pass (/.regex "\p{Contrl}") (text.from-code (hex "12"))) + (should-fail (/.regex "\p{Contrl}") "a"))) + (_.test "Punctuation." + (and (should-pass (/.regex "\p{Punct}") "@") + (should-fail (/.regex "\p{Punct}") "a"))) + (_.test "Graph." + (and (should-pass (/.regex "\p{Graph}") "@") + (should-fail (/.regex "\p{Graph}") " "))) + (_.test "Print." + (and (should-pass (/.regex "\p{Print}") (text.from-code (hex "20"))) + (should-fail (/.regex "\p{Print}") (text.from-code (hex "1234"))))) )) -(context: "Regular Expressions [Custom character classes : Part 3]" - ($_ seq - (test "Can make custom character classes more specific." - (and (let [RE (&.regex "[a-z&&[def]]")] - (and (should-fail RE "a") - (should-pass RE "d"))) - - (let [RE (&.regex "[a-z&&[^bc]]")] - (and (should-pass RE "a") - (should-fail RE "b"))) - - (let [RE (&.regex "[a-z&&[^m-p]]")] - (and (should-pass RE "a") - (should-fail RE "m") - (should-fail RE "p"))))) +(def: custom-character-classes + Test + ($_ _.and + (_.test "Can parse using custom character classes." + (and (should-pass (/.regex "[abc]") "a") + (should-fail (/.regex "[abc]") "m"))) + (_.test "Can parse using character ranges." + (and (should-pass (/.regex "[a-z]") "a") + (should-pass (/.regex "[a-z]") "m") + (should-pass (/.regex "[a-z]") "z"))) + (_.test "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"))) + (_.test "Can negate custom character classes." + (and (should-fail (/.regex "[^abc]") "a") + (should-pass (/.regex "[^abc]") "m"))) + (_.test "Can negate character ranges.." + (and (should-fail (/.regex "[^a-z]") "a") + (should-pass (/.regex "[^a-z]") "0"))) + (_.test "Can parse negate combinations of character ranges." + (and (should-fail (/.regex "[^a-zA-Z]") "a") + (should-pass (/.regex "[^a-zA-Z]") "0"))) + (_.test "Can make custom character classes more specific." + (and (let [RE (/.regex "[a-z&&[def]]")] + (and (should-fail RE "a") + (should-pass RE "d"))) + (let [RE (/.regex "[a-z&&[^bc]]")] + (and (should-pass RE "a") + (should-fail RE "b"))) + (let [RE (/.regex "[a-z&&[^m-p]]")] + (and (should-pass RE "a") + (should-fail RE "m") + (should-fail RE "p"))))) )) -(context: "Regular Expressions [Reference]" - (let [number (&.regex "\d+")] - (test "Can build complex regexs by combining simpler ones." - (should-check ["809-345-6789" "809" "345" "6789"] (&.regex "(\@<number>)-(\@<number>)-(\@<number>)") "809-345-6789")))) - -(context: "Regular Expressions [Fuzzy Quantifiers]" - ($_ seq - (test "Can sequentially combine patterns." - (should-passT "aa" (&.regex "aa") "aa")) - - (test "Can match patterns optionally." - (and (should-passT "a" (&.regex "a?") "a") - (should-passT "" (&.regex "a?") ""))) - - (test "Can match a pattern 0 or more times." - (and (should-passT "aaa" (&.regex "a*") "aaa") - (should-passT "" (&.regex "a*") ""))) - - (test "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+") ""))) +(def: references + Test + (let [number (/.regex "\d+")] + (_.test "Can build complex regexs by combining simpler ones." + (should-check ["809-345-6789" "809" "345" "6789"] (/.regex "(\@<number>)-(\@<number>)-(\@<number>)") "809-345-6789")))) + +(def: fuzzy-quantifiers + Test + ($_ _.and + (_.test "Can sequentially combine patterns." + (text-should-pass "aa" (/.regex "aa") "aa")) + + (_.test "Can match patterns optionally." + (and (text-should-pass "a" (/.regex "a?") "a") + (text-should-pass "" (/.regex "a?") ""))) + + (_.test "Can match a pattern 0 or more times." + (and (text-should-pass "aaa" (/.regex "a*") "aaa") + (text-should-pass "" (/.regex "a*") ""))) + + (_.test "Can match a pattern 1 or more times." + (and (text-should-pass "aaa" (/.regex "a+") "aaa") + (text-should-pass "a" (/.regex "a+") "a") + (should-fail (/.regex "a+") ""))) )) -(context: "Regular Expressions [Crisp Quantifiers]" - ($_ seq - (test "Can match a pattern N times." - (and (should-passT "aa" (&.regex "a{2}") "aa") - (should-passT "a" (&.regex "a{1}") "a") - (should-fail (&.regex "a{3}") "aa"))) - - (test "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"))) - - (test "Can match a pattern at-most N times." - (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"))) +(def: crisp-quantifiers + Test + ($_ _.and + (_.test "Can match a pattern N times." + (and (text-should-pass "aa" (/.regex "a{2}") "aa") + (text-should-pass "a" (/.regex "a{1}") "a") + (should-fail (/.regex "a{3}") "aa"))) + + (_.test "Can match a pattern at-least N times." + (and (text-should-pass "aa" (/.regex "a{1,}") "aa") + (text-should-pass "aa" (/.regex "a{2,}") "aa") + (should-fail (/.regex "a{3,}") "aa"))) + + (_.test "Can match a pattern at-most N times." + (and (text-should-pass "aa" (/.regex "a{,2}") "aa") + (text-should-pass "aa" (/.regex "a{,3}") "aa"))) + + (_.test "Can match a pattern between N and M times." + (and (text-should-pass "a" (/.regex "a{1,2}") "a") + (text-should-pass "aa" (/.regex "a{1,2}") "aa"))) )) -(context: "Regular Expressions [Groups]" - ($_ seq - (test "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 "(?<code>\d{3})-\k<code>-(\d{4})") "809-809-6789") - (should-check ["809-809-6789-6789" "809" "6789"] (&.regex "(?<code>\d{3})-\k<code>-(\d{4})-\0") "809-809-6789-6789"))) - - (test "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")) +(def: groups + Test + ($_ _.and + (_.test "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 "(?<code>\d{3})-\k<code>-(\d{4})") "809-809-6789") + (should-check ["809-809-6789-6789" "809" "6789"] (/.regex "(?<code>\d{3})-\k<code>-(\d{4})-\0") "809-809-6789-6789"))) + + (_.test "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")) )) -(context: "Regular Expressions [Alternation]" - ($_ seq - (test "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"))) - - (test "Can have groups within alternations." - (and (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"))) +(def: alternation + Test + ($_ _.and + (_.test "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"))) + + (_.test "Can have groups within alternations." + (and (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"))) )) -(context: "Pattern-matching" - (<| (times 100) - (do @ - [sample1 (r.unicode 3) - sample2 (r.unicode 3) - sample3 (r.unicode 4)] - (case (format sample1 "-" sample2 "-" sample3) - (&.^regex "(.{3})-(.{3})-(.{4})" - [_ match1 match2 match3]) - (test "Can pattern-match using regular-expressions." - (and (text;= sample1 match1) - (text;= sample2 match2) - (text;= sample3 match3))) - - _ - (test "Cannot pattern-match using regular-expressions." - #0))))) +(def: pattern-matching + Test + (do r.monad + [sample1 (r.unicode 3) + sample2 (r.unicode 3) + sample3 (r.unicode 4)] + (case (format sample1 "-" sample2 "-" sample3) + (/.^regex "(.{3})-(.{3})-(.{4})" + [_ match1 match2 match3]) + (_.test "Can pattern-match using regular-expressions." + (and (text@= sample1 match1) + (text@= sample2 match2) + (text@= sample3 match3))) + + _ + (_.test "Cannot pattern-match using regular-expressions." + #0)))) + +(def: #export test + Test + (<| (_.context (%name (name-of /.regex))) + ($_ _.and + ..basics + ..system-character-classes + ..special-system-character-classes + ..custom-character-classes + ..references + ..fuzzy-quantifiers + ..crisp-quantifiers + ..groups + ..alternation + ..pattern-matching + ))) |