From ed0406cb0994f14ca5a3e6120b7b1ec6927bae75 Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Mon, 19 Jun 2017 20:06:41 -0400 Subject: - JSON polytypic generator checks for (Dict Text ?) instead of (List [Text ?]). - Lexers now rely only on Text, instead of also relying on Char. --- stdlib/test/test/lux/data/format/json.lux | 55 +++++----- stdlib/test/test/lux/data/text/lexer.lux | 162 ++++++++++++++---------------- 2 files changed, 105 insertions(+), 112 deletions(-) (limited to 'stdlib/test') diff --git a/stdlib/test/test/lux/data/format/json.lux b/stdlib/test/test/lux/data/format/json.lux index b52b72635..88e4603d8 100644 --- a/stdlib/test/test/lux/data/format/json.lux +++ b/stdlib/test/test/lux/data/format/json.lux @@ -14,28 +14,28 @@ [number "i/" Number] (format ["&" json]) (coll [vector #+ vector] - [dict] + ["d" dict] [list])) [macro #+ with-gensyms] (macro [code] [syntax #+ syntax:] [poly #+ derived:]) - ["R" math/random] + ["r" math/random] test) ) (def: gen-json - (R;Random &;JSON) - (R;rec (function [gen-json] - (do R;Monad - [size (:: @ map (n.% +2) R;nat)] - ($_ R;alt + (r;Random &;JSON) + (r;rec (function [gen-json] + (do r;Monad + [size (:: @ map (n.% +2) r;nat)] + ($_ r;alt (:: @ wrap []) - R;bool - (|> R;real (:: @ map (r.* 1_000_000.0))) - (R;text size) - (R;vector size gen-json) - (R;dict text;Hash size (R;text size) gen-json) + r;bool + (|> r;real (:: @ map (r.* 1_000_000.0))) + (r;text size) + (r;vector size gen-json) + (r;dict text;Hash size (r;text size) gen-json) ))))) (test: "JSON" @@ -70,24 +70,26 @@ #maybe (Maybe Int) #list (List Int) #variant Variant - #tuple [Int Real Char]}) + #tuple [Int Real Char] + #dict (d;Dict Text Int)}) (def: gen-record - (R;Random Record) - (do R;Monad - [size (:: @ map (n.% +2) R;nat) - #let [gen-int (|> R;int (:: @ map (|>. i/abs (i.% 1_000_000))))]] - ($_ R;seq + (r;Random Record) + (do r;Monad + [size (:: @ map (n.% +2) r;nat) + #let [gen-int (|> r;int (:: @ map (|>. i/abs (i.% 1_000_000))))]] + ($_ r;seq (:: @ wrap []) - R;bool + r;bool gen-int - R;real - R;char - (R;text size) - (R;maybe gen-int) - (R;list size gen-int) - ($_ R;alt R;bool gen-int R;real) - ($_ R;seq gen-int R;real R;char) + r;real + r;char + (r;text size) + (r;maybe gen-int) + (r;list size gen-int) + ($_ r;alt r;bool gen-int r;real) + ($_ r;seq gen-int r;real r;char) + (r;dict text;Hash size (r;text size) gen-int) ))) (derived: (&;Codec Record)) @@ -120,6 +122,7 @@ (and (i.= tL0 tR0) (r.= tL1 tR1) (:: char;Eq = tL2 tR2))) + (:: (d;Eq i.=) = (get@ #dict recL) (get@ #dict recR)) )))) (test: "Polytypism" diff --git a/stdlib/test/test/lux/data/text/lexer.lux b/stdlib/test/test/lux/data/text/lexer.lux index f9b6bdc79..df77f804a 100644 --- a/stdlib/test/test/lux/data/text/lexer.lux +++ b/stdlib/test/test/lux/data/text/lexer.lux @@ -3,33 +3,23 @@ (lux (control monad pipe) [io] - (data ["E" result] + (data ["R" result] [text "T/" Eq] text/format ["&" text/lexer] - [char "C/" Eq] (coll [list])) - ["R" math/random]) + ["r" math/random]) lux/test) ## [Utils] (def: (should-fail input) - (All [a] (-> (E;Result a) Bool)) + (All [a] (-> (R;Result a) Bool)) (case input (#;Left _) true _ false)) -(def: (should-passC test input) - (-> Char (E;Result Char) Bool) - (case input - (#;Right output) - (C/= test output) - - _ - false)) - (def: (should-passT test input) - (-> Text (E;Result Text) Bool) + (-> Text (R;Result Text) Bool) (case input (#;Right output) (T/= test output) @@ -38,8 +28,8 @@ false)) (def: (should-passL test input) - (-> (List Char) (E;Result (List Char)) Bool) - (let [(^open "L/") (list;Eq char;Eq)] + (-> (List Text) (R;Result (List Text)) Bool) + (let [(^open "L/") (list;Eq text;Eq)] (case input (#;Right output) (L/= test output) @@ -48,15 +38,15 @@ false))) (def: (should-passE test input) - (-> (Either Char Char) (E;Result (Either Char Char)) Bool) + (-> (Either Text Text) (R;Result (Either Text Text)) Bool) (case input (#;Right output) (case [test output] [(#;Left test) (#;Left output)] - (C/= test output) + (T/= test output) [(#;Right test) (#;Right output)] - (C/= test output) + (T/= test output) _ false) @@ -79,17 +69,17 @@ )) (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)))] + [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 (format pre post) - (&;text pre)) - (case> (#;Right found) (T/= pre found) _ false)) + (&;this pre)) + (case> (#;Right []) true _ false)) (|> (&;run post - (&;text pre)) + (&;this pre)) (case> (#;Left _) true _ false)))) )) @@ -97,15 +87,15 @@ ($_ seq (assert "Can lex characters." (and (|> (&;run "YOLO" - (&;char #"Y")) - (case> (#;Right #"Y") true _ false)) + (&;this "Y")) + (case> (#;Right []) true _ false)) (|> (&;run "MEME" - (&;char #"Y")) + (&;this "Y")) (case> (#;Left _) true _ false)))) (assert "Can lex characters ranges." - (and (should-passC #"Y" (&;run "YOLO" - (&;char-range #"X" #"Z"))) + (and (should-passT "Y" (&;run "YOLO" + (&;char-range #"X" #"Z"))) (should-fail (&;run "MEME" (&;char-range #"X" #"Z"))))) )) @@ -113,64 +103,64 @@ (test: "Custom lexers" ($_ seq (assert "Can lex anything" - (and (should-passC #"A" (&;run "A" - &;any)) + (and (should-passT "A" (&;run "A" + &;any)) (should-fail (&;run "" &;any)))) (assert "Can lex upper-case and &;lower-case letters." - (and (should-passC #"Y" (&;run "YOLO" - &;upper)) + (and (should-passT "Y" (&;run "YOLO" + &;upper)) (should-fail (&;run "meme" &;upper)) - (should-passC #"y" (&;run "yolo" - &;lower)) + (should-passT "y" (&;run "yolo" + &;lower)) (should-fail (&;run "MEME" &;lower)))) (assert "Can lex numbers." - (and (should-passC #"1" (&;run "1" - &;digit)) + (and (should-passT "1" (&;run "1" + &;digit)) (should-fail (&;run " " &;digit)) - (should-passC #"7" (&;run "7" - &;oct-digit)) + (should-passT "7" (&;run "7" + &;oct-digit)) (should-fail (&;run "8" &;oct-digit)) - (should-passC #"1" (&;run "1" - &;hex-digit)) - (should-passC #"a" (&;run "a" - &;hex-digit)) - (should-passC #"A" (&;run "A" - &;hex-digit)) + (should-passT "1" (&;run "1" + &;hex-digit)) + (should-passT "a" (&;run "a" + &;hex-digit)) + (should-passT "A" (&;run "A" + &;hex-digit)) (should-fail (&;run " " &;hex-digit)) )) (assert "Can lex alphabetic characters." - (and (should-passC #"A" (&;run "A" - &;alpha)) - (should-passC #"a" (&;run "a" - &;alpha)) + (and (should-passT "A" (&;run "A" + &;alpha)) + (should-passT "a" (&;run "a" + &;alpha)) (should-fail (&;run "1" &;alpha)))) (assert "Can lex alphanumeric characters." - (and (should-passC #"A" (&;run "A" - &;alpha-num)) - (should-passC #"a" (&;run "a" - &;alpha-num)) - (should-passC #"1" (&;run "1" - &;alpha-num)) + (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)))) (assert "Can lex white-space." - (and (should-passC #" " (&;run " " - &;space)) + (and (should-passT " " (&;run " " + &;space)) (should-fail (&;run "8" &;space)))) )) @@ -180,48 +170,48 @@ (assert "Can combine lexers sequentially." (and (|> (&;run "YOLO" (&;seq &;any &;any)) - (case> (#;Right [#"Y" #"O"]) true + (case> (#;Right ["Y" "O"]) true _ false)) (should-fail (&;run "Y" (&;seq &;any &;any))))) (assert "Can combine lexers alternatively." - (and (should-passE (#;Left #"0") (&;run "0" + (and (should-passE (#;Left "0") (&;run "0" + (&;alt &;digit &;upper))) + (should-passE (#;Right "A") (&;run "A" (&;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 "a" - (&;not (&;alt &;digit &;upper)))) + (and (should-passT "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 "0" - (&;either &;digit &;upper))) - (should-passC #"A" (&;run "A" - (&;either &;digit &;upper))) + (and (should-passT "0" (&;run "0" + (&;either &;digit &;upper))) + (should-passT "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 "C" - (&;one-of "ABC"))) + (and (should-passT "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 "D" - (&;none-of "ABC"))) + (and (should-passT "D" (&;run "D" + (&;none-of "ABC"))) (should-fail (&;run "C" (&;none-of "ABC"))))) (assert "Can lex using arbitrary predicates." - (and (should-passC #"D" (&;run "D" - (&;satisfies (function [c] true)))) + (and (should-passT "D" (&;run "D" + (&;satisfies (function [c] true)))) (should-fail (&;run "C" (&;satisfies (function [c] false)))))) @@ -250,7 +240,7 @@ _ 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") + (and (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") (&;run "0123456789ABCDEF yolo" (&;many &;hex-digit))) (should-fail (&;run "yolo" @@ -261,43 +251,43 @@ (&;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") + (and (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") (&;run "0123456789ABCDEF yolo" (&;exactly +16 &;hex-digit))) - (should-passL (list #"0" #"1" #"2") + (should-passL (list "0" "1" "2") (&;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") + (and (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") (&;run "0123456789ABCDEF yolo" (&;at-most +16 &;hex-digit))) - (should-passL (list #"0" #"1" #"2") + (should-passL (list "0" "1" "2") (&;run "0123456789ABCDEF yolo" (&;at-most +3 &;hex-digit))) - (should-passL (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F") + (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") (&;run "0123456789ABCDEF yolo" (&;at-most +17 &;hex-digit))))) (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") + (and (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") (&;run "0123456789ABCDEF yolo" (&;between +0 +16 &;hex-digit))) - (should-passL (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F") + (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") (&;run "0123456789ABCDEF yolo" (&;between +3 +16 &;hex-digit))) (should-fail (&;run "0123456789ABCDEF yolo" (&;between +17 +100 &;hex-digit))) - (should-passL (list #"0" #"1" #"2" #"3" #"4" #"5" #"6" #"7" #"8" #"9" #"A" #"B" #"C" #"D" #"E" #"F") + (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "A" "B" "C" "D" "E" "F") (&;run "0123456789ABCDEF yolo" (&;between +15 +20 &;hex-digit))))) (assert "Can optionally lex a token." (and (|> (&;run "123abc" (&;opt &;hex-digit)) - (case> (#;Right (#;Some #"1")) true + (case> (#;Right (#;Some "1")) true _ false)) (|> (&;run "yolo" (&;opt &;hex-digit)) @@ -305,7 +295,7 @@ _ 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") + (should-passL (list "0" "1" "2" "3" "4" "5" "6" "7" "8" "9" "a" "b" "c" "d" "e" "f") (&;run "0 1 2 3 4 5 6 7 8 9 a b c d e f YOLO" (&;sep-by &;space &;hex-digit)))) -- cgit v1.2.3