;;; 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) ;; ─── 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 "~%~%"))))) ;; ─── 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))))) (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))))) (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)))))) (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)))) (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))))) ;; ─── 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")))) ;; ─── 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)))) ;; ─── 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))))) ;; ─── 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)))))