From de9d2c8f69eee373d4940798b30be4aeaf7652bc Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Fri, 14 Apr 2017 21:32:23 -0400
Subject: - Added tests for parser.

---
 new-luxc/test/test/luxc/parser.lux | 81 ++++++++++++++++++++++++++++++++++++++
 new-luxc/test/tests.lux            | 12 ++++++
 2 files changed, 93 insertions(+)
 create mode 100644 new-luxc/test/test/luxc/parser.lux
 create mode 100644 new-luxc/test/tests.lux

(limited to 'new-luxc/test')

diff --git a/new-luxc/test/test/luxc/parser.lux b/new-luxc/test/test/luxc/parser.lux
new file mode 100644
index 000000000..7ccc0c451
--- /dev/null
+++ b/new-luxc/test/test/luxc/parser.lux
@@ -0,0 +1,81 @@
+(;module:
+  lux
+  (lux [io]
+       (control monad
+                pipe)
+       (data [char]
+             [text "T/" Eq<Text>]
+             (text format
+                   ["l" lexer])
+             [number])
+       ["R" math/random "R/" Monad<Random>]
+       (macro [ast])
+       test)
+  (luxc ["&" parser]))
+
+(def: default-cursor
+  Cursor
+  {#;module ""
+   #;line   +0
+   #;column +0})
+
+(def: ident-part^
+  (R;Random Text)
+  (do R;Monad<Random>
+    [#let [digits "0123456789"
+           delimiters "()[]{}#;"
+           space "\t\v \n\r\f"
+           invalid-range (format digits delimiters space)
+           char-gen (|> R;char
+                        (R;filter (function [sample]
+                                    (not (text;contains? (char;as-text sample)
+                                                         invalid-range)))))]
+     size (|> R;nat (:: @ map (n.% +20)))]
+    (R;text' char-gen size)))
+
+(def: ident^
+  (R;Random Ident)
+  (R;seq ident-part^ ident-part^))
+
+(def: ast^
+  (R;Random AST)
+  (let [simple^ (: (R;Random AST)
+                   ($_ R;either
+                       (|> R;bool (R/map (|>. #;BoolS [default-cursor])))
+                       (|> R;nat (R/map (|>. #;NatS [default-cursor])))
+                       (|> R;int (R/map (|>. #;IntS [default-cursor])))
+                       (|> R;deg (R/map (|>. #;DegS [default-cursor])))
+                       (|> R;real (R/map (|>. #;RealS [default-cursor])))
+                       (|> R;char (R/map (|>. #;CharS [default-cursor])))
+                       (do R;Monad<Random>
+                         [size (|> R;nat (R/map (n.% +20)))]
+                         (|> (R;text size) (R/map (|>. #;TextS [default-cursor]))))
+                       (|> ident^ (R/map (|>. #;SymbolS [default-cursor])))
+                       (|> ident^ (R/map (|>. #;TagS [default-cursor])))))]
+    (R;rec
+     (function [ast^]
+       (let [multi^ (do R;Monad<Random>
+                      [size (|> R;nat (R/map (n.% +2)))]
+                      (R;list size ast^))
+             composite^ (: (R;Random AST)
+                           ($_ R;either
+                               (|> multi^ (R/map (|>. #;FormS [default-cursor])))
+                               (|> multi^ (R/map (|>. #;TupleS [default-cursor])))
+                               (do R;Monad<Random>
+                                 [size (|> R;nat (R/map (n.% +2)))]
+                                 (|> (R;list size (R;seq ast^ ast^))
+                                     (R/map (|>. #;RecordS [default-cursor]))))))]
+         (R;either simple^
+                   composite^))))))
+
+(test: "Lux code parser."
+  [sample ast^]
+  (assert "Can parse Lux code."
+          (|> &;ast^
+              (l;run (ast;to-text sample))
+              (case> (#;Left error)
+                     false
+
+                     (#;Right parsed)
+                     (:: ast;Eq<AST> = parsed sample))
+              )))
diff --git a/new-luxc/test/tests.lux b/new-luxc/test/tests.lux
new file mode 100644
index 000000000..443ec6757
--- /dev/null
+++ b/new-luxc/test/tests.lux
@@ -0,0 +1,12 @@
+(;module:
+  lux
+  (lux (control monad)
+       [io]
+       (concurrency [promise])
+       [cli #+ program:]
+       [test])
+  (test (luxc ["_;" parser])))
+
+## [Program]
+(program: args
+  (test;run))
-- 
cgit v1.2.3