From 692f9751f36fbfc4a5f1148c7b1fadc03495fa6b Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Fri, 19 Apr 2019 01:13:00 -0400 Subject: Moved the text lexers under "lux/control/parser/". --- stdlib/source/test/lux/control.lux | 9 ++ stdlib/source/test/lux/control/parser/text.lux | 171 +++++++++++++++++++++ stdlib/source/test/lux/data.lux | 2 - stdlib/source/test/lux/data/text/lexer.lux | 171 --------------------- stdlib/source/test/lux/data/text/regex.lux | 14 +- .../test/lux/tool/compiler/default/syntax.lux | 6 +- 6 files changed, 191 insertions(+), 182 deletions(-) create mode 100644 stdlib/source/test/lux/control/parser/text.lux delete mode 100644 stdlib/source/test/lux/data/text/lexer.lux (limited to 'stdlib/source/test') diff --git a/stdlib/source/test/lux/control.lux b/stdlib/source/test/lux/control.lux index 9d95dc969..bacb4cb24 100644 --- a/stdlib/source/test/lux/control.lux +++ b/stdlib/source/test/lux/control.lux @@ -19,6 +19,8 @@ ["#." frp] ["#." actor] ["#." stm]] + ["#." parser #_ + ["#/." text]] [security ["#." privacy] ["#." integrity]] @@ -34,6 +36,12 @@ /stm.test )) +(def: parser + Test + ($_ _.and + /parser/text.test + )) + (def: security Test ($_ _.and @@ -57,5 +65,6 @@ /thread.test /writer.test ..concurrency + ..parser ..security )) diff --git a/stdlib/source/test/lux/control/parser/text.lux b/stdlib/source/test/lux/control/parser/text.lux new file mode 100644 index 000000000..3693b0fd0 --- /dev/null +++ b/stdlib/source/test/lux/control/parser/text.lux @@ -0,0 +1,171 @@ +(.module: + [lux #* + data/text/format + ["_" test (#+ Test)] + [abstract/monad (#+ do)] + [control + pipe + ["p" parser]] + [data + ["." error (#+ Error)] + ["." text ("#@." equivalence)] + [collection + ["." list]]] + [math + ["r" random]]] + {1 + ["." /]}) + +(def: (should-fail input) + (All [a] (-> (Error a) Bit)) + (case input + (#error.Failure _) + true + + _ + false)) + +(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.lux b/stdlib/source/test/lux/data.lux index 92680f03a..a29358b6b 100644 --- a/stdlib/source/test/lux/data.lux +++ b/stdlib/source/test/lux/data.lux @@ -20,7 +20,6 @@ ["#." ratio] ["#." complex]] ["#." text - ["#/." lexer] ["#/." regex]] [format ["#." json] @@ -42,7 +41,6 @@ (def: text ($_ _.and /text.test - /text/lexer.test /text/regex.test )) diff --git a/stdlib/source/test/lux/data/text/lexer.lux b/stdlib/source/test/lux/data/text/lexer.lux deleted file mode 100644 index 3693b0fd0..000000000 --- a/stdlib/source/test/lux/data/text/lexer.lux +++ /dev/null @@ -1,171 +0,0 @@ -(.module: - [lux #* - data/text/format - ["_" test (#+ Test)] - [abstract/monad (#+ do)] - [control - pipe - ["p" parser]] - [data - ["." error (#+ Error)] - ["." text ("#@." equivalence)] - [collection - ["." list]]] - [math - ["r" random]]] - {1 - ["." /]}) - -(def: (should-fail input) - (All [a] (-> (Error a) Bit)) - (case input - (#error.Failure _) - true - - _ - false)) - -(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 a683c446f..eeec23d2f 100644 --- a/stdlib/source/test/lux/data/text/regex.lux +++ b/stdlib/source/test/lux/data/text/regex.lux @@ -5,12 +5,12 @@ [abstract/monad (#+ do)] [control pipe - ["p" parser]] + ["p" parser + ["<.>" text (#+ Lexer)]]] [data [number (#+ hex)] ["." error] - ["." text ("#@." equivalence) - ["." lexer (#+ Lexer)]]] + ["." text ("#@." equivalence)]] [math ["r" random]] ["." macro @@ -20,7 +20,7 @@ (def: (should-pass regex input) (-> (Lexer Text) Text Bit) - (|> (lexer.run input regex) + (|> (.run input regex) (case> (#error.Success parsed) (text@= parsed input) @@ -29,7 +29,7 @@ (def: (text-should-pass test regex input) (-> Text (Lexer Text) Text Bit) - (|> (lexer.run input regex) + (|> (.run input regex) (case> (#error.Success parsed) (text@= test parsed) @@ -38,7 +38,7 @@ (def: (should-fail regex input) (All [a] (-> (Lexer a) Text Bit)) - (|> (lexer.run input regex) + (|> (.run input regex) (case> (#error.Failure _) true @@ -47,7 +47,7 @@ (syntax: (should-check pattern regex input) (macro.with-gensyms [g!message g!_] - (wrap (list (` (|> (lexer.run (~ input) (~ regex)) + (wrap (list (` (|> (.run (~ input) (~ regex)) (case> (^ (#error.Success (~ pattern))) true diff --git a/stdlib/source/test/lux/tool/compiler/default/syntax.lux b/stdlib/source/test/lux/tool/compiler/default/syntax.lux index 9f36c551f..a0005cc64 100644 --- a/stdlib/source/test/lux/tool/compiler/default/syntax.lux +++ b/stdlib/source/test/lux/tool/compiler/default/syntax.lux @@ -6,10 +6,12 @@ ["." name]] ["r" math/random (#+ Random) ("#@." monad)] ["_" test (#+ Test)] + [control + [parser + ["l" text]]] [data ["." error] - ["." text - ["l" lexer]] + ["." text] [collection ["." list] ["." dictionary (#+ Dictionary)]]] -- cgit v1.2.3