aboutsummaryrefslogtreecommitdiff
path: root/stdlib/test
diff options
context:
space:
mode:
authorEduardo Julian2017-01-12 19:39:31 -0400
committerEduardo Julian2017-01-12 19:39:31 -0400
commit1f28cd54954e8b2b978b5fa94956c8df4cbee698 (patch)
treec0ff4aaf6e57d1544402d40f461a88527f6a1cf9 /stdlib/test
parent129d3a169484c08d90a31fba5d8f59d39227c5fd (diff)
- Minor refactorings and additions.
Diffstat (limited to 'stdlib/test')
-rw-r--r--stdlib/test/test/lux/lexer.lux210
-rw-r--r--stdlib/test/test/lux/regex.lux8
2 files changed, 144 insertions, 74 deletions
diff --git a/stdlib/test/test/lux/lexer.lux b/stdlib/test/test/lux/lexer.lux
index 7e7408428..3c459ab8e 100644
--- a/stdlib/test/test/lux/lexer.lux
+++ b/stdlib/test/test/lux/lexer.lux
@@ -73,11 +73,13 @@
(test: "End"
($_ seq
(assert "Can detect the end of the input."
- (|> (&;run &;end "")
+ (|> (&;run ""
+ &;end)
(case> (#;Right _) true _ false)))
(assert "Won't mistake non-empty text for no more input."
- (|> (&;run &;end "YOLO")
+ (|> (&;run "YOLO"
+ &;end)
(case> (#;Left _) true _ false)))
))
@@ -88,163 +90,231 @@
(R;filter (|>. (text;starts-with? pre) not)))]
($_ seq
(assert "Can find literal text fragments."
- (and (|> (&;run (&;text pre) (format pre post))
+ (and (|> (&;run (format pre post)
+ (&;text pre))
(case> (#;Right found) (T/= pre found) _ false))
- (|> (&;run (&;text pre) post)
+ (|> (&;run post
+ (&;text pre))
(case> (#;Left _) true _ false))))
))
(test: "Char lexers"
($_ seq
(assert "Can lex characters."
- (and (|> (&;run (&;char #"Y") "YOLO")
+ (and (|> (&;run "YOLO"
+ (&;char #"Y"))
(case> (#;Right #"Y") true _ false))
- (|> (&;run (&;char #"Y") "MEME")
+ (|> (&;run "MEME"
+ (&;char #"Y"))
(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"))))
+ (and (should-passC #"Y" (&;run "YOLO"
+ (&;char-range #"X" #"Z")))
+ (should-fail (&;run "MEME"
+ (&;char-range #"X" #"Z")))))
))
(test: "Custom lexers"
($_ seq
(assert "Can lex anything"
- (and (should-passC #"A" (&;run &;any "A"))
- (should-fail (&;run &;any ""))))
+ (and (should-passC #"A" (&;run "A"
+ &;any))
+ (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"))
+ (and (should-passC #"Y" (&;run "YOLO"
+ &;upper))
+ (should-fail (&;run "meme"
+ &;upper))
- (should-passC #"y" (&;run &;lower "yolo"))
- (should-fail (&;run &;lower "MEME"))))
+ (should-passC #"y" (&;run "yolo"
+ &;lower))
+ (should-fail (&;run "MEME"
+ &;lower))))
(assert "Can lex numbers."
- (and (should-passC #"1" (&;run &;digit "1"))
- (should-fail (&;run &;digit " "))
+ (and (should-passC #"1" (&;run "1"
+ &;digit))
+ (should-fail (&;run " "
+ &;digit))
- (should-passC #"7" (&;run &;oct-digit "7"))
- (should-fail (&;run &;oct-digit "8"))
+ (should-passC #"7" (&;run "7"
+ &;oct-digit))
+ (should-fail (&;run "8"
+ &;oct-digit))
- (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 " "))
+ (should-passC #"1" (&;run "1"
+ &;hex-digit))
+ (should-passC #"a" (&;run "a"
+ &;hex-digit))
+ (should-passC #"A" (&;run "A"
+ &;hex-digit))
+ (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"))))
+ (and (should-passC #"A" (&;run "A"
+ &;alpha))
+ (should-passC #"a" (&;run "a"
+ &;alpha))
+ (should-fail (&;run "1"
+ &;alpha))))
(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 " "))))
+ (and (should-passC #"A" (&;run "A"
+ &;alpha-num))
+ (should-passC #"a" (&;run "a"
+ &;alpha-num))
+ (should-passC #"1" (&;run "1"
+ &;alpha-num))
+ (should-fail (&;run " "
+ &;alpha-num))))
(assert "Can lex white-space."
- (and (should-passC #" " (&;run &;space " "))
- (should-fail (&;run &;space "8"))))
+ (and (should-passC #" " (&;run " "
+ &;space))
+ (should-fail (&;run "8"
+ &;space))))
))
(test: "Combinators"
($_ seq
(assert "Can combine lexers sequentially."
- (and (|> (&;run (&;seq &;any &;any) "YOLO")
+ (and (|> (&;run "YOLO"
+ (&;seq &;any &;any))
(case> (#;Right [#"Y" #"O"]) true
_ false))
- (should-fail (&;run (&;seq &;any &;any) "Y"))))
+ (should-fail (&;run "Y"
+ (&;seq &;any &;any)))))
(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"))))
+ (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)))))
(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"))))
+ (and (should-passC #"a" (&;run "a"
+ (&;not (&;alt &;digit &;upper))))
+ (should-fail (&;run "A"
+ (&;not (&;alt &;digit &;upper))))))
(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"))))
+ (and (should-passC #"0" (&;run "0"
+ (&;either &;digit &;upper)))
+ (should-passC #"A" (&;run "A"
+ (&;either &;digit &;upper)))
+ (should-fail (&;run "a"
+ (&;either &;digit &;upper)))))
(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"))))
+ (and (should-passC #"C" (&;run "C"
+ (&;one-of "ABC")))
+ (should-fail (&;run "D"
+ (&;one-of "ABC")))))
(assert "Can avoid a set of characters."
- (and (should-passC #"D" (&;run (&;none-of "ABC") "D"))
- (should-fail (&;run (&;none-of "ABC") "C"))))
+ (and (should-passC #"D" (&;run "D"
+ (&;none-of "ABC")))
+ (should-fail (&;run "C"
+ (&;none-of "ABC")))))
(assert "Can lex using arbitrary predicates."
- (and (should-passC #"D" (&;run (&;satisfies (lambda [c] true)) "D"))
- (should-fail (&;run (&;satisfies (lambda [c] false)) "C"))))
+ (and (should-passC #"D" (&;run "D"
+ (&;satisfies (lambda [c] true))))
+ (should-fail (&;run "C"
+ (&;satisfies (lambda [c] false))))))
(assert "Can apply a lexer multiple times."
- (and (should-passT "0123456789ABCDEF" (&;run (&;many' &;hex-digit) "0123456789ABCDEF yolo"))
- (should-fail (&;run (&;many' &;hex-digit) "yolo"))
+ (and (should-passT "0123456789ABCDEF" (&;run "0123456789ABCDEF yolo"
+ (&;many' &;hex-digit)))
+ (should-fail (&;run "yolo"
+ (&;many' &;hex-digit)))
- (should-passT "" (&;run (&;some' &;hex-digit) "yolo"))))
+ (should-passT "" (&;run "yolo"
+ (&;some' &;hex-digit)))))
))
(test: "Yet more combinators..."
($_ seq
(assert "Can fail at will."
- (should-fail (&;run (&;fail "Well, it really SHOULD fail...") "yolo")))
+ (should-fail (&;run "yolo"
+ (&;fail "Well, it really SHOULD fail..."))))
(assert "Can make assertions."
- (and (should-fail (&;run (&;assert "Well, it really SHOULD fail..." false) "yolo"))
- (|> (&;run (&;assert "GO, GO, GO!" true) "yolo")
+ (and (should-fail (&;run "yolo"
+ (&;assert "Well, it really SHOULD fail..." false)))
+ (|> (&;run "yolo"
+ (&;assert "GO, GO, GO!" true))
(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"))
+ (&;run "0123456789ABCDEF yolo"
+ (&;many &;hex-digit)))
+ (should-fail (&;run "yolo"
+ (&;many &;hex-digit)))
(should-passL (list)
- (&;run (&;some &;hex-digit) "yolo"))))
+ (&;run "yolo"
+ (&;some &;hex-digit)))))
(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"))
+ (&;run "0123456789ABCDEF yolo"
+ (&;exactly +16 &;hex-digit)))
(should-passL (list #"0" #"1" #"2")
- (&;run (&;exactly +3 &;hex-digit) "0123456789ABCDEF yolo"))
- (should-fail (&;run (&;exactly +17 &;hex-digit) "0123456789ABCDEF yolo"))))
+ (&;run "0123456789ABCDEF yolo"
+ (&;exactly +3 &;hex-digit)))
+ (should-fail (&;run "0123456789ABCDEF yolo"
+ (&;exactly +17 &;hex-digit)))))
(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"))
+ (&;run "0123456789ABCDEF yolo"
+ (&;at-most +16 &;hex-digit)))
(should-passL (list #"0" #"1" #"2")
- (&;run (&;at-most +3 &;hex-digit) "0123456789ABCDEF yolo"))
+ (&;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 (&;at-most +17 &;hex-digit) "0123456789ABCDEF yolo"))))
+ (&;run "0123456789ABCDEF yolo"
+ (&;at-most +17 &;hex-digit)))))
(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"))
+ (&;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 (&;between +3 +16 &;hex-digit) "0123456789ABCDEF yolo"))
- (should-fail (&;run (&;between +17 +100 &;hex-digit) "0123456789ABCDEF yolo"))
+ (&;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 (&;between +15 +20 &;hex-digit) "0123456789ABCDEF yolo"))))
+ (&;run "0123456789ABCDEF yolo"
+ (&;between +15 +20 &;hex-digit)))))
(assert "Can optionally lex a token."
- (and (|> (&;run (&;opt &;hex-digit) "123abc")
+ (and (|> (&;run "123abc"
+ (&;opt &;hex-digit))
(case> (#;Right (#;Some #"1")) true
_ false))
- (|> (&;run (&;opt &;hex-digit) "yolo")
+ (|> (&;run "yolo"
+ (&;opt &;hex-digit))
(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")))
+ (&;run "0 1 2 3 4 5 6 7 8 9 a b c d e f YOLO"
+ (&;sep-by &;space &;hex-digit))))
(assert "Can obtain the whole of the remaining input."
- (should-passT "yolo" (&;run &;get-input "yolo")))
+ (should-passT "yolo" (&;run "yolo"
+ &;get-input)))
))
diff --git a/stdlib/test/test/lux/regex.lux b/stdlib/test/test/lux/regex.lux
index 281e6dbad..6c6854ce0 100644
--- a/stdlib/test/test/lux/regex.lux
+++ b/stdlib/test/test/lux/regex.lux
@@ -23,7 +23,7 @@
## [Utils]
(def: (should-pass regex input)
(-> (lexer;Lexer Text) Text Bool)
- (|> (lexer;run regex input)
+ (|> (lexer;run input regex)
(case> (#;Right parsed)
(T/= parsed input)
@@ -32,7 +32,7 @@
(def: (should-passT test regex input)
(-> Text (lexer;Lexer Text) Text Bool)
- (|> (lexer;run regex input)
+ (|> (lexer;run input regex)
(case> (#;Right parsed)
(T/= test parsed)
@@ -41,11 +41,11 @@
(def: (should-fail regex input)
(All [a] (-> (lexer;Lexer a) Text Bool))
- (|> (lexer;run regex input)
+ (|> (lexer;run input regex)
(case> (#;Left _) true _ false)))
(syntax: (should-check pattern regex input)
- (wrap (list (` (|> (lexer;run (~ regex) (~ input))
+ (wrap (list (` (|> (lexer;run (~ input) (~ regex))
(case> (^ (#;Right (~ pattern)))
true