parsing tests

1 files changed, 143 insertions, 0 deletions

diff --git a/tests/run.scm b/tests/run.scm
new file mode 100644
index 0000000..ef1c172
--- /dev/null
+++ b/tests/run.scm
@@ -0,0 +1,143 @@
+#| Copyright 2024 Peter McGoron
+ |
+ | Licensed under the Apache License, Version 2.0 (the "License");
+ |
+ | you may not use this file except in compliance with the License.
+ | You may obtain a copy of the License at
+ |
+ |     http://www.apache.org/licenses/LICENSE-2.0
+ |
+ | Unless required by applicable law or agreed to in writing, software
+ | distributed under the License is distributed on an "AS IS" BASIS,
+ | WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
+ | See the License for the specific language governing permissions and
+ | limitations under the License.
+ |#
+
+(load "../mcgoron/srfi/61.sld")
+(load "../market/string.sld")
+(load "../market/blocks.sld")
+(load "../market/default.sld")
+
+(import (prefix (only (mcgoron srfi 64) factory)
+                mcgoron-test-)
+        (srfi 64) (srfi 197) (srfi 117))
+(import (market default) (market string) (market blocks))
+
+(test-runner-factory mcgoron-test-factory)
+(test-runner-current (test-runner-create))
+
+(test-group "paragraphs"
+  (let ((str
+         (chain (parse->document "hello, world" #f)
+                (node-children _)
+                (list-queue-list _)
+                (list-ref _ 0)
+                (xstring->string _))))
+    (test-equal "single line" str "hello, world\n"))
+  (let ((str
+         (chain (parse->document "hello," #f)
+                (parse->document "world" _)
+                (node-children _)
+                (list-queue-list _)
+                (list-ref _ 0)
+                (xstring->string _))))
+    (test-equal "two lines" str "hello,\nworld\n"))
+  (test-group "two paragraphs"
+    (let ((children
+       (chain (parse->document "hello" #f)
+              (parse->document "" _)
+              (parse->document "world" _)
+              (node-children _)
+              (list-queue-list _))))
+      (test-equal "first paragraph"
+                  (xstring->string (list-ref children 0))
+                  "hello\n")
+      (test-equal "second paragraph"
+                  (xstring->string (list-ref children 1))
+                  "world\n"))))
+
+(test-group "block quotes"
+  (test-group "single line"
+    (let ((block (chain (parse->document "> hello, world" #f)
+                        (node-children _)
+                        (list-queue-list _)
+                        (list-ref _ 0))))
+      (test-assert "block-quote?" (block-quote? block))
+      (let ((str (chain (node-children block)
+                        (list-queue-list _)
+                        (list-ref _ 0)
+                        (xstring->string _))))
+        (test-equal "string" str "hello, world\n"))))
+  (let ((str (chain (parse->document "> hello," #f)
+                    (parse->document "> world" _)
+                    (node-children _)
+                    (list-queue-list _)
+                    (list-ref _ 0)
+                    (node-children _)
+                    (list-queue-list _)
+                    (list-ref _ 0)
+                    (xstring->string _))))
+    (test-equal "two lines" str "hello,\nworld\n"))
+  (test-group "multiple paragraphs"
+    (let ((lst (chain (parse->document "> hello" #f)
+                      (parse->document "> " _)
+                      (parse->document "> world" _)
+                      (node-children _)
+                      (list-queue-list _)
+                      (list-ref _ 0)
+                      (node-children _)
+                      (list-queue-list _))))
+      (test-equal "first paragraph"
+                  (xstring->string (list-ref lst 0))
+                  "hello\n")
+      (test-equal "second paragraph"
+                  (xstring->string (list-ref lst 1))
+                  "world\n")))
+  (test-group "interrupted"
+    (let ((lst (chain (parse->document "> hello, world" #f)
+                      (parse->document "outside of a block quote" _)
+                      (node-children _)
+                      (list-queue-list _))))
+      (test-assert "first is block quote"
+                   (block-node? (list-ref lst 0)))
+      (let ((quote-paragraph (chain (list-ref lst 0)
+                                    (node-children _)
+                                    (list-queue-list _)
+                                    (list-ref _ 0)
+                                    (xstring->string _))))
+        (test-equal "block quote paragraph"
+                    "hello, world\n"
+                    quote-paragraph))
+      (test-assert "second is paragraph"
+                   (xstring? (list-ref lst 1)))
+      (test-equal "second paragraph"
+                  "outside of a block quote\n"
+                  (xstring->string (list-ref lst 1)))))
+  (test-group "two nested with spaces"
+    (define block
+      (chain (parse->document "> > hello, world" #f)
+             (parse->document "> > continuing nested" _)
+             (parse->document "> outside of the block quote" _)
+             (node-children _)
+             (list-queue-list _)
+             (list-ref _ 0)))
+    (test-assert "first block quote"
+                 (block-quote? block))
+    (test-equal "first block quote second paragraph"
+                "outside of the block quote\n"
+                (chain (node-children block)
+                       (list-queue-list _)
+                       (list-ref _ 1)
+                       (xstring->string _)))
+    (set! block
+          (chain (node-children block)
+                 (list-queue-list _)
+                 (list-ref _ 0)))
+    (test-assert "second block quote" (block-quote? block))
+    (test-equal "second block quote paragraph"
+                "hello, world\ncontinuing nested\n"
+                (chain (node-children block)
+                       (list-queue-list _)
+                       (list-ref _ 0)
+                       (xstring->string _)))))