partial suppor for ATX headings

1 files changed, 83 insertions, 0 deletions

diff --git a/tests/run.scm b/tests/run.scm
index bc67ab6..d44abb8 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -167,3 +167,86 @@
     (test-equal "nested block quote paragraph"
                 "hello, world\ncontinuing nested\n"
                 nested-str)))
+
+(test-group "atx headings"
+  (test-group "heading 1"
+    (let ((heading (chain (parse->document "# hello" #f)
+                          (node-children _)
+                          (list-queue-list _)
+                          (list-ref _ 0))))
+      (test-assert "atx-heading?" (atx-heading? heading))
+      (test-equal "indent" 1 (atx-heading-indent heading))
+      (test-equal "text" "hello" (chain (node-children heading)
+                                        (list-queue-list _)
+                                        (list-ref _ 0)
+                                        (xstring->string _)))))
+  (test-group "heading 6"
+    (let ((heading (chain (parse->document "###### hello" #f)
+                          (node-children _)
+                          (list-queue-list _)
+                          (list-ref _ 0))))
+      (test-assert "atx-heading?" (atx-heading? heading))
+      (test-equal "indent" 6 (atx-heading-indent heading))
+      (test-equal "text" "hello" (chain (node-children heading)
+                                        (list-queue-list _)
+                                        (list-ref _ 0)
+                                        (xstring->string _)))))
+  (test-group "heading followed by paragraph"
+    (let ((children (chain (parse->document "## hello, " #f)
+                           (parse->document "world" _)
+                           (parse->document "## another heading" _)
+                           (node-children _)
+                           (list-queue-list _))))
+      (test-group "atx heading 1"
+        (define heading (list-ref children 0))
+        (test-equal "indent" 2 (atx-heading-indent heading))
+        (define text (chain (node-children heading)
+                            (list-queue-list _)
+                            (list-ref _ 0)
+                            (xstring->string _)))
+        (test-equal "text" "hello, " text))
+      (test-group "paragraph"
+        (define text (chain (list-ref children 1)
+                            (xstring->string _)))
+        (test-equal "text" "world\n" text))
+      (test-group "atx heading 2"
+        (define heading (list-ref children 2))
+        (test-equal "indent" 2 (atx-heading-indent heading))
+        (define text (chain (node-children heading)
+                            (list-queue-list _)
+                            (list-ref _ 0)
+                            (xstring->string _)))
+        (test-equal "text" "another heading" text))))
+  (test-group "heading inside block quote"
+    (let ((children (chain (parse->document "> # nested heading" #f)
+                           (parse->document "> text inside quote" _)
+                           (parse->document "### outside of quote" _)
+                           (node-children _)
+                           (list-queue-list _))))
+      (test-group "block quote"
+        (define block-quote (list-ref children 0))
+        (test-assert "block-quote?" (block-quote? block-quote))
+        (let ((children (chain (node-children block-quote)
+                               (list-queue-list _))))
+          (test-group "atx heading"
+            (define heading (list-ref children 0))
+            (test-equal "indent" 1 (atx-heading-indent heading))
+            (test-equal "text" "nested heading"
+                        (chain (node-children heading)
+                               (list-queue-list _)
+                               (list-ref _ 0)
+                               (xstring->string _))))
+          (test-group "paragraph"
+            (define par (list-ref children 1))
+            (test-equal "text"
+                        "text inside quote\n"
+                        (xstring->string par)))))
+      (test-group "heading outside of quote"
+        (define heading (list-ref children 1))
+        (test-equal "indent" 3 (atx-heading-indent heading))
+        (test-equal "text"
+                    "outside of quote"
+                    (chain (node-children heading)
+                           (list-queue-list _)
+                           (list-ref _ 0)
+                           (xstring->string _)))))))