literate: add org sources for orphan test files, update README
- Create org/integration-tests.org (15 blocks, per-test prose) - Add Markdown tests section to org/markdown-renderer.org (11 test blocks) - Delete deprecated src/components/input-tests.lisp stub - Update README.org: tree diagram, literate programming section, development commands, remove stale test counts All 13 test suites pass at 100%. Zero .lisp files without org origin.
This commit is contained in:
Hermes Agent
@@ -1061,3 +1061,390 @@ Returns an empty string for ~nil~ input.
|
||||
for first = t then nil
|
||||
do (unless first (terpri s)) (princ part s)))))
|
||||
#+END_SRC
|
||||
|
||||
* Tests
|
||||
|
||||
The test suite covers parser edge cases, heading/paragraph parsing, inline
|
||||
formatting (bold, italic, code, links), code blocks, blockquotes, lists,
|
||||
diff classification, syntax highlighting, render output, and integration.
|
||||
|
||||
The first block writes the target file (defpackage/suite). Subsequent blocks
|
||||
append individual test groups.
|
||||
|
||||
** Package and suite setup
|
||||
|
||||
This block must be first because ~tests/markdown-tests.lisp~ does not
|
||||
exist yet — the tangle script creates it by writing this block's content.
|
||||
All later blocks append.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
;;; markdown-tests.lisp — Tests for cl-tty.markdown
|
||||
|
||||
(defpackage :cl-tty-markdown-test
|
||||
(:use :cl :cl-tty.markdown :fiveam))
|
||||
|
||||
(in-package :cl-tty-markdown-test)
|
||||
|
||||
;; Test suite
|
||||
(def-suite :cl-tty-markdown-test
|
||||
:description "Markdown parser/renderer tests for cl-tty.markdown")
|
||||
|
||||
(in-suite :cl-tty-markdown-test)
|
||||
#+END_SRC
|
||||
|
||||
** Parser edge cases
|
||||
|
||||
Edge cases guard against crashes on ~nil~ input, very long lines, blank-only
|
||||
input, and unclosed fenced blocks. These come first because they exercise the
|
||||
defensive gate checks at the top of each parsing function.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
|
||||
;; ─── Parser edge cases ─────────────────────────────────────────
|
||||
|
||||
(def-test render-markdown-nil ( )
|
||||
"render-markdown handles nil gracefully."
|
||||
(is (string= "" (render-markdown nil))))
|
||||
|
||||
(def-test render-markdown-empty ( )
|
||||
"render-markdown handles empty string."
|
||||
(let ((result (render-markdown "")))
|
||||
(is (stringp result))
|
||||
(is (string= "" result))))
|
||||
|
||||
(def-test parse-blocks-nil ( )
|
||||
"parse-blocks handles nil gracefully."
|
||||
(is-false (parse-blocks nil)))
|
||||
|
||||
(def-test split-string-into-lines-nil ( )
|
||||
"parse-blocks handles nil input (tests internal split-string-into-lines)."
|
||||
(is-false (parse-blocks nil)))
|
||||
|
||||
(def-test nested-bold-inside-italic ( )
|
||||
"Nested formatting: bold inside italic."
|
||||
(let ((children (parse-inline "***hello*** world")))
|
||||
(is (= 3 (length children)))
|
||||
(let ((first-node (first children)))
|
||||
(is-true (eql :bold (getf first-node :type))))))
|
||||
|
||||
(def-test nested-italic-inside-bold ( )
|
||||
"Nested formatting: italic inside bold."
|
||||
(let ((children (parse-inline "**bold *italic* bold**")))
|
||||
(is (= 1 (length children)))
|
||||
(let ((bold (first children)))
|
||||
(is-true (eql :bold (getf bold :type)))
|
||||
(let ((inner (getf bold :children)))
|
||||
(is (= 3 (length inner)))
|
||||
(is-true (eql :italic (getf (second inner) :type)))))))
|
||||
|
||||
(def-test inline-code-inside-bold ( )
|
||||
"Code inside bold."
|
||||
(let ((children (parse-inline "**bold `code` bold**")))
|
||||
(is (= 1 (length children)))
|
||||
(let ((bold (first children)))
|
||||
(is-true (eql :bold (getf bold :type)))
|
||||
(let ((inner (getf bold :children)))
|
||||
(is (= 3 (length inner)))
|
||||
(is-true (eql :inline-code (getf (second inner) :type)))))))
|
||||
|
||||
(def-test unclosed-code-block ( )
|
||||
"Unclosed code block accumulates remaining lines as content."
|
||||
(let* ((lines '("```lisp" "(defun foo ())" " (bar)"))
|
||||
(text (format nil "~{~a~%~}" lines))
|
||||
(result (parse-blocks text))
|
||||
(node (first result)))
|
||||
(is-true (eql :code-block (getf node :type)))
|
||||
(is (equal "lisp" (getf (getf node :properties) :language)))
|
||||
(is-true (search "bar" (getf node :content)))))
|
||||
|
||||
(def-test code-block-no-language ( )
|
||||
"Code block with no language is still parsed."
|
||||
(let* ((lines '("```" "plain" "```"))
|
||||
(text (format nil "~{~a~%~}" lines))
|
||||
(result (parse-blocks text))
|
||||
(node (first result)))
|
||||
(is-true (eql :code-block (getf node :type)))
|
||||
(is-false (getf (getf node :properties) :language))))
|
||||
|
||||
(def-test markdown-very-long-line ( )
|
||||
"A very long paragraph line does not cause issues."
|
||||
(let* ((long-line (make-string 500 :initial-element #\x))
|
||||
(result (render-markdown long-line)))
|
||||
(is (stringp result))
|
||||
(is-true (> (length result) 0))))
|
||||
|
||||
(def-test markdown-only-blank ( )
|
||||
"Only blank lines produce empty output."
|
||||
(is (string= "" (render-markdown (format nil "~%~%")))))
|
||||
#+END_SRC
|
||||
|
||||
** Heading parsing
|
||||
|
||||
ATX headings from level 1 through 6, including headings with inline
|
||||
formatting inside the heading text.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
|
||||
;; ─── Parser tests ─────────────────────────────────────────────────────────────
|
||||
|
||||
(def-test heading-parsing ( )
|
||||
(let* ((result (parse-blocks "# Hello World")) (node (first result)))
|
||||
(is-true (eql :heading (getf node :type)))
|
||||
(is (= 1 (getf (getf node :properties) :level)))))
|
||||
|
||||
(def-test heading-levels ( )
|
||||
(loop for level from 1 to 6
|
||||
do (let* ((hashes (make-string level :initial-element #\#))
|
||||
(text (format nil "~a Heading ~d" hashes level))
|
||||
(result (parse-blocks text))
|
||||
(node (first result)))
|
||||
(is-true (eql :heading (getf node :type)))
|
||||
(is (= level (getf (getf node :properties) :level))))))
|
||||
|
||||
(def-test heading-with-inline-formatting ( )
|
||||
(let* ((result (parse-blocks "# Hello **World**"))
|
||||
(node (first result)) (children (getf node :children)))
|
||||
(is-true (eql :heading (getf node :type)))
|
||||
(is (= 2 (length children)))
|
||||
(is-true (eql :text (getf (first children) :type)))
|
||||
(is-true (eql :bold (getf (second children) :type)))))
|
||||
#+END_SRC
|
||||
|
||||
** Paragraph parsing
|
||||
|
||||
Single-line and multi-line paragraphs. Multi-line paragraphs are joined
|
||||
with spaces before inline parsing.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
|
||||
(def-test paragraph-parsing ( )
|
||||
(let* ((result (parse-blocks "This is a paragraph.")) (node (first result)))
|
||||
(is-true (eql :paragraph (getf node :type)))))
|
||||
|
||||
(def-test paragraph-multi-line ( )
|
||||
(let* ((result (parse-blocks "Line one\nLine two")) (node (first result)))
|
||||
(is-true (eql :paragraph (getf node :type)))))
|
||||
#+END_SRC
|
||||
|
||||
** Inline formatting
|
||||
|
||||
Bold, italic, combined bold+italic, inline code, and link parsing. Each
|
||||
test verifies both structure (node types) and content (text/url values).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
|
||||
(def-test bold-parsing ( )
|
||||
(let* ((children (parse-inline "hello **world** here"))
|
||||
(bold-node (second children)))
|
||||
(is (= 3 (length children)))
|
||||
(is-true (eql :bold (getf bold-node :type)))))
|
||||
|
||||
(def-test italic-parsing ( )
|
||||
(let* ((children (parse-inline "hello *world* here"))
|
||||
(italic-node (second children)))
|
||||
(is (= 3 (length children)))
|
||||
(is-true (eql :italic (getf italic-node :type)))))
|
||||
|
||||
(def-test bold-italic-combined ( )
|
||||
(let ((children (parse-inline "**bold** and *italic*")))
|
||||
(is (= 3 (length children)))
|
||||
(is-true (eql :bold (getf (first children) :type)))
|
||||
(is-true (eql :italic (getf (third children) :type)))))
|
||||
|
||||
(def-test inline-code-parsing ( )
|
||||
(let* ((children (parse-inline "use `foo` here"))
|
||||
(code-node (second children)))
|
||||
(is (= 3 (length children)))
|
||||
(is-true (eql :inline-code (getf code-node :type)))
|
||||
(is (equal "foo" (getf code-node :content)))))
|
||||
|
||||
(def-test link-parsing ( )
|
||||
(let* ((children (parse-inline "click [here](https://x.com)"))
|
||||
(link-node (second children)))
|
||||
(is (= 2 (length children)))
|
||||
(is-true (eql :link (getf link-node :type)))
|
||||
(is (equal "https://x.com" (getf link-node :url)))
|
||||
(let ((link-text (getf link-node :children)))
|
||||
(is (= 1 (length link-text)))
|
||||
(is-true (eql :text (getf (first link-text) :type)))
|
||||
(is (equal "here" (getf (first link-text) :content))))))
|
||||
#+END_SRC
|
||||
|
||||
** Code block parsing
|
||||
|
||||
Fenced code blocks with and without a language annotation. Verifies the
|
||||
presence/absence of the ~:language~ property on the resulting node.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
|
||||
(def-test code-block-parsing ( )
|
||||
(let* ((lines '("```lisp" "(defun hello ())" " (print \"hi\")" "```"))
|
||||
(text (format nil "~{~a~%~}" lines))
|
||||
(result (parse-blocks text)) (node (first result)))
|
||||
(is-true (eql :code-block (getf node :type)))
|
||||
(is (equal "lisp" (getf (getf node :properties) :language)))
|
||||
(is-true (search "(defun hello" (getf node :content)))))
|
||||
|
||||
(def-test code-block-unknown-language ( )
|
||||
(let* ((lines '("```" "plain code" "```"))
|
||||
(text (format nil "~{~a~%~}" lines))
|
||||
(result (parse-blocks text)) (node (first result)))
|
||||
(is-true (eql :code-block (getf node :type)))
|
||||
(is-false (getf (getf node :properties) :language))))
|
||||
#+END_SRC
|
||||
|
||||
** Blockquote, list, and thematic-break parsing
|
||||
|
||||
Verifies that blockquote markers, unordered list items, ordered list
|
||||
items, and thematic breaks (---) are correctly classified and produce
|
||||
the expected node types.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
|
||||
(def-test blockquote-parsing ( )
|
||||
(let* ((result (parse-blocks "> This is a quote")) (node (first result)))
|
||||
(is-true (eql :blockquote (getf node :type)))))
|
||||
|
||||
(def-test list-item-parsing ( )
|
||||
(let* ((result (parse-blocks "- First item")) (node (first result)))
|
||||
(is-true (eql :list-item (getf node :type)))))
|
||||
|
||||
(def-test ordered-list-parsing ( )
|
||||
(let* ((result (parse-blocks "1. First item")) (node (first result)))
|
||||
(is-true (eql :ordered-item (getf node :type)))))
|
||||
|
||||
(def-test thematic-break-parsing ( )
|
||||
(let* ((result (parse-blocks "---")) (node (first result)))
|
||||
(is-true (eql :thematic-break (getf node :type)))))
|
||||
#+END_SRC
|
||||
|
||||
** Diff line classification
|
||||
|
||||
Tests ~classify-diff-line~ with each diff line variant: added (+),
|
||||
removed (-), hunk header (@@), and context (neither).
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
|
||||
;; ─── Diff tests ───────────────────────────────────────────────────────────────
|
||||
|
||||
(def-test classify-diff-added ( )
|
||||
(is (eql :added (classify-diff-line "+this is added"))))
|
||||
|
||||
(def-test classify-diff-removed ( )
|
||||
(is (eql :removed (classify-diff-line "-this is removed"))))
|
||||
|
||||
(def-test classify-diff-hunk ( )
|
||||
(is (eql :hunk-header (classify-diff-line "@@ -1,3 +1,4 @@"))))
|
||||
|
||||
(def-test classify-diff-context ( )
|
||||
(is (eql :context (classify-diff-line " normal context"))))
|
||||
#+END_SRC
|
||||
|
||||
** Syntax highlighting
|
||||
|
||||
Verifies that ~highlight-code~ returns categorised tokens for Lisp
|
||||
keywords, builtins, comments, and falls back to plain tokens for
|
||||
unknown languages.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
|
||||
;; ─── Syntax highlighting tests ────────────────────────────────────────────────
|
||||
(def-test highlight-lisp-keyword ( )
|
||||
(let ((tokens (highlight-code "(defun hello ()" "lisp")))
|
||||
(is-true (some (lambda (pair) (and (search "defun" (car pair))
|
||||
(eql :keyword (cdr pair))))
|
||||
tokens))))
|
||||
|
||||
(def-test highlight-lisp-builtin ( )
|
||||
"Test that a Lisp builtin like nil is highlighted as :builtin."
|
||||
(let ((tokens (highlight-code "(if t nil)" "lisp")))
|
||||
(is-true (some (lambda (pair) (and (string= (car pair) "nil")
|
||||
(eql :builtin (cdr pair))))
|
||||
tokens))))
|
||||
|
||||
(def-test highlight-unknown-language ( )
|
||||
(let ((tokens (highlight-code "hello world" "unknown-xyz")))
|
||||
(every (lambda (pair) (eql :plain (cdr pair))) tokens)))
|
||||
|
||||
(def-test highlight-comment ( )
|
||||
(let ((tokens (highlight-code "; this is a comment" "lisp")))
|
||||
(is-true (some (lambda (pair) (eql :comment (cdr pair))) tokens))))
|
||||
#+END_SRC
|
||||
|
||||
** Render output
|
||||
|
||||
Verifies that each node type produces output via ~render-md-node~.
|
||||
Heading, paragraph, thematic-break, code-block, and diff-block are
|
||||
all exercised to ensure the render dispatcher routes correctly.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
|
||||
;; ─── Render tests ─────────────────────────────────────────────────────────────
|
||||
|
||||
(def-test render-heading-output ( )
|
||||
(let* ((node (make-md-node :heading :properties (list :level 2)
|
||||
:children (list (make-md-node :text :content "Test"))))
|
||||
(lines (render-md-node node)))
|
||||
(is (= 1 (length lines)))
|
||||
(is-true (> (length (first lines)) 0))))
|
||||
|
||||
(def-test render-paragraph-output ( )
|
||||
(let* ((node (make-md-node :paragraph
|
||||
:children (list (make-md-node :text :content "Hello"))))
|
||||
(lines (render-md-node node)))
|
||||
(is (= 1 (length lines)))
|
||||
(is-true (search "Hello" (first lines)))))
|
||||
|
||||
(def-test render-thematic-break-output ( )
|
||||
(let* ((node (make-md-node :thematic-break)) (lines (render-md-node node)))
|
||||
(is (= 1 (length lines)))))
|
||||
|
||||
(def-test render-code-block-output ( )
|
||||
(let* ((node (make-md-node :code-block :content "(print \"hello\")"
|
||||
:properties (list :language "lisp")))
|
||||
(lines (render-md-node node)))
|
||||
(is-true (> (length lines) 0))))
|
||||
|
||||
(def-test render-diff-block-output ( )
|
||||
(let* ((node (make-md-node :diff-block :properties
|
||||
(list :lines
|
||||
'("--- a/file" "+++ b/file" "@@ -1 +1 @@"
|
||||
"+added" "-removed" " context"))))
|
||||
(lines (render-md-node node)))
|
||||
(is (= 6 (length lines)))
|
||||
(is (search "added" (fourth lines)))
|
||||
(is (search "removed" (fifth lines)))))
|
||||
#+END_SRC
|
||||
|
||||
** Integration test and utilities
|
||||
|
||||
A full parse-and-render integration test exercises the pipeline end-to-end.
|
||||
The ~md-node-text~ utility tests verify both simple and nested node
|
||||
traversal.
|
||||
|
||||
#+BEGIN_SRC lisp :tangle ../tests/markdown-tests.lisp
|
||||
|
||||
;; ─── Integration tests ────────────────────────────────────────────────────────
|
||||
|
||||
(def-test markdown-integration ( )
|
||||
(let* ((md (format nil "# Title~%~%This is **bold** and `code`.~%~%- Item 1~%~%- Item 2~%~%> A quote~%~%```lisp~%(defun hello ())~% (print \"hi\")~%```~%~%---"))
|
||||
(nodes (parse-blocks md)) (lines (render-md nodes)))
|
||||
(is-true (> (length lines) 5))
|
||||
(is-true (search "# Title" (first lines)))))
|
||||
|
||||
(def-test render-markdown-string ( )
|
||||
(let ((result (render-markdown "**bold** text")))
|
||||
(is-true (stringp result))
|
||||
(is-true (> (length result) 0))))
|
||||
|
||||
(def-test md-node-text-simple ( )
|
||||
(let ((node (make-md-node :text :content "hello")))
|
||||
(is (equal "hello" (md-node-text node)))))
|
||||
|
||||
(def-test md-node-text-nested ( )
|
||||
(let ((node (make-md-node :paragraph :children
|
||||
(list (make-md-node :text :content "hello")
|
||||
(make-md-node :bold :children
|
||||
(list (make-md-node :text :content "world")))))))
|
||||
(is (equal "helloworld" (md-node-text node)))))
|
||||
#+END_SRC
|
||||
|
||||
Reference in New Issue
Block a user