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
86
README.org
86
README.org
@@ -309,7 +309,7 @@ Result is cached in ~*detected-backend*~.
|
|||||||
* Development
|
* Development
|
||||||
|
|
||||||
#+BEGIN_SRC bash
|
#+BEGIN_SRC bash
|
||||||
# Run all tests (483 checks, 13 suites)
|
# Run all tests
|
||||||
sbcl --script run-all-tests.lisp
|
sbcl --script run-all-tests.lisp
|
||||||
|
|
||||||
# Run interactive demo
|
# Run interactive demo
|
||||||
@@ -317,13 +317,18 @@ sbcl --script demo.lisp
|
|||||||
|
|
||||||
# Tangle org files (regenerate .lisp from .org sources)
|
# Tangle org files (regenerate .lisp from .org sources)
|
||||||
python3 ~/.hermes/skills/software-development/org-babel-tangle/scripts/tangle.py org/*.org
|
python3 ~/.hermes/skills/software-development/org-babel-tangle/scripts/tangle.py org/*.org
|
||||||
|
|
||||||
|
# Verify syntax of all tangled files
|
||||||
|
for f in src/**/*.lisp tests/*.lisp; do
|
||||||
|
sbcl --eval "(with-open-file (s \"$f\") (loop for e = (read s nil s) until (eq e s)))" \
|
||||||
|
--eval "(format t \"~a: OK~%\" \"$f\")" --quit 2>/dev/null
|
||||||
|
done
|
||||||
#+END_SRC
|
#+END_SRC
|
||||||
|
|
||||||
Literate programming: ~.org~ files in ~org/~ are the source of truth for
|
Literate programming: every ~.lisp~ file in ~src/~ and ~tests/~ is a generated
|
||||||
the input system, scrollbox/tabbar, dialog, mouse, select, slot,
|
artifact from an ~.org~ file in ~org/~. The org files are the source of truth.
|
||||||
framebuffer, and markdown modules. The backend (~modern.lisp~,
|
Each function has its own code block with prose explaining the design reasoning.
|
||||||
~simple.lisp~) and basic components (~box.lisp~, ~text.lisp~, ~render.lisp~,
|
Delete every ~.lisp~ file and they can all be regenerated by tangling the org files.
|
||||||
~theme.lisp~, ~dirty.lisp~) are written directly.
|
|
||||||
|
|
||||||
Project structure:
|
Project structure:
|
||||||
|
|
||||||
@@ -332,46 +337,51 @@ cl-tty/
|
|||||||
├── cl-tty.asd # ASDF system definition
|
├── cl-tty.asd # ASDF system definition
|
||||||
├── demo.lisp # Interactive demo
|
├── demo.lisp # Interactive demo
|
||||||
├── run-all-tests.lisp # Test runner
|
├── run-all-tests.lisp # Test runner
|
||||||
├── src/backend/ # Backend protocol + implementations
|
|
||||||
│ ├── package.lisp
|
|
||||||
│ ├── classes.lisp # Generic definitions
|
|
||||||
│ ├── simple.lisp # ASCII fallback backend
|
|
||||||
│ ├── modern.lisp # Truecolor escape backend
|
|
||||||
│ └── detection.lisp # Auto-detect backend from env
|
|
||||||
├── src/layout/ # Flexbox layout engine
|
|
||||||
│ └── layout.lisp
|
|
||||||
├── src/
|
├── src/
|
||||||
│ ├── rendering/ # Framebuffer backend + diff + flush
|
│ ├── backend/ # Backend protocol + implementations
|
||||||
|
│ │ ├── package.lisp, classes.lisp
|
||||||
|
│ │ ├── simple.lisp, modern.lisp
|
||||||
|
│ │ └── detection.lisp
|
||||||
|
│ ├── layout/ # Flexbox layout engine
|
||||||
|
│ │ └── layout.lisp
|
||||||
|
│ ├── rendering/ # Framebuffer diffing pipeline
|
||||||
│ │ └── framebuffer.lisp
|
│ │ └── framebuffer.lisp
|
||||||
│ └── components/ # Widgets
|
│ └── components/ # Widget library
|
||||||
│ ├── box.lisp, text.lisp, render.lisp, theme.lisp
|
│ ├── package.lisp, dirty.lisp, render.lisp, theme.lisp
|
||||||
│ ├── dirty.lisp, input-package.lisp, input.lisp
|
│ ├── box.lisp, text.lisp
|
||||||
|
│ ├── input-package.lisp, input.lisp
|
||||||
│ ├── text-input.lisp, textarea.lisp, keybindings.lisp
|
│ ├── text-input.lisp, textarea.lisp, keybindings.lisp
|
||||||
│ ├── scrollbox.lisp, tabbar.lisp, container-package.lisp
|
│ ├── container-package.lisp, scrollbox.lisp, tabbar.lisp
|
||||||
│ ├── select.lisp, select-package.lisp
|
│ ├── select-package.lisp, select.lisp
|
||||||
│ ├── markdown.lisp, markdown-package.lisp
|
│ ├── markdown-package.lisp, markdown.lisp
|
||||||
│ ├── dialog.lisp, dialog-package.lisp
|
│ ├── dialog-package.lisp, dialog.lisp
|
||||||
│ ├── mouse.lisp, mouse-package.lisp
|
│ ├── mouse-package.lisp, mouse.lisp
|
||||||
│ └── slot.lisp, slot-package.lisp
|
│ └── slot-package.lisp, slot.lisp
|
||||||
├── tests/ # Test files
|
├── tests/ # FiveAM test files
|
||||||
├── org/ # Literate source files
|
│ ├── input-tests.lisp, scrollbox-tabbar-tests.lisp
|
||||||
|
│ ├── select-tests.lisp, markdown-tests.lisp
|
||||||
|
│ ├── dialog-tests.lisp, mouse-tests.lisp, slot-tests.lisp
|
||||||
|
│ ├── framebuffer-tests.lisp, integration-tests.lisp
|
||||||
|
│ ├── box-tests.lisp, dirty-tests.lisp, render-tests.lisp
|
||||||
|
│ └── theme-tests.lisp
|
||||||
|
├── org/ # Literate source (all .lisp files come from here)
|
||||||
|
│ ├── package.org, dirty.org, render.org, theme.org
|
||||||
|
│ ├── box-renderable.org
|
||||||
│ ├── text-input.org
|
│ ├── text-input.org
|
||||||
│ ├── scrollbox.org
|
│ ├── scrollbox.org, tabbar.org, container-package.org
|
||||||
│ ├── tabbar.org
|
│ ├── select.org
|
||||||
│ ├── container-package.org
|
│ ├── markdown-renderer.org
|
||||||
│ ├── dialog.org
|
│ ├── dialog.org
|
||||||
│ ├── mouse.org
|
│ ├── mouse.org
|
||||||
│ ├── select.org
|
|
||||||
│ ├── slot.org
|
│ ├── slot.org
|
||||||
|
│ ├── backend-protocol.org, modern-backend.org, detection.org
|
||||||
|
│ ├── layout-engine.org
|
||||||
│ ├── framebuffer.org
|
│ ├── framebuffer.org
|
||||||
│ ├── markdown-renderer.org
|
│ └── integration-tests.org
|
||||||
│ ├── detection.org
|
├── docs/
|
||||||
│ ├── modern-backend.org
|
│ ├── ROADMAP.org
|
||||||
│ ├── box-renderable.org
|
│ └── ARCHITECTURE.org
|
||||||
│ └── layout-engine.org
|
└── demo/ # Demo assets (optional)
|
||||||
└── docs/
|
|
||||||
├── ROADMAP.org # Versioned roadmap
|
|
||||||
└── ARCHITECTURE.org # Design docs
|
|
||||||
#+END_EXAMPLE
|
#+END_EXAMPLE
|
||||||
|
|
||||||
* License
|
* License
|
||||||
|
|||||||
471
org/integration-tests.org
Normal file
471
org/integration-tests.org
Normal file
@@ -0,0 +1,471 @@
|
|||||||
|
#+TITLE: Integration Tests for cl-tty
|
||||||
|
#+STARTUP: content
|
||||||
|
#+FILETAGS: :cl-tty:test:
|
||||||
|
|
||||||
|
* Overview
|
||||||
|
|
||||||
|
These integration tests compose all major cl-tty components through the
|
||||||
|
framebuffer backend and verify cell-level output. Instead of mocking
|
||||||
|
individual components, each test creates a real ~framebuffer-backend~,
|
||||||
|
plumbs components into it, and inspects the resulting cell grid.
|
||||||
|
|
||||||
|
This gives us confidence that:
|
||||||
|
|
||||||
|
- Components render the expected characters at the expected positions.
|
||||||
|
- Layout coordinates are applied correctly before rendering.
|
||||||
|
- Scroll offsets, cursor positions, dialog stacks, and toast messages
|
||||||
|
all compose correctly on a single framebuffer.
|
||||||
|
- The full ~render-screen~ pipeline works end-to-end.
|
||||||
|
|
||||||
|
The framebuffer backend uses ASCII box-drawing characters (+, -, |) so
|
||||||
|
tests remain portable across terminals.
|
||||||
|
|
||||||
|
** Test layout
|
||||||
|
|
||||||
|
The file is structured as:
|
||||||
|
|
||||||
|
1. Package definition, suite definition, and helper functions (first
|
||||||
|
block — overwrites target).
|
||||||
|
2. Individual test functions (each in its own block — appends target).
|
||||||
|
|
||||||
|
* Package and Suite
|
||||||
|
|
||||||
|
The integration tests live in their own package ~cl-tty-integration-test~
|
||||||
|
to avoid polluting the component namespaces. We use ~fiveam~ for the test
|
||||||
|
framework with ~def-suite~ and ~in-suite~ so all tests belong to
|
||||||
|
~integration-suite~.
|
||||||
|
|
||||||
|
The run-all-tests.lisp loader references this suite by name
|
||||||
|
(~\"INTEGRATION-SUITE\"~) and looks it up via ~find-symbol~ in the
|
||||||
|
package, so the symbol must be interned and accessible.
|
||||||
|
|
||||||
|
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||||
|
;;; integration-tests.lisp — Full pipeline integration tests for cl-tty
|
||||||
|
;;;
|
||||||
|
;;; Composes all major components through the rendering pipeline onto a
|
||||||
|
;;; framebuffer backend and verifies cell-level output.
|
||||||
|
;;;
|
||||||
|
;;; This file is tangled from org/integration-tests.org — do not edit directly.
|
||||||
|
|
||||||
|
(defpackage :cl-tty-integration-test
|
||||||
|
(:use :cl :fiveam
|
||||||
|
:cl-tty.backend :cl-tty.box :cl-tty.layout
|
||||||
|
:cl-tty.input :cl-tty.select :cl-tty.container
|
||||||
|
:cl-tty.rendering :cl-tty.dialog))
|
||||||
|
|
||||||
|
(in-package :cl-tty-integration-test)
|
||||||
|
|
||||||
|
(def-suite integration-suite
|
||||||
|
:description "Full pipeline integration tests for cl-tty")
|
||||||
|
|
||||||
|
(in-suite integration-suite)
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
* Helper Functions
|
||||||
|
|
||||||
|
These helpers extract and search text from the framebuffer cell grid.
|
||||||
|
They are shared by all tests and avoid duplicating cell-access logic.
|
||||||
|
|
||||||
|
** ~fb-string~
|
||||||
|
|
||||||
|
Reads a string of ~len~ characters from framebuffer ~fb~ starting at
|
||||||
|
coordinates ~(x, y)~. This is the primitive all other helpers build on.
|
||||||
|
|
||||||
|
The framebuffer stores cells in a 2D array indexed as ~(aref cells y x)~.
|
||||||
|
Cells are structs with a ~cell-char~ slot holding the character. We
|
||||||
|
iterate horizontally and collect each ~cell-char~ into a string.
|
||||||
|
|
||||||
|
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||||
|
(defun fb-string (fb x y &optional (len 1))
|
||||||
|
"Read a string of LEN characters from framebuffer FB starting at (X,Y)."
|
||||||
|
(let* ((cells (fb-framebuffer fb))
|
||||||
|
(w (framebuffer-width cells))
|
||||||
|
(h (framebuffer-height cells)))
|
||||||
|
(declare (ignore h))
|
||||||
|
(with-output-to-string (s)
|
||||||
|
(loop for i from 0 below len
|
||||||
|
for cx = (+ x i)
|
||||||
|
while (< cx w)
|
||||||
|
do (princ (cell-char (aref cells y cx)) s)))))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** ~fb-lines~
|
||||||
|
|
||||||
|
Extracts all rows from the framebuffer as a list of strings. Each row is
|
||||||
|
the full width of the framebuffer converted via ~fb-string~. Optional
|
||||||
|
~start-row~ and ~end-row~ keywords let callers inspect a sub-region.
|
||||||
|
|
||||||
|
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||||
|
(defun fb-lines (fb &key (start-row 0) (end-row nil))
|
||||||
|
"Extract all lines from framebuffer FB as a list of strings."
|
||||||
|
(let* ((cells (fb-framebuffer fb))
|
||||||
|
(w (framebuffer-width cells))
|
||||||
|
(h (framebuffer-height cells))
|
||||||
|
(max-row (min (or end-row h) h)))
|
||||||
|
(declare (ignore w))
|
||||||
|
(loop for y from start-row below max-row
|
||||||
|
collect (fb-string fb 0 y (framebuffer-width cells)))))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** ~fb-contains~
|
||||||
|
|
||||||
|
Returns ~T~ if the text content of the framebuffer contains ~text~
|
||||||
|
anywhere, using case-insensitive comparison. Concatenates all lines with
|
||||||
|
newlines and runs ~search~.
|
||||||
|
|
||||||
|
This is the most commonly used assertion helper — it lets tests check for
|
||||||
|
the presence of rendered text without specifying exact coordinates.
|
||||||
|
|
||||||
|
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||||
|
(defun fb-contains (fb text)
|
||||||
|
"Return T if framebuffer FB contains TEXT anywhere."
|
||||||
|
(let ((all-text (format nil "~{~a~^~%~}" (fb-lines fb))))
|
||||||
|
(search text all-text :test #'char-equal)))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
* Individual Tests
|
||||||
|
|
||||||
|
** Box with title renders correctly
|
||||||
|
|
||||||
|
A ~Box~ with a ~:single~ border style draws ASCII border characters
|
||||||
|
(+, -, |) and paints the title text at the top border. This test verifies
|
||||||
|
both the structural border characters and the title positioning.
|
||||||
|
|
||||||
|
The title is rendered starting at column 2 of row 1 (just inside the
|
||||||
|
top border). We check ~fb-string~ at those exact coordinates for the
|
||||||
|
title text, and ~fb-contains~ for the border characters.
|
||||||
|
|
||||||
|
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||||
|
(test box-title-renders-on-fb
|
||||||
|
"A Box with a title draws border and title text on framebuffer."
|
||||||
|
(let* ((fb (make-framebuffer-backend :width 40 :height 10))
|
||||||
|
(bx (make-box :border-style :single :title "My Box" :width 40 :height 10)))
|
||||||
|
(compute-layout (box-layout-node bx) 40 10)
|
||||||
|
(render-box bx fb)
|
||||||
|
;; Framebuffer uses ASCII border chars (+, -, |)
|
||||||
|
(is-true (fb-contains fb "My Box") "title text appears")
|
||||||
|
(is-true (fb-contains fb "+") "top-left corner appears")
|
||||||
|
(is-true (fb-contains fb "-") "horizontal border appears")
|
||||||
|
;; Check the title at row 0, col 2
|
||||||
|
(is (equal "My Box" (fb-string fb 2 1 6)) "title at correct position")))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Text component with word-wrap
|
||||||
|
|
||||||
|
The ~Text~ component word-wraps content to fit within a given width and
|
||||||
|
height. This test renders a sentence longer than the framebuffer width
|
||||||
|
and verifies that individual words break across lines as expected.
|
||||||
|
|
||||||
|
Word-wrap mode ~:word~ preserves word boundaries — it only wraps between
|
||||||
|
words, never in the middle of one. The framebuffer is 20 columns wide, so
|
||||||
|
each row holds roughly 2-3 words.
|
||||||
|
|
||||||
|
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||||
|
(test text-component-on-fb
|
||||||
|
"Text component renders word-wrapped content on framebuffer."
|
||||||
|
(let* ((fb (make-framebuffer-backend :width 20 :height 6))
|
||||||
|
(tx (make-text "Hello brave new world of terminal UI"
|
||||||
|
:wrap-mode :word :width 20 :height 4)))
|
||||||
|
(compute-layout (text-layout-node tx) 20 4)
|
||||||
|
(render-text tx fb)
|
||||||
|
(is-true (fb-contains fb "Hello") "first word appears")
|
||||||
|
(is-true (fb-contains fb "brave") "second word appears")
|
||||||
|
(is-true (fb-contains fb "world") "third word wraps")))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** TextInput with value
|
||||||
|
|
||||||
|
~TextInput~ renders its current value as plain text and draws a cursor
|
||||||
|
block (~█~) at the cursor position. The cursor character is a full block
|
||||||
|
(U+2588) — a Unicode character that renders as a solid rectangle in most
|
||||||
|
terminals.
|
||||||
|
|
||||||
|
This test checks the value string at row 0 and then directly inspects the
|
||||||
|
cell at the cursor position to confirm the block character is present.
|
||||||
|
Direct cell access (~aref~ on the framebuffer array) is necessary because
|
||||||
|
the cursor block is a single character that ~fb-contains~ could match
|
||||||
|
ambiguously.
|
||||||
|
|
||||||
|
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||||
|
(test textinput-value-on-fb
|
||||||
|
"TextInput renders its value and cursor on framebuffer."
|
||||||
|
(let* ((fb (make-framebuffer-backend :width 40 :height 3))
|
||||||
|
(ti (make-text-input :value "hello world" :cursor 11)))
|
||||||
|
(setf (text-input-layout-node ti)
|
||||||
|
(make-layout-node :width 40 :height 1))
|
||||||
|
(compute-layout (text-input-layout-node ti) 40 1)
|
||||||
|
(render ti fb)
|
||||||
|
;; Verify value via direct cell inspection
|
||||||
|
(is (equal "hello world" (fb-string fb 0 0 11)) "value appears at row 0")
|
||||||
|
;; Check cursor block at position 11
|
||||||
|
(let* ((cells (fb-framebuffer fb))
|
||||||
|
(cursor-char (cell-char (aref cells 0 11))))
|
||||||
|
(is (eql #\█ cursor-char) "cursor block is drawn at position 11"))))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** TextInput empty shows placeholder
|
||||||
|
|
||||||
|
When ~TextInput~ has an empty value (~\"\"~) and a ~placeholder~ is set,
|
||||||
|
the placeholder text is rendered in place of the value. This provides
|
||||||
|
visual guidance to the user about what to type.
|
||||||
|
|
||||||
|
The placeholder must disappear once a value is set — that behavior is
|
||||||
|
tested indirectly here by verifying the placeholder text appears on an
|
||||||
|
empty input.
|
||||||
|
|
||||||
|
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||||
|
(test textinput-placeholder-on-fb
|
||||||
|
"TextInput with empty value shows placeholder text."
|
||||||
|
(let* ((fb (make-framebuffer-backend :width 40 :height 3))
|
||||||
|
(ti (make-text-input :value "" :placeholder "Type here...")))
|
||||||
|
(setf (text-input-layout-node ti)
|
||||||
|
(make-layout-node :width 40 :height 1))
|
||||||
|
(compute-layout (text-input-layout-node ti) 40 1)
|
||||||
|
(render ti fb)
|
||||||
|
(is (equal "Type here..." (fb-string fb 0 0 12)) "placeholder appears at row 0")))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** ScrollBox with children
|
||||||
|
|
||||||
|
~ScrollBox~ is a container that renders a subset of its children based on
|
||||||
|
scroll offset. Children above the offset are clipped (scrolled out), and
|
||||||
|
only visible children appear in the viewport.
|
||||||
|
|
||||||
|
This test creates 8 text children (each one line tall) in a ScrollBox
|
||||||
|
with ~scroll-y=2~ and a viewport height of 8. Lines 1-2 should be
|
||||||
|
scrolled out, while Lines 3-8 should be visible. We check both presence
|
||||||
|
(visible lines) and absence (scrolled-out lines).
|
||||||
|
|
||||||
|
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||||
|
(test scrollbox-children-on-fb
|
||||||
|
"ScrollBox renders visible children offset by scroll position."
|
||||||
|
(let* ((fb (make-framebuffer-backend :width 40 :height 10))
|
||||||
|
(children nil))
|
||||||
|
;; Create 8 text children, each 1 line tall
|
||||||
|
(dotimes (i 8)
|
||||||
|
(let ((tx (make-text (format nil "Line ~D" (1+ i))
|
||||||
|
:wrap-mode :none :width 40 :height 1)))
|
||||||
|
(push tx children)))
|
||||||
|
(setf children (nreverse children))
|
||||||
|
(let ((sb (make-scroll-box :children children :scroll-y 2)))
|
||||||
|
;; Set scroll-box layout to 40x8 viewport using component-layout-node
|
||||||
|
(let ((ln (component-layout-node sb)))
|
||||||
|
(setf (layout-node-width ln) 40)
|
||||||
|
(setf (layout-node-height ln) 8))
|
||||||
|
;; Layout each child too
|
||||||
|
(dolist (c children)
|
||||||
|
(compute-layout (component-layout-node c) 40 1))
|
||||||
|
(render sb fb)
|
||||||
|
;; Because scroll-y=2, Line 1 and Line 2 are scrolled out
|
||||||
|
;; Line 3 should be first visible
|
||||||
|
(is-true (fb-contains fb "Line 3") "scroll-y=2 shows Line 3 first")
|
||||||
|
(is-true (fb-contains fb "Line 4") "Line 4 is visible")
|
||||||
|
(is-true (fb-contains fb "Line 5") "Line 5 is visible")
|
||||||
|
;; Line 1 and 2 should NOT be visible (scrolled out)
|
||||||
|
(is-false (fb-contains fb "Line 1") "Line 1 scrolled out")
|
||||||
|
(is-false (fb-contains fb "Line 2") "Line 2 scrolled out"))))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Select renders options
|
||||||
|
|
||||||
|
~Select~ is a dropdown-like component that displays a list of options
|
||||||
|
with titles. This test verifies that all three option titles (\"Red\",
|
||||||
|
\"Green\", \"Blue\") appear on the framebuffer after rendering.
|
||||||
|
|
||||||
|
The ~make-select~ function takes a list of plists with ~:title~ and
|
||||||
|
~:value~ keys. The render method iterates over options and draws each
|
||||||
|
title.
|
||||||
|
|
||||||
|
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||||
|
(test select-options-on-fb
|
||||||
|
"Select renders option titles on framebuffer."
|
||||||
|
(let* ((fb (make-framebuffer-backend :width 40 :height 10))
|
||||||
|
(sel (make-select
|
||||||
|
:options '((:title "Red" :value :red)
|
||||||
|
(:title "Green" :value :green)
|
||||||
|
(:title "Blue" :value :blue)))))
|
||||||
|
(let ((ln (select-layout-node sel)))
|
||||||
|
(setf (layout-node-width ln) 40)
|
||||||
|
(setf (layout-node-height ln) 5))
|
||||||
|
(render sel fb)
|
||||||
|
(is-true (fb-contains fb "Red") "first option appears")
|
||||||
|
(is-true (fb-contains fb "Green") "second option appears")
|
||||||
|
(is-true (fb-contains fb "Blue") "third option appears")))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Dialog renders with backdrop
|
||||||
|
|
||||||
|
~Dialog~ is a modal overlay component. When pushed onto the dialog stack,
|
||||||
|
rendering it draws a dimmed backdrop over the entire framebuffer and a
|
||||||
|
dialog panel (with border and title) centered in the viewport.
|
||||||
|
|
||||||
|
This test creates a dialog with title \"Confirm\", pushes it onto the
|
||||||
|
global stack, renders it, and checks for the title and ASCII border
|
||||||
|
characters. The backdrop is a dimming overlay applied across the full
|
||||||
|
framebuffer area.
|
||||||
|
|
||||||
|
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||||
|
(test dialog-appears-on-fb
|
||||||
|
"Dialog renders a dimmed backdrop and dialog panel with title."
|
||||||
|
(let* ((fb (make-framebuffer-backend :width 80 :height 24))
|
||||||
|
(d (make-instance 'dialog :title "Confirm" :size :small)))
|
||||||
|
(push-dialog d)
|
||||||
|
(render-dialog d fb 80 24)
|
||||||
|
;; Dialog title appears somewhere in the output
|
||||||
|
(is-true (fb-contains fb "Confirm") "dialog title appears")
|
||||||
|
;; Dialog border (ASCII)
|
||||||
|
(is-true (fb-contains fb "+") "dialog border appears")
|
||||||
|
(is-true (fb-contains fb "|") "dialog vertical border appears")
|
||||||
|
;; Clean up
|
||||||
|
(pop-dialog)))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Dialog push/pop with render
|
||||||
|
|
||||||
|
The dialog system maintains a stack (~*dialog-stack*~). When multiple
|
||||||
|
dialogs are pushed, only the topmost dialog is rendered. Popping a dialog
|
||||||
|
restores the previous one.
|
||||||
|
|
||||||
|
This test pushes two dialogs (\"Dialog One\" and \"Dialog Two\"),
|
||||||
|
verifies that only the top dialog (\"Dialog Two\") renders, then pops it
|
||||||
|
and verifies that \"Dialog One\" appears after clearing and re-rendering.
|
||||||
|
This exercises the full push-pop-render cycle.
|
||||||
|
|
||||||
|
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||||
|
(test dialog-push-pop-render
|
||||||
|
"Dialog push/pop cycle works with rendering."
|
||||||
|
(let* ((fb (make-framebuffer-backend :width 80 :height 24))
|
||||||
|
(d1 (make-instance 'dialog :title "Dialog One"))
|
||||||
|
(d2 (make-instance 'dialog :title "Dialog Two")))
|
||||||
|
(push-dialog d1)
|
||||||
|
(push-dialog d2)
|
||||||
|
(render-dialog (first *dialog-stack*) fb 80 24)
|
||||||
|
(is-true (fb-contains fb "Dialog Two") "top dialog renders")
|
||||||
|
(pop-dialog)
|
||||||
|
(backend-clear fb)
|
||||||
|
(render-dialog (first *dialog-stack*) fb 80 24)
|
||||||
|
(is-true (fb-contains fb "Dialog One") "second dialog renders after pop")
|
||||||
|
(pop-dialog)))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Toast renders
|
||||||
|
|
||||||
|
~Toast~ notifications are ephemeral messages that appear at the bottom of
|
||||||
|
the screen with a colored background. They are managed via ~*toasts*~, a
|
||||||
|
list of active toasts.
|
||||||
|
|
||||||
|
This test creates a toast with variant ~:info~, renders the first toast
|
||||||
|
in the list, verifies the message text appears, and then dismisses it to
|
||||||
|
clean up. The ~duration~ is set to 0 so the toast does not auto-dismiss
|
||||||
|
during the test.
|
||||||
|
|
||||||
|
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||||
|
(test toast-appears-on-fb
|
||||||
|
"Toast notification renders with colored background."
|
||||||
|
(let* ((fb (make-framebuffer-backend :width 80 :height 24)))
|
||||||
|
(toast "Hello from toast!" :variant :info :duration 0)
|
||||||
|
(render-toast (first *toasts*) fb 80)
|
||||||
|
(is-true (fb-contains fb "Hello from toast!") "toast message appears")
|
||||||
|
(dismiss-toast (first *toasts*))))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** render-screen pipeline
|
||||||
|
|
||||||
|
~render-screen~ is the top-level entry point for the rendering pipeline.
|
||||||
|
It takes a component tree root and a backend, performs layout computation
|
||||||
|
(if needed), and renders all components recursively.
|
||||||
|
|
||||||
|
This test creates a simple tree with a single Box, calls
|
||||||
|
~render-screen~, and verifies that both the title and border characters
|
||||||
|
appear. This validates that the pipeline dispatches correctly from root
|
||||||
|
through the component hierarchy.
|
||||||
|
|
||||||
|
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||||
|
(test render-screen-pipeline
|
||||||
|
"render-screen processes a component tree through the full pipeline."
|
||||||
|
(let* ((fb (make-framebuffer-backend :width 40 :height 12))
|
||||||
|
(root (make-box :border-style :single :title "Root"
|
||||||
|
:width 40 :height 12)))
|
||||||
|
(render-screen root fb)
|
||||||
|
(is-true (fb-contains fb "Root") "title renders via render-screen")
|
||||||
|
;; Border characters (ASCII on framebuffer)
|
||||||
|
(is-true (fb-contains fb "+") "border renders")))
|
||||||
|
#+END_SRC
|
||||||
|
|
||||||
|
** Full composition via framebuffer
|
||||||
|
|
||||||
|
The ultimate integration test: compose all major components (Box, Text,
|
||||||
|
TextInput, Select) on a single framebuffer at specific positions and
|
||||||
|
verify everything renders correctly.
|
||||||
|
|
||||||
|
The layout is a 60x24 framebuffer with:
|
||||||
|
|
||||||
|
- A Box titled \"Dashboard\" as the outer container.
|
||||||
|
- A Text component with welcome message at (2, 2).
|
||||||
|
- A TextInput with value \"search query\" and cursor at position 12,
|
||||||
|
positioned at (2, 6).
|
||||||
|
- A Select with three options positioned at (2, 8).
|
||||||
|
|
||||||
|
Each component is positioned manually via ~layout-node-x~ and
|
||||||
|
~layout-node-y~ to simulate a composed screen. All components must coexist
|
||||||
|
without overwriting each other's output.
|
||||||
|
|
||||||
|
#+BEGIN_SRC lisp :tangle ../tests/integration-tests.lisp
|
||||||
|
(test full-composition-via-fb
|
||||||
|
"All components compose correctly on a single framebuffer."
|
||||||
|
(let* ((fb (make-framebuffer-backend :width 60 :height 24)))
|
||||||
|
;;
|
||||||
|
;; 1. Box with title at top
|
||||||
|
;;
|
||||||
|
(let ((bx (make-box :border-style :single :title "Dashboard"
|
||||||
|
:width 60 :height 24)))
|
||||||
|
(compute-layout (box-layout-node bx) 60 24)
|
||||||
|
(render-box bx fb))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; 2. Text content inside
|
||||||
|
;;
|
||||||
|
(let ((tx (make-text "Welcome to the dashboard."
|
||||||
|
:wrap-mode :word :width 56 :height 3)))
|
||||||
|
(setf (layout-node-x (text-layout-node tx)) 2)
|
||||||
|
(setf (layout-node-y (text-layout-node tx)) 2)
|
||||||
|
(compute-layout (text-layout-node tx) 56 3)
|
||||||
|
(render-text tx fb))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; 3. TextInput
|
||||||
|
;;
|
||||||
|
(let ((ti (make-text-input :value "search query" :cursor 12)))
|
||||||
|
(setf (text-input-layout-node ti) (make-layout-node))
|
||||||
|
(setf (layout-node-x (text-input-layout-node ti)) 2)
|
||||||
|
(setf (layout-node-y (text-input-layout-node ti)) 6)
|
||||||
|
(setf (layout-node-width (text-input-layout-node ti)) 56)
|
||||||
|
(setf (layout-node-height (text-input-layout-node ti)) 1)
|
||||||
|
(render ti fb))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; 4. Select options
|
||||||
|
;;
|
||||||
|
(let ((sel (make-select
|
||||||
|
:options '((:title "Option A" :value :a)
|
||||||
|
(:title "Option B" :value :b)
|
||||||
|
(:title "Option C" :value :c)))))
|
||||||
|
(setf (select-layout-node sel) (make-layout-node))
|
||||||
|
(setf (layout-node-x (select-layout-node sel)) 2)
|
||||||
|
(setf (layout-node-y (select-layout-node sel)) 8)
|
||||||
|
(setf (layout-node-width (select-layout-node sel)) 56)
|
||||||
|
(setf (layout-node-height (select-layout-node sel)) 3)
|
||||||
|
(render sel fb))
|
||||||
|
|
||||||
|
;;
|
||||||
|
;; Verifications
|
||||||
|
;;
|
||||||
|
(is-true (fb-contains fb "Dashboard") "box title appears")
|
||||||
|
(is-true (fb-contains fb "Welcome") "text content appears")
|
||||||
|
;; Check TextInput value at its position
|
||||||
|
(is (equal "search query" (fb-string fb 2 6 12)) "TextInput value at row 6")
|
||||||
|
;; Check Select options at their positions
|
||||||
|
(is-true (fb-contains fb "Option A") "Select option A appears")
|
||||||
|
(is-true (fb-contains fb "Option B") "Select option B appears")
|
||||||
|
(is-true (fb-contains fb "Option C") "Select option C appears")))
|
||||||
|
#+END_SRC
|
||||||
@@ -1061,3 +1061,390 @@ Returns an empty string for ~nil~ input.
|
|||||||
for first = t then nil
|
for first = t then nil
|
||||||
do (unless first (terpri s)) (princ part s)))))
|
do (unless first (terpri s)) (princ part s)))))
|
||||||
#+END_SRC
|
#+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
|
||||||
|
|||||||
@@ -1,12 +0,0 @@
|
|||||||
;; This file is deprecated. Tests moved to tests/input-tests.lisp.
|
|
||||||
;; Kept as placeholder to prevent confusion with stale copies.
|
|
||||||
(defpackage :cl-tty-input-test
|
|
||||||
(:use :cl :fiveam :cl-tty.backend :cl-tty.box :cl-tty.layout :cl-tty.input)
|
|
||||||
(:export #:run-tests))
|
|
||||||
(in-package :cl-tty-input-test)
|
|
||||||
|
|
||||||
(defun run-tests ()
|
|
||||||
(warn "src/components/input-tests.lisp is deprecated. Use tests/input-tests.lisp instead.")
|
|
||||||
(let ((result (run 'input-suite)))
|
|
||||||
(fiveam:explain! result)
|
|
||||||
(uiop:quit 0)))
|
|
||||||
@@ -2,6 +2,8 @@
|
|||||||
;;;
|
;;;
|
||||||
;;; Composes all major components through the rendering pipeline onto a
|
;;; Composes all major components through the rendering pipeline onto a
|
||||||
;;; framebuffer backend and verifies cell-level output.
|
;;; framebuffer backend and verifies cell-level output.
|
||||||
|
;;;
|
||||||
|
;;; This file is tangled from org/integration-tests.org — do not edit directly.
|
||||||
|
|
||||||
(defpackage :cl-tty-integration-test
|
(defpackage :cl-tty-integration-test
|
||||||
(:use :cl :fiveam
|
(:use :cl :fiveam
|
||||||
@@ -16,13 +18,12 @@
|
|||||||
|
|
||||||
(in-suite integration-suite)
|
(in-suite integration-suite)
|
||||||
|
|
||||||
;; ─── Helper: extract cell text from a region ──────────────────────
|
|
||||||
|
|
||||||
(defun fb-string (fb x y &optional (len 1))
|
(defun fb-string (fb x y &optional (len 1))
|
||||||
"Read a string of LEN characters from framebuffer FB starting at (X,Y)."
|
"Read a string of LEN characters from framebuffer FB starting at (X,Y)."
|
||||||
(let* ((cells (fb-framebuffer fb))
|
(let* ((cells (fb-framebuffer fb))
|
||||||
(w (framebuffer-width cells))
|
(w (framebuffer-width cells))
|
||||||
(h (framebuffer-height cells)))
|
(h (framebuffer-height cells)))
|
||||||
|
(declare (ignore h))
|
||||||
(with-output-to-string (s)
|
(with-output-to-string (s)
|
||||||
(loop for i from 0 below len
|
(loop for i from 0 below len
|
||||||
for cx = (+ x i)
|
for cx = (+ x i)
|
||||||
@@ -35,16 +36,15 @@
|
|||||||
(w (framebuffer-width cells))
|
(w (framebuffer-width cells))
|
||||||
(h (framebuffer-height cells))
|
(h (framebuffer-height cells))
|
||||||
(max-row (min (or end-row h) h)))
|
(max-row (min (or end-row h) h)))
|
||||||
|
(declare (ignore w))
|
||||||
(loop for y from start-row below max-row
|
(loop for y from start-row below max-row
|
||||||
collect (fb-string fb 0 y w))))
|
collect (fb-string fb 0 y (framebuffer-width cells)))))
|
||||||
|
|
||||||
(defun fb-contains (fb text)
|
(defun fb-contains (fb text)
|
||||||
"Return T if framebuffer FB contains TEXT anywhere."
|
"Return T if framebuffer FB contains TEXT anywhere."
|
||||||
(let ((all-text (format nil "~{~a~^~%~}" (fb-lines fb))))
|
(let ((all-text (format nil "~{~a~^~%~}" (fb-lines fb))))
|
||||||
(search text all-text :test #'char-equal)))
|
(search text all-text :test #'char-equal)))
|
||||||
|
|
||||||
;; ─── Test: Box with title renders correctly ───────────────────────
|
|
||||||
|
|
||||||
(test box-title-renders-on-fb
|
(test box-title-renders-on-fb
|
||||||
"A Box with a title draws border and title text on framebuffer."
|
"A Box with a title draws border and title text on framebuffer."
|
||||||
(let* ((fb (make-framebuffer-backend :width 40 :height 10))
|
(let* ((fb (make-framebuffer-backend :width 40 :height 10))
|
||||||
@@ -58,8 +58,6 @@
|
|||||||
;; Check the title at row 0, col 2
|
;; Check the title at row 0, col 2
|
||||||
(is (equal "My Box" (fb-string fb 2 1 6)) "title at correct position")))
|
(is (equal "My Box" (fb-string fb 2 1 6)) "title at correct position")))
|
||||||
|
|
||||||
;; ─── Test: Text component with word-wrap ──────────────────────────
|
|
||||||
|
|
||||||
(test text-component-on-fb
|
(test text-component-on-fb
|
||||||
"Text component renders word-wrapped content on framebuffer."
|
"Text component renders word-wrapped content on framebuffer."
|
||||||
(let* ((fb (make-framebuffer-backend :width 20 :height 6))
|
(let* ((fb (make-framebuffer-backend :width 20 :height 6))
|
||||||
@@ -71,8 +69,6 @@
|
|||||||
(is-true (fb-contains fb "brave") "second word appears")
|
(is-true (fb-contains fb "brave") "second word appears")
|
||||||
(is-true (fb-contains fb "world") "third word wraps")))
|
(is-true (fb-contains fb "world") "third word wraps")))
|
||||||
|
|
||||||
;; ─── Test: TextInput with value ───────────────────────────────────
|
|
||||||
|
|
||||||
(test textinput-value-on-fb
|
(test textinput-value-on-fb
|
||||||
"TextInput renders its value and cursor on framebuffer."
|
"TextInput renders its value and cursor on framebuffer."
|
||||||
(let* ((fb (make-framebuffer-backend :width 40 :height 3))
|
(let* ((fb (make-framebuffer-backend :width 40 :height 3))
|
||||||
@@ -88,8 +84,6 @@
|
|||||||
(cursor-char (cell-char (aref cells 0 11))))
|
(cursor-char (cell-char (aref cells 0 11))))
|
||||||
(is (eql #\█ cursor-char) "cursor block is drawn at position 11"))))
|
(is (eql #\█ cursor-char) "cursor block is drawn at position 11"))))
|
||||||
|
|
||||||
;; ─── Test: TextInput empty shows placeholder ──────────────────────
|
|
||||||
|
|
||||||
(test textinput-placeholder-on-fb
|
(test textinput-placeholder-on-fb
|
||||||
"TextInput with empty value shows placeholder text."
|
"TextInput with empty value shows placeholder text."
|
||||||
(let* ((fb (make-framebuffer-backend :width 40 :height 3))
|
(let* ((fb (make-framebuffer-backend :width 40 :height 3))
|
||||||
@@ -100,8 +94,6 @@
|
|||||||
(render ti fb)
|
(render ti fb)
|
||||||
(is (equal "Type here..." (fb-string fb 0 0 12)) "placeholder appears at row 0")))
|
(is (equal "Type here..." (fb-string fb 0 0 12)) "placeholder appears at row 0")))
|
||||||
|
|
||||||
;; ─── Test: ScrollBox with children ────────────────────────────────
|
|
||||||
|
|
||||||
(test scrollbox-children-on-fb
|
(test scrollbox-children-on-fb
|
||||||
"ScrollBox renders visible children offset by scroll position."
|
"ScrollBox renders visible children offset by scroll position."
|
||||||
(let* ((fb (make-framebuffer-backend :width 40 :height 10))
|
(let* ((fb (make-framebuffer-backend :width 40 :height 10))
|
||||||
@@ -130,8 +122,6 @@
|
|||||||
(is-false (fb-contains fb "Line 1") "Line 1 scrolled out")
|
(is-false (fb-contains fb "Line 1") "Line 1 scrolled out")
|
||||||
(is-false (fb-contains fb "Line 2") "Line 2 scrolled out"))))
|
(is-false (fb-contains fb "Line 2") "Line 2 scrolled out"))))
|
||||||
|
|
||||||
;; ─── Test: Select renders options ─────────────────────────────────
|
|
||||||
|
|
||||||
(test select-options-on-fb
|
(test select-options-on-fb
|
||||||
"Select renders option titles on framebuffer."
|
"Select renders option titles on framebuffer."
|
||||||
(let* ((fb (make-framebuffer-backend :width 40 :height 10))
|
(let* ((fb (make-framebuffer-backend :width 40 :height 10))
|
||||||
@@ -147,8 +137,6 @@
|
|||||||
(is-true (fb-contains fb "Green") "second option appears")
|
(is-true (fb-contains fb "Green") "second option appears")
|
||||||
(is-true (fb-contains fb "Blue") "third option appears")))
|
(is-true (fb-contains fb "Blue") "third option appears")))
|
||||||
|
|
||||||
;; ─── Test: Dialog renders with backdrop ───────────────────────────
|
|
||||||
|
|
||||||
(test dialog-appears-on-fb
|
(test dialog-appears-on-fb
|
||||||
"Dialog renders a dimmed backdrop and dialog panel with title."
|
"Dialog renders a dimmed backdrop and dialog panel with title."
|
||||||
(let* ((fb (make-framebuffer-backend :width 80 :height 24))
|
(let* ((fb (make-framebuffer-backend :width 80 :height 24))
|
||||||
@@ -163,8 +151,6 @@
|
|||||||
;; Clean up
|
;; Clean up
|
||||||
(pop-dialog)))
|
(pop-dialog)))
|
||||||
|
|
||||||
;; ─── Test: Dialog push/pop with render ────────────────────────────
|
|
||||||
|
|
||||||
(test dialog-push-pop-render
|
(test dialog-push-pop-render
|
||||||
"Dialog push/pop cycle works with rendering."
|
"Dialog push/pop cycle works with rendering."
|
||||||
(let* ((fb (make-framebuffer-backend :width 80 :height 24))
|
(let* ((fb (make-framebuffer-backend :width 80 :height 24))
|
||||||
@@ -180,8 +166,6 @@
|
|||||||
(is-true (fb-contains fb "Dialog One") "second dialog renders after pop")
|
(is-true (fb-contains fb "Dialog One") "second dialog renders after pop")
|
||||||
(pop-dialog)))
|
(pop-dialog)))
|
||||||
|
|
||||||
;; ─── Test: Toast renders ──────────────────────────────────────────
|
|
||||||
|
|
||||||
(test toast-appears-on-fb
|
(test toast-appears-on-fb
|
||||||
"Toast notification renders with colored background."
|
"Toast notification renders with colored background."
|
||||||
(let* ((fb (make-framebuffer-backend :width 80 :height 24)))
|
(let* ((fb (make-framebuffer-backend :width 80 :height 24)))
|
||||||
@@ -190,8 +174,6 @@
|
|||||||
(is-true (fb-contains fb "Hello from toast!") "toast message appears")
|
(is-true (fb-contains fb "Hello from toast!") "toast message appears")
|
||||||
(dismiss-toast (first *toasts*))))
|
(dismiss-toast (first *toasts*))))
|
||||||
|
|
||||||
;; ─── Test: render-screen pipeline ─────────────────────────────────
|
|
||||||
|
|
||||||
(test render-screen-pipeline
|
(test render-screen-pipeline
|
||||||
"render-screen processes a component tree through the full pipeline."
|
"render-screen processes a component tree through the full pipeline."
|
||||||
(let* ((fb (make-framebuffer-backend :width 40 :height 12))
|
(let* ((fb (make-framebuffer-backend :width 40 :height 12))
|
||||||
@@ -202,8 +184,6 @@
|
|||||||
;; Border characters (ASCII on framebuffer)
|
;; Border characters (ASCII on framebuffer)
|
||||||
(is-true (fb-contains fb "+") "border renders")))
|
(is-true (fb-contains fb "+") "border renders")))
|
||||||
|
|
||||||
;; ─── Test: Full composition via framebuffer ───────────────────────
|
|
||||||
|
|
||||||
(test full-composition-via-fb
|
(test full-composition-via-fb
|
||||||
"All components compose correctly on a single framebuffer."
|
"All components compose correctly on a single framebuffer."
|
||||||
(let* ((fb (make-framebuffer-backend :width 60 :height 24)))
|
(let* ((fb (make-framebuffer-backend :width 60 :height 24)))
|
||||||
|
|||||||
@@ -11,6 +11,7 @@
|
|||||||
|
|
||||||
(in-suite :cl-tty-markdown-test)
|
(in-suite :cl-tty-markdown-test)
|
||||||
|
|
||||||
|
|
||||||
;; ─── Parser edge cases ─────────────────────────────────────────
|
;; ─── Parser edge cases ─────────────────────────────────────────
|
||||||
|
|
||||||
(def-test render-markdown-nil ( )
|
(def-test render-markdown-nil ( )
|
||||||
@@ -88,6 +89,7 @@
|
|||||||
"Only blank lines produce empty output."
|
"Only blank lines produce empty output."
|
||||||
(is (string= "" (render-markdown (format nil "~%~%")))))
|
(is (string= "" (render-markdown (format nil "~%~%")))))
|
||||||
|
|
||||||
|
|
||||||
;; ─── Parser tests ─────────────────────────────────────────────────────────────
|
;; ─── Parser tests ─────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
(def-test heading-parsing ( )
|
(def-test heading-parsing ( )
|
||||||
@@ -112,6 +114,7 @@
|
|||||||
(is-true (eql :text (getf (first children) :type)))
|
(is-true (eql :text (getf (first children) :type)))
|
||||||
(is-true (eql :bold (getf (second children) :type)))))
|
(is-true (eql :bold (getf (second children) :type)))))
|
||||||
|
|
||||||
|
|
||||||
(def-test paragraph-parsing ( )
|
(def-test paragraph-parsing ( )
|
||||||
(let* ((result (parse-blocks "This is a paragraph.")) (node (first result)))
|
(let* ((result (parse-blocks "This is a paragraph.")) (node (first result)))
|
||||||
(is-true (eql :paragraph (getf node :type)))))
|
(is-true (eql :paragraph (getf node :type)))))
|
||||||
@@ -120,6 +123,7 @@
|
|||||||
(let* ((result (parse-blocks "Line one\nLine two")) (node (first result)))
|
(let* ((result (parse-blocks "Line one\nLine two")) (node (first result)))
|
||||||
(is-true (eql :paragraph (getf node :type)))))
|
(is-true (eql :paragraph (getf node :type)))))
|
||||||
|
|
||||||
|
|
||||||
(def-test bold-parsing ( )
|
(def-test bold-parsing ( )
|
||||||
(let* ((children (parse-inline "hello **world** here"))
|
(let* ((children (parse-inline "hello **world** here"))
|
||||||
(bold-node (second children)))
|
(bold-node (second children)))
|
||||||
@@ -156,6 +160,7 @@
|
|||||||
(is-true (eql :text (getf (first link-text) :type)))
|
(is-true (eql :text (getf (first link-text) :type)))
|
||||||
(is (equal "here" (getf (first link-text) :content))))))
|
(is (equal "here" (getf (first link-text) :content))))))
|
||||||
|
|
||||||
|
|
||||||
(def-test code-block-parsing ( )
|
(def-test code-block-parsing ( )
|
||||||
(let* ((lines '("```lisp" "(defun hello ())" " (print \"hi\")" "```"))
|
(let* ((lines '("```lisp" "(defun hello ())" " (print \"hi\")" "```"))
|
||||||
(text (format nil "~{~a~%~}" lines))
|
(text (format nil "~{~a~%~}" lines))
|
||||||
@@ -171,6 +176,7 @@
|
|||||||
(is-true (eql :code-block (getf node :type)))
|
(is-true (eql :code-block (getf node :type)))
|
||||||
(is-false (getf (getf node :properties) :language))))
|
(is-false (getf (getf node :properties) :language))))
|
||||||
|
|
||||||
|
|
||||||
(def-test blockquote-parsing ( )
|
(def-test blockquote-parsing ( )
|
||||||
(let* ((result (parse-blocks "> This is a quote")) (node (first result)))
|
(let* ((result (parse-blocks "> This is a quote")) (node (first result)))
|
||||||
(is-true (eql :blockquote (getf node :type)))))
|
(is-true (eql :blockquote (getf node :type)))))
|
||||||
@@ -187,6 +193,7 @@
|
|||||||
(let* ((result (parse-blocks "---")) (node (first result)))
|
(let* ((result (parse-blocks "---")) (node (first result)))
|
||||||
(is-true (eql :thematic-break (getf node :type)))))
|
(is-true (eql :thematic-break (getf node :type)))))
|
||||||
|
|
||||||
|
|
||||||
;; ─── Diff tests ───────────────────────────────────────────────────────────────
|
;; ─── Diff tests ───────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
(def-test classify-diff-added ( )
|
(def-test classify-diff-added ( )
|
||||||
@@ -201,6 +208,7 @@
|
|||||||
(def-test classify-diff-context ( )
|
(def-test classify-diff-context ( )
|
||||||
(is (eql :context (classify-diff-line " normal context"))))
|
(is (eql :context (classify-diff-line " normal context"))))
|
||||||
|
|
||||||
|
|
||||||
;; ─── Syntax highlighting tests ────────────────────────────────────────────────
|
;; ─── Syntax highlighting tests ────────────────────────────────────────────────
|
||||||
(def-test highlight-lisp-keyword ( )
|
(def-test highlight-lisp-keyword ( )
|
||||||
(let ((tokens (highlight-code "(defun hello ()" "lisp")))
|
(let ((tokens (highlight-code "(defun hello ()" "lisp")))
|
||||||
@@ -223,6 +231,7 @@
|
|||||||
(let ((tokens (highlight-code "; this is a comment" "lisp")))
|
(let ((tokens (highlight-code "; this is a comment" "lisp")))
|
||||||
(is-true (some (lambda (pair) (eql :comment (cdr pair))) tokens))))
|
(is-true (some (lambda (pair) (eql :comment (cdr pair))) tokens))))
|
||||||
|
|
||||||
|
|
||||||
;; ─── Render tests ─────────────────────────────────────────────────────────────
|
;; ─── Render tests ─────────────────────────────────────────────────────────────
|
||||||
|
|
||||||
(def-test render-heading-output ( )
|
(def-test render-heading-output ( )
|
||||||
@@ -259,10 +268,11 @@
|
|||||||
(is (search "added" (fourth lines)))
|
(is (search "added" (fourth lines)))
|
||||||
(is (search "removed" (fifth lines)))))
|
(is (search "removed" (fifth lines)))))
|
||||||
|
|
||||||
|
|
||||||
;; ─── Integration tests ────────────────────────────────────────────────────────
|
;; ─── Integration tests ────────────────────────────────────────────────────────
|
||||||
|
|
||||||
(def-test markdown-integration ( )
|
(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\")~%```~%~%---"))
|
(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)))
|
(nodes (parse-blocks md)) (lines (render-md nodes)))
|
||||||
(is-true (> (length lines) 5))
|
(is-true (> (length lines) 5))
|
||||||
(is-true (search "# Title" (first lines)))))
|
(is-true (search "# Title" (first lines)))))
|
||||||
|
|||||||
Reference in New Issue
Block a user