use pipeline operators to write more comprehensive tests

1 files changed, 371 insertions, 303 deletions

diff --git a/tests/run.scm b/tests/run.scm
index f140892..87ece52 100644
--- a/tests/run.scm
+++ b/tests/run.scm
@@ -27,317 +27,385 @@
 (test-runner-factory mcgoron-test-factory)
 (test-runner-current (test-runner-create))
 
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Chained test predicates
+;;; 
+;;; These apply a test to `value` and return `value` afterwards, so that
+;;; they can be chained in a `chain` expressions.
+
+(define (test-assert-then name actual-procedure value)
+  (test-assert name (actual-procedure value))
+  value)
+
+(define test-equal-then
+  (case-lambda
+    ((name expected actual)
+     (test-equal name expected actual)
+     actual)
+    ((name expected actual-procedure value)
+     (test-equal name expected (actual-procedure value))
+     value)))
+
+(define (test-length-then name expected lst)
+  (test-equal name expected (length lst))
+  lst)
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Wrappers for commonly used test operations on nodes
+;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define (test-parse->document . arguments)
+  (chain (apply parse->document arguments)
+         (test-assert-then "document-node?"
+                           document-node?
+                           _)))
+
+(define (test-node-list name expected node)
+  (chain (node-children node)
+         (test-assert-then "queue" list-queue? _)
+         (list-queue-list _)
+         (test-length-then name expected _)))
+
+(define (test-child name procedure num lst)
+  (chain (list-ref lst num)
+         (test-assert-then name procedure _)))
+
+(define (fork name arg procedure)
+  (test-group name
+    (procedure arg))
+  arg)
+
+(define-syntax with-test-chain
+  (syntax-rules ()
+    ((with-test-chain name chain-body ...)
+     (test-group name (chain chain-body ...)))))
+
+;;; ;;;;;;;;;;;;;;;;;;;;;;
+;;; Paragraphs
+;;; ;;;;;;;;;;;;;;;;;;;;;;;
+
 (test-group "paragraphs"
-  (let ((str
-         (chain (parse->document "hello, world")
-                (node-children _)
-                (list-queue-list _)
-                (list-ref _ 0)
-                (xstring->string _))))
-    (test-equal "single line" str "hello, world\n"))
-  (let ((str
-         (chain (parse->document "hello,")
-                (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")
-              (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"))))
+  (with-test-chain "single line"
+    (test-parse->document "hello, world")
+    (test-node-list "document children" 1 _)
+    (test-child "xstring" xstring? 0 _)
+    (xstring->string _)
+    (test-assert-then "string?" string? _)
+    (test-equal-then "text"
+                     "hello, world\n"
+                     _))
+  (with-test-chain "two lines"
+    (test-parse->document "hello,")
+    (test-parse->document "world" _)
+    (test-node-list "document children" 1 _)
+    (test-child "xstring" xstring? 0 _)
+    (xstring->string _)
+    (test-equal-then "text"
+                     "hello,\nworld\n"
+                     _))
+  (with-test-chain "two paragraphs"
+    (test-parse->document "hello")
+    (test-parse->document "" _)
+    (test-parse->document "world" _)
+    (test-node-list "document children" 2 _)
+    (fork "first"
+          _
+          (chain-lambda (test-child "first paragraph xstring?"
+                                    xstring?
+                                    0
+                                    _)
+                        (xstring->string _)
+                        (test-equal-then "first paragraph"
+                                         "hello\n"
+                                         _)))
+    (fork "second"
+          _
+          (chain-lambda (test-child "second paragraph xstring?"
+                                    xstring?
+                                    1
+                                    _)
+                        (xstring->string _)
+                        (test-equal-then "first paragraph"
+                                         "world\n"
+                                         _)))))
 
 (test-group "block quotes"
-  (test-group "single line"
-    (let ((block (chain (parse->document "> hello, world")
-                        (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,")
-                    (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 in block quote"
-    (let ((lst (chain (parse->document "> hello")
-                      (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 by paragraph break"
-    (let ((lst (chain (parse->document "> hello,")
-                      (parse->document "" _)
-                      (parse->document "world" _)
-                      (node-children _)
-                      (list-queue-list _))))
-      (test-assert "first is block quote" (block-quote? (list-ref lst 0)))
-      (let ((quote-par (chain (list-ref lst 0)
-                              (node-children _)
-                              (list-queue-list _)
-                              (list-ref _ 0)
-                              (xstring->string _))))
-        (test-equal "quote text" "hello,\n" quote-par))
-      (let ((text (chain (list-ref lst 1)
-                         (xstring->string _))))
-        (test-equal "paragraph text" "world\n" text))))
-  (test-group "interrupted"
-    (let ((lst (chain (parse->document "> hello, world")
-                      (parse->document "outside of a block quote" _)
-                      (node-children _)
-                      (list-queue-list _))))
-      (test-assert "first is block quote"
-                   (block-quote? (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")
-             (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 _))))
-  (test-group "two nested without spaces"
-    (define block
-      (chain (parse->document ">> hello, world")
-             (parse->document ">> continuing nested" _)
-             (parse->document "> at first level" _)
-             (parse->document "> continuing first level" _)
-             (node-children _)
-             (list-queue-list _)
-             (list-ref _ 0)))
-    (test-assert "first block quote" (block-quote? block))
-    (test-equal "first block quote paragraph"
-                "at first level\ncontinuing first level\n"
-                (chain (node-children block)
-                       (list-queue-list _)
-                       (list-ref _ 1)
-                       (xstring->string _)))
-    (define nested-str (chain (node-children block)
-                              (list-queue-list _)
-                              (list-ref _ 0)
-                              (node-children _)
-                              (list-queue-list _)
-                              (list-ref _ 0)
-                              (xstring->string _)))
-    (test-equal "nested block quote paragraph"
-                "hello, world\ncontinuing nested\n"
-                nested-str)))
+  (with-test-chain "single line"
+    (test-parse->document "> hello, world")
+    (test-node-list "document node" 1 _)
+    (test-child "block-quote?" block-quote? 0 _)
+    (test-node-list "block children" 1 _)
+    (test-child "xstring?" xstring? 0 _)
+    (xstring->string _)
+    (test-equal-then "text"
+                     "hello, world\n"
+                     _))
+  (with-test-chain "two lines"
+    (test-parse->document "> hello,")
+    (test-parse->document "> world" _)
+    (test-node-list "document node" 1 _)
+    (test-child "block-quote?" block-quote? 0 _)
+    (test-node-list "quote children" 1 _)
+    (test-child "xstring?" xstring? 0 _)
+    (xstring->string _)
+    (test-equal-then "text"
+                     "hello,\nworld\n"
+                     _))
+  (with-test-chain "multiple paragraphs in block quote"
+    (test-parse->document "> hello")
+    (test-parse->document "> " _)
+    (test-parse->document "> world" _)
+    (test-node-list "document node" 1 _)
+    (test-child "block-quote?" block-quote? 0 _)
+    (test-node-list "quote node" 2 _)
+    (fork
+     "first"
+     _
+     (chain-lambda (test-child "first paragraph xstring?"
+                               xstring?
+                               0
+                               _)
+                   (xstring->string _)
+                   (test-equal-then "first paragraph"
+                                    "hello\n"
+                                    _)))
+    (fork
+     "second"
+     _
+     (chain-lambda (test-child "second paragraph xstring?"
+                               xstring?
+                               1
+                               _)
+                   (xstring->string _)
+                   (test-equal-then "second paragraph"
+                                    "world\n"
+                                    _))))
+  (with-test-chain "interrupted by paragraph break"
+    (test-parse->document "> hello,")
+    (test-parse->document "" _)
+    (test-parse->document "world" _)
+    (test-node-list "document node" 2 _)
+    (fork
+     "block quote"
+     _
+     (chain-lambda (test-child "block-quote?" block-quote? 0 _)
+                   (test-node-list "quote children" 1 _)
+                   (test-child "quote xstring?" xstring? 0 _)
+                   (xstring->string _)
+                   (test-equal-then "quote text"
+                                    "hello,\n"
+                                    _)))
+    (fork
+     "paragraph"
+     _
+     (chain-lambda (test-child "paragraph xstring?" xstring? 1 _)
+                   (xstring->string _)
+                   (test-equal-then "paragraph text"
+                                    "world\n"
+                                    _))))
+  (with-test-chain "interrupted"
+    (test-parse->document "> hello, world")
+    (test-parse->document "outside of a block quote" _)
+    (test-node-list "document children" 2 _)
+    (fork
+     "block quote"
+     _
+     (chain-lambda (test-child "block-quote?" block-quote? 0 _)
+                   (test-node-list "quote children" 1 _)
+                   (test-child "quote xstring?" xstring? 0 _)
+                   (xstring->string _)
+                   (test-equal-then "quote text"
+                                    "hello, world\n"
+                                    _)))
+    (fork
+     "paragraph"
+     _
+     (chain-lambda (test-child "paragraph xstring?" xstring? 1 _)
+                   (xstring->string _)
+                   (test-equal-then "paragraph text"
+                                    "outside of a block quote\n"
+                                    _))))
+  (with-test-chain "two nested with spaces"
+    (test-parse->document "> > hello, world")
+    (test-parse->document "> > continuing nested" _)
+    (test-parse->document "> outside of the block quote" _)
+    (test-node-list "document children" 1 _)
+    (test-child "top block-quote?" block-quote? 0 _)
+    (test-node-list "top block quote children" 2 _)
+    (fork
+     "nested quote"
+     _
+     (chain-lambda (test-child "nested quote" block-quote? 0 _)
+                   (test-node-list "nested quote children" 1 _)
+                   (test-child "xstring?" xstring? 0 _)
+                   (xstring->string _)
+                   (test-equal-then "nested quote text"
+                                    "hello, world\ncontinuing nested\n"
+                                    _)))
+    (fork
+     "inside quote"
+     _
+     (chain-lambda (test-child "paragraph in quote" xstring? 1 _)
+                   (xstring->string _)
+                   (test-equal-then "nested quote text"
+                                    "outside of the block quote\n"
+                                    _))))
+  (with-test-chain "two nested without spaces"
+    (test-parse->document ">> hello, world")
+    (test-parse->document ">> continuing nested" _)
+    (test-parse->document "> at first level" _)
+    (test-parse->document "> continuing first level" _)
+    (test-node-list "document children" 1 _)
+    (test-child "block-quote?" block-quote? 0 _)
+    (test-node-list "block quote children" 2 _)
+    (fork
+     "nested block quote"
+     _
+     (chain-lambda (test-child "nested block quote" block-quote? 0 _)
+                   (test-node-list "nested block quote children" 1 _)
+                   (test-child "xstring?" xstring? 0 _)
+                   (xstring->string _)
+                   (test-equal-then "nested block quote text"
+                                    "hello, world\ncontinuing nested\n"
+                                    _)))
+    (fork
+     "first level xstring"
+     _
+     (chain-lambda (test-child "first level xstring?" xstring? 1 _)
+                   (xstring->string _)
+                   (test-equal-then "first level block quote text"
+                                    "at first level\n continuing first level\n"
+                                    _)))))
 
 (test-group "atx headings"
-  (test-group "heading 1"
-    (let ((heading (chain (parse->document "# hello")
-                          (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")
-                          (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, ")
-                           (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")
-                           (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 _)))))))
+  (with-test-chain "heading 1"
+    (test-parse->document "# hello")
+    (test-node-list "document children" 1 _)
+    (test-child "atx-heading?" atx-heading? 0 _)
+    (test-equal-then "indent"
+                     1
+                     atx-heading-indent
+                     _)
+    (test-node-list "heading children" 1 _)
+    (test-child "xstring?" xstring? 0 _)
+    (xstring->string _)
+    (test-equal-then "text" "hello" _))
+  (with-test-chain "heading 6"
+    (test-parse->document "###### hello")
+    (test-node-list "document children" 1 _)
+    (test-child "atx-heading?" atx-heading? 0 _)
+    (test-equal-then "indent" 6 atx-heading-indent _)
+    (test-node-list "heading children" 1 _)
+    (test-child "xstring?" xstring? 0 _)
+    (xstring->string _)
+    (test-equal-then "text" "hello" _))
+  (with-test-chain "heading followed by paragraph"
+    (test-parse->document "## hello, ")
+    (test-parse->document "world" _)
+    (test-parse->document "## another heading" _)
+    (test-node-list "document children" 3 _)
+    (fork
+     "atx heading 1"
+     _
+     (chain-lambda (test-child "atx-heading?" atx-heading? 0 _)
+                   (test-equal-then "indent" 2 atx-heading-indent _)
+                   (test-node-list "children" 1 _)
+                   (test-child "xstring?" xstring? 0 _)
+                   (xstring->string _)
+                   (test-equal-then "text" "hello, " _)))
+    (fork
+     "paragraph"
+     _
+     (chain-lambda (test-child "xstring?" xstring? 1 _)
+                   (xstring->string _)
+                   (test-equal-then "text" "world\n" _)))
+    (fork
+     "atx heading 2"
+     _
+     (chain-lambda (test-child "atx-heading?" atx-heading? 2 _)
+                   (test-equal-then "indent" 2 atx-heading-indent _)
+                   (test-node-list "children" 1 _)
+                   (test-child "xstring?" xstring? 0 _)
+                   (xstring->string _)
+                   (test-equal-then "text" "another heading" _))))
+  (with-test-chain "heading inside block quote"
+    (test-parse->document "> # nested heading")
+    (test-parse->document "> text inside quote" _)
+    (test-parse->document "### outside of quote" _)
+    (test-node-list "document children" 2 _)
+    (fork
+     "block quote"
+     _
+     (chain-lambda (test-child "block-quote?" block-quote? 0 _)
+                   (test-node-list "block quote children" 2 _)
+                   (fork
+                    "atx heading"
+                    _
+                    (chain-lambda (test-child "atx-heading?" atx-heading? 0 _)
+                                  (test-equal-then "indent" 1 atx-heading-indent _)
+                                  (test-node-list "children" 1 _)
+                                  (test-child "xstring?" xstring? 0 _)
+                                  (xstring->string _)
+                                  (test-equal-then "text" "nested heading" _)))
+                   (fork
+                    "paragraph"
+                    _
+                    (chain-lambda (test-child "xstring?" xstring? 1 _)
+                                  (xstring->string _)
+                                  (test-equal-then "text" "text inside quote\n" _)))))
+    (fork
+     "heading outside of quote"
+     _
+     (chain-lambda (test-child "atx-heading?" atx-heading? 1 _)
+                   (test-equal-then "indent" 3 atx-heading-indent _)
+                   (test-node-list "children" 1 _)
+                   (test-child "xstring?" xstring? 0 _)
+                   (xstring->string _)
+                   (test-equal-then "text" "outside of quote" _)))))
 
-(test-group "code blocks"
-  (test-group "single line, 4 spaces"
-    (let ((block (chain (parse->document "    (procedure? call/cc)")
-                        (node-children _)
-                        (list-queue-list _)
-                        (list-ref _ 0))))
-      (test-assert "code-block?" (code-block? block))
-      (test-equal "text"
-                  "(procedure? call/cc)\n"
-                  (chain (node-children block)
-                         (list-queue-list _)
-                         (list-ref _ 0)
-                         (xstring->string _)))))
-  (test-group "single line, tab"
-    (let ((block (chain (parse->document "\t(procedure? call/cc)")
-                        (node-children _)
-                        (list-queue-list _)
-                        (list-ref _ 0))))
-      (test-assert "code-block?" (code-block? block))
-      (test-equal "text"
-                  "(procedure? call/cc)\n"
-                  (chain (node-children block)
-                         (list-queue-list _)
-                         (list-ref _ 0)
-                         (xstring->string _)))))
-  (test-group "multiple lines, mixing"
-    (let ((str (chain (parse->document "    (lambda (x)")
-                      (parse->document "\t  x)" _)
-                      (node-children _)
-                      (list-queue-list _)
-                      (list-ref _ 0)
-                      (node-children _)
-                      (list-queue-list _)
-                      (list-ref _ 0)
-                      (xstring->string _))))
-      (test-equal "text"
-                  "(lambda (x)\n  x)\n"
-                  str)))
-  (test-group "no quotes in code blocks"
-    (let ((first-child (chain (parse->document "    > not a block")
-                              (node-children _)
-                              (list-queue-list _)
-                              (list-ref _ 0)
-                              (node-children _)
-                              (list-queue-list _)
-                              (list-ref _ 0))))
-      (test-assert "xstring" (xstring? first-child))
-      (test-equal "text"
-                  "> not a block\n"
-                  (xstring->string first-child))))
-  (test-group "code block in quotes"
-    (let ((node (chain (parse->document ">     quoted code")
-                       (node-children _)
-                       (list-queue-list _)
-                       (list-ref _ 0))))
-      (test-assert "block-quote?" (block-quote? node))
-      (set! node (chain (node-children node)
-                        (list-queue-list _)
-                        (list-ref _ 0)))
-      (test-assert "code-block?" (code-block? node))
-      (set! text (chain (node-children node)
-                        (list-queue-list _)
-                        (list-ref _ 0)
-                        (xstring->string _)))
-      (test-equal "text"
-                  "quoted code\n"
-                  text))))
+;;; TODO: test of line break in code block
 
-;;; TODO: check number of children of each node.
+(test-group "code blocks"
+  (define (test/string name prepend)
+    (with-test-chain name
+      (test-parse->document (string-append prepend "(procedure? call/cc)"))
+      (test-node-list "document children" 1 _)
+      (test-child "code-block?" code-block? 0 _)
+      (test-node-list "block children" 1 _)
+      (test-child "xstring?" xstring? 0 _)
+      (xstring->string _)
+      (test-equal-then "text" "(procedure? call/cc)" _)))
+  (test/string "single line, 4 spaces" "    ")
+  (test/string "single line, tab" "\t")
+  (with-test-chain "multiple lines, mixing"
+    (test-parse->document "    (lambda (x)")
+    (test-parse->document "\t  x)" _)
+    (test-node-list "document children" 1 _)
+    (test-child "code-block?" code-block? 0 _)
+    (test-node-list "block children" 1 _)
+    (test-child "xstring?" xstring? 0 _)
+    (xstring->string _)
+    (test-equal-then "text" "(lambda (x)\n  x)" _))
+  (with-test-chain "no quotes in code blocks"
+    (test-parse->document "    > not a block")
+    (test-node-list "document children" 1 _)
+    (test-child "code-block?" code-block? 0 _)
+    (test-node-list "block children" 1 _)
+    (test-child "xstring?" xstring? 0 _)
+    (xstring->string _)
+    (test-equal-then "text" "    > not a block" _))
+  (with-test-chain "code block in quotes"
+    (test-parse->document ">     quoted code")
+    (test-node-list "document children" 1 _)
+    (test-child "block-quote?" block-quote? 0 _)
+    (test-node-list "quote children" 1 _)
+    (test-child "code-block?" code-block? 0 _)
+    (test-node-list "code block children" 1 _)
+    (test-child "xstring?" xstring? 0 _)
+    (xstring->string _)
+    (test-equal-then "text" "quoted code\n" _)))
 
-(test-group "unordered lists"
+#;(test-group "unordered lists"
   (test-group "one element"
     (let ((lst (chain (parse->document "* hello, world")
                       (node-children _)