From b5c854fb5ac1ead274f4ae0c657da66df957f14e Mon Sep 17 00:00:00 2001 From: Eduardo Julian Date: Wed, 15 Nov 2017 20:57:47 -0400 Subject: - Moved "luxc/lang/syntax" to "lux/lang/syntax". - Minor refactoring. --- stdlib/test/test/lux/lang/syntax.lux | 233 +++++++++++++++++++++++++++++++++++ stdlib/test/tests.lux | 1 + 2 files changed, 234 insertions(+) create mode 100644 stdlib/test/test/lux/lang/syntax.lux (limited to 'stdlib/test') diff --git a/stdlib/test/test/lux/lang/syntax.lux b/stdlib/test/test/lux/lang/syntax.lux new file mode 100644 index 000000000..4db181cae --- /dev/null +++ b/stdlib/test/test/lux/lang/syntax.lux @@ -0,0 +1,233 @@ +(;module: + lux + (lux [io] + (control [monad #+ do]) + (data [number] + ["e" error] + [text] + (text format + ["l" lexer]) + (coll [list])) + ["r" math/random "r/" Monad] + (meta [code]) + (lang ["&" syntax]) + test)) + +(def: default-cursor + Cursor + {#;module "" + #;line +0 + #;column +0}) + +(def: ident-part^ + (r;Random Text) + (do r;Monad + [#let [digits "0123456789" + delimiters "()[]{}#;\"" + space "\t\v \n\r\f" + invalid-range (format digits delimiters space) + char-gen (|> r;nat + (r;filter (function [sample] + (not (text;contains? (text;from-code sample) + invalid-range)))))] + size (|> r;nat (:: @ map (|>. (n.% +20) (n.max +1))))] + (r;text' char-gen size))) + +(def: ident^ + (r;Random Ident) + (r;seq ident-part^ ident-part^)) + +(def: code^ + (r;Random Code) + (let [numeric^ (: (r;Random Code) + ($_ r;either + (|> r;bool (r/map (|>. #;Bool [default-cursor]))) + (|> r;nat (r/map (|>. #;Nat [default-cursor]))) + (|> r;int (r/map (|>. #;Int [default-cursor]))) + (|> r;deg (r/map (|>. #;Deg [default-cursor]))) + (|> r;frac (r/map (|>. #;Frac [default-cursor]))))) + textual^ (: (r;Random Code) + ($_ r;either + (do r;Monad + [size (|> r;nat (r/map (n.% +20)))] + (|> (r;text size) (r/map (|>. #;Text [default-cursor])))) + (|> ident^ (r/map (|>. #;Symbol [default-cursor]))) + (|> ident^ (r/map (|>. #;Tag [default-cursor]))))) + simple^ (: (r;Random Code) + ($_ r;either + numeric^ + textual^))] + (r;rec + (function [code^] + (let [multi^ (do r;Monad + [size (|> r;nat (r/map (n.% +3)))] + (r;list size code^)) + composite^ (: (r;Random Code) + ($_ r;either + (|> multi^ (r/map (|>. #;Form [default-cursor]))) + (|> multi^ (r/map (|>. #;Tuple [default-cursor]))) + (do r;Monad + [size (|> r;nat (r/map (n.% +3)))] + (|> (r;list size (r;seq code^ code^)) + (r/map (|>. #;Record [default-cursor]))))))] + (r;either simple^ + composite^)))))) + +(context: "Lux code syntax." + (<| (times +100) + (do @ + [sample code^ + other code^] + ($_ seq + (test "Can parse Lux code." + (case (&;parse "" [default-cursor +0 (code;to-text sample)]) + (#e;Error error) + false + + (#e;Success [_ parsed]) + (:: code;Eq = parsed sample))) + (test "Can parse Lux multiple code nodes." + (case (&;parse "" [default-cursor +0 (format (code;to-text sample) " " + (code;to-text other))]) + (#e;Error error) + false + + (#e;Success [remaining =sample]) + (case (&;parse "" remaining) + (#e;Error error) + false + + (#e;Success [_ =other]) + (and (:: code;Eq = sample =sample) + (:: code;Eq = other =other))))) + )))) + +(def: nat-to-frac + (-> Nat Frac) + (|>. nat-to-int int-to-frac)) + +(context: "Frac special syntax." + (<| (times +100) + (do @ + [numerator (|> r;nat (:: @ map (|>. (n.% +100) nat-to-frac))) + denominator (|> r;nat (:: @ map (|>. (n.% +100) (n.max +1) nat-to-frac))) + signed? r;bool + #let [expected (|> numerator (f./ denominator) (f.* (if signed? -1.0 1.0)))]] + (test "Can parse frac ratio syntax." + (case (&;parse "" [default-cursor +0 + (format (if signed? "-" "") + (%i (frac-to-int numerator)) + "/" + (%i (frac-to-int denominator)))]) + (#e;Success [_ [_ (#;Frac actual)]]) + (f.= expected actual) + + _ + false) + )))) + +(context: "Nat special syntax." + (<| (times +100) + (do @ + [expected (|> r;nat (:: @ map (n.% +1_000)))] + (test "Can parse nat char syntax." + (case (&;parse "" [default-cursor +0 + (format "#" (%t (text;from-code expected)) "")]) + (#e;Success [_ [_ (#;Nat actual)]]) + (n.= expected actual) + + _ + false) + )))) + +(def: comment-text^ + (r;Random Text) + (let [char-gen (|> r;nat (r;filter (function [value] + (not (or (text;space? value) + (n.= (char "#") value) + (n.= (char "(") value) + (n.= (char ")") value))))))] + (do r;Monad + [size (|> r;nat (r/map (n.% +20)))] + (r;text' char-gen size)))) + +(def: comment^ + (r;Random Text) + (r;either (do r;Monad + [comment comment-text^] + (wrap (format "## " comment "\n"))) + (r;rec (function [nested^] + (do r;Monad + [comment (r;either comment-text^ + nested^)] + (wrap (format "#( " comment " )#"))))))) + +(context: "Multi-line text & comments." + (<| (times +100) + (do @ + [#let [char-gen (|> r;nat (r;filter (function [value] + (not (or (text;space? value) + (n.= (char "\"") value))))))] + x char-gen + y char-gen + z char-gen + offset-size (|> r;nat (r/map (|>. (n.% +10) (n.max +1)))) + #let [offset (text;join-with "" (list;repeat offset-size " "))] + sample code^ + comment comment^ + unbalanced-comment comment-text^] + ($_ seq + (test "Will reject invalid multi-line text." + (let [bad-match (format (text;from-code x) "\n" + (text;from-code y) "\n" + (text;from-code z))] + (case (&;parse "" [default-cursor +0 + (format "\"" bad-match "\"")]) + (#e;Error error) + true + + (#e;Success [_ parsed]) + false))) + (test "Will accept valid multi-line text" + (let [good-input (format (text;from-code x) "\n" + offset (text;from-code y) "\n" + offset (text;from-code z)) + good-output (format (text;from-code x) "\n" + (text;from-code y) "\n" + (text;from-code z))] + (case (&;parse "" [(|> default-cursor (update@ #;column (n.+ (n.dec offset-size)))) + +0 + (format "\"" good-input "\"")]) + (#e;Error error) + false + + (#e;Success [_ parsed]) + (:: code;Eq = + parsed + (code;text good-output))))) + (test "Can handle comments." + (case (&;parse "" [default-cursor +0 + (format comment (code;to-text sample))]) + (#e;Error error) + false + + (#e;Success [_ parsed]) + (:: code;Eq = parsed sample))) + (test "Will reject unbalanced multi-line comments." + (and (case (&;parse "" [default-cursor +0 + (format "#(" "#(" unbalanced-comment ")#" + (code;to-text sample))]) + (#e;Error error) + true + + (#e;Success [_ parsed]) + false) + (case (&;parse "" [default-cursor +0 + (format "#(" unbalanced-comment ")#" ")#" + (code;to-text sample))]) + (#e;Error error) + true + + (#e;Success [_ parsed]) + false))) + )))) diff --git a/stdlib/test/tests.lux b/stdlib/test/tests.lux index aa816c4d3..ea0aa72f7 100644 --- a/stdlib/test/tests.lux +++ b/stdlib/test/tests.lux @@ -70,6 +70,7 @@ (type ["_;" check] ["_;" auto] ["_;" object])) + (lang ["lang_;" syntax]) (world ["_;" blob] ["_;" file] (net ["_;" tcp] -- cgit v1.2.3