From 4295ff3a08dae2d1a31284d752c2e955456d9a32 Mon Sep 17 00:00:00 2001
From: Eduardo Julian
Date: Sat, 15 Apr 2017 19:41:38 -0400
Subject: - Fixed a bug with multi-line comments.

---
 new-luxc/source/luxc/parser.lux    | 50 +++++++++++----------
 new-luxc/test/test/luxc/parser.lux | 90 +++++++++++++++++++++++---------------
 2 files changed, 81 insertions(+), 59 deletions(-)

diff --git a/new-luxc/source/luxc/parser.lux b/new-luxc/source/luxc/parser.lux
index 7670d72c7..25f9af46a 100644
--- a/new-luxc/source/luxc/parser.lux
+++ b/new-luxc/source/luxc/parser.lux
@@ -46,30 +46,32 @@
 (def: (multi-line-comment^ where)
   (-> Cursor (Lexer [Text Cursor]))
   (do Monad<Lexer>
-    [_ (l;text "#(")
-     [comment end] (loop [comment ""
-                          where (|> where
-                                    (update@ #;column (n.+ +2)))]
-                     ($_ l;either
-                         (do @
-                           [_ (l;one-of "\n")]
-                           (recur (format comment "\n")
-                                  (|> where
-                                      (update@ #;line n.inc)
-                                      (set@ #;column +0))))
-                         (do @
-                           [chunk (l;some' (l;not comment-bound^))]
-                           (recur (format comment chunk)
-                                  (|> where
-                                      (update@ #;column (n.+ (text;size chunk))))))
-                         (do @
-                           [[sub-comment sub-where] (multi-line-comment^ where)]
-                           (wrap [(format comment "#(" sub-comment ")#")
-                                  sub-where]))))
-     _ (l;text ")#")]
-    (wrap [comment
-           (|> end
-               (update@ #;column (n.+ +2)))])))
+    [_ (l;text "#(")]
+    (loop [comment ""
+           where (|> where
+                     (update@ #;column (n.+ +2)))]
+      ($_ l;either
+          (do @
+            [chunk (l;many' (l;not comment-bound^))]
+            (recur (format comment chunk)
+                   (|> where
+                       (update@ #;column (n.+ (text;size chunk))))))
+          (do @
+            [_ (l;one-of "\n")]
+            (recur (format comment "\n")
+                   (|> where
+                       (update@ #;line n.inc)
+                       (set@ #;column +0))))
+          (do @
+            [[sub-comment sub-where] (multi-line-comment^ where)]
+            (recur (format comment "#(" sub-comment ")#")
+                   sub-where))
+          (do @
+            [_ (l;text ")#")]
+            (wrap [comment
+                   (|> where
+                       (update@ #;column (n.+ +2)))]))
+          ))))
 
 (def: (comment^ where)
   (-> Cursor (Lexer [Text Cursor]))
diff --git a/new-luxc/test/test/luxc/parser.lux b/new-luxc/test/test/luxc/parser.lux
index 32aad3b8f..79414b920 100644
--- a/new-luxc/test/test/luxc/parser.lux
+++ b/new-luxc/test/test/luxc/parser.lux
@@ -87,8 +87,30 @@
                      (:: ast;Eq<AST> = parsed sample))
               )))
 
+(def: comment-text^
+  (R;Random Text)
+  (let [char-gen (|> R;char (R;filter (function [value]
+                                        (not (or (char;space? value)
+                                                 (C/= #"\n" value)
+                                                 (C/= #"#" value)
+                                                 (C/= #"(" value)
+                                                 (C/= #")" value))))))]
+    (do R;Monad<Random>
+      [size (|> R;nat (R/map (n.% +20)))]
+      (R;text' char-gen size))))
+
+(def: comment^
+  (R;Random Text)
+  (R;either (do R;Monad<Random>
+              [comment comment-text^]
+              (wrap (format "## " comment "\n")))
+            (R;rec (function [nested^]
+                     (do R;Monad<Random>
+                       [comment (R;either comment-text^
+                                          nested^)]
+                       (wrap (format "#( " comment " )#")))))))
+
 (test: "Multi-line text & comments."
-  #seed +9223374029023245172
   [#let [char-gen (|> R;char (R;filter (function [value]
                                          (not (or (char;space? value)
                                                   (C/= #"\"" value)
@@ -99,44 +121,42 @@
    offset-size (|> R;nat (R/map (|>. (n.% +10) (n.max +1))))
    #let [offset (text;join-with "" (list;repeat offset-size " "))]
    sample ast^
-   comment (do @
-             [size (|> R;nat (R/map (n.% +20)))]
-             (R;text' char-gen size))]
+   comment comment^]
   ($_ seq
-      (assert "Can handle multi-line text."
-              (and (let [bad-match (format (char;as-text x) "\n"
-                                           (char;as-text y) "\n"
-                                           (char;as-text z))]
-                     (|> (&;ast^ default-cursor)
-                         (l;run (format "\"" bad-match "\""))
-                         (case> (#;Left error)
-                                true
+      (assert "Will reject invalid multi-line text."
+              (let [bad-match (format (char;as-text x) "\n"
+                                      (char;as-text y) "\n"
+                                      (char;as-text z))]
+                (|> (&;ast^ default-cursor)
+                    (l;run (format "\"" bad-match "\""))
+                    (case> (#;Left error)
+                           true
 
-                                (#;Right [parsed _])
-                                false)
-                         ))
-                   (let [good-input (format (char;as-text x) "\n"
-                                            offset (char;as-text y) "\n"
-                                            offset (char;as-text z))
-                         good-output (format (char;as-text x) "\n"
-                                             (char;as-text y) "\n"
-                                             (char;as-text z))]
-                     (|> (&;ast^ (|> default-cursor
-                                     (update@ #;column (n.+ (n.dec offset-size)))))
-                         (l;run (format "\"" good-input "\""))
-                         (case> (#;Left error)
-                                false
+                           (#;Right [parsed _])
+                           false)
+                    )))
+      (assert "Will accept valid multi-line text"
+              (let [good-input (format (char;as-text x) "\n"
+                                       offset (char;as-text y) "\n"
+                                       offset (char;as-text z))
+                    good-output (format (char;as-text x) "\n"
+                                        (char;as-text y) "\n"
+                                        (char;as-text z))]
+                (|> (&;ast^ (|> default-cursor
+                                (update@ #;column (n.+ (n.dec offset-size)))))
+                    (l;run (format "\"" good-input "\""))
+                    (case> (#;Left error)
+                           false
 
-                                (#;Right [parsed _])
-                                (:: ast;Eq<AST> =
-                                    parsed
-                                    (ast;text good-output)))
-                         ))
-                   ))
-      (assert "Can handle single-line comments."
+                           (#;Right [parsed _])
+                           (:: ast;Eq<AST> =
+                               parsed
+                               (ast;text good-output)))
+                    ))
+              )
+      (assert "Can handle comments."
               (|> (&;ast^ default-cursor)
-                  (l;run (format "## " comment "\n"
-                                 (ast;to-text sample)))
+                  (l;run (format comment (ast;to-text sample)))
                   (case> (#;Left error)
                          false
 
-- 
cgit v1.2.3