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
@@ -2,6 +2,8 @@
|
||||
;;;
|
||||
;;; 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
|
||||
@@ -16,13 +18,12 @@
|
||||
|
||||
(in-suite integration-suite)
|
||||
|
||||
;; ─── Helper: extract cell text from a region ──────────────────────
|
||||
|
||||
(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)
|
||||
@@ -35,16 +36,15 @@
|
||||
(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 w))))
|
||||
collect (fb-string fb 0 y (framebuffer-width cells)))))
|
||||
|
||||
(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)))
|
||||
|
||||
;; ─── Test: Box with title renders correctly ───────────────────────
|
||||
|
||||
(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))
|
||||
@@ -58,8 +58,6 @@
|
||||
;; Check the title at row 0, col 2
|
||||
(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
|
||||
"Text component renders word-wrapped content on framebuffer."
|
||||
(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 "world") "third word wraps")))
|
||||
|
||||
;; ─── Test: TextInput with value ───────────────────────────────────
|
||||
|
||||
(test textinput-value-on-fb
|
||||
"TextInput renders its value and cursor on framebuffer."
|
||||
(let* ((fb (make-framebuffer-backend :width 40 :height 3))
|
||||
@@ -88,8 +84,6 @@
|
||||
(cursor-char (cell-char (aref cells 0 11))))
|
||||
(is (eql #\█ cursor-char) "cursor block is drawn at position 11"))))
|
||||
|
||||
;; ─── Test: TextInput empty shows placeholder ──────────────────────
|
||||
|
||||
(test textinput-placeholder-on-fb
|
||||
"TextInput with empty value shows placeholder text."
|
||||
(let* ((fb (make-framebuffer-backend :width 40 :height 3))
|
||||
@@ -100,8 +94,6 @@
|
||||
(render ti fb)
|
||||
(is (equal "Type here..." (fb-string fb 0 0 12)) "placeholder appears at row 0")))
|
||||
|
||||
;; ─── Test: ScrollBox with children ────────────────────────────────
|
||||
|
||||
(test scrollbox-children-on-fb
|
||||
"ScrollBox renders visible children offset by scroll position."
|
||||
(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 2") "Line 2 scrolled out"))))
|
||||
|
||||
;; ─── Test: Select renders options ─────────────────────────────────
|
||||
|
||||
(test select-options-on-fb
|
||||
"Select renders option titles on framebuffer."
|
||||
(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 "Blue") "third option appears")))
|
||||
|
||||
;; ─── Test: Dialog renders with backdrop ───────────────────────────
|
||||
|
||||
(test dialog-appears-on-fb
|
||||
"Dialog renders a dimmed backdrop and dialog panel with title."
|
||||
(let* ((fb (make-framebuffer-backend :width 80 :height 24))
|
||||
@@ -163,8 +151,6 @@
|
||||
;; Clean up
|
||||
(pop-dialog)))
|
||||
|
||||
;; ─── Test: Dialog push/pop with render ────────────────────────────
|
||||
|
||||
(test dialog-push-pop-render
|
||||
"Dialog push/pop cycle works with rendering."
|
||||
(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")
|
||||
(pop-dialog)))
|
||||
|
||||
;; ─── Test: Toast renders ──────────────────────────────────────────
|
||||
|
||||
(test toast-appears-on-fb
|
||||
"Toast notification renders with colored background."
|
||||
(let* ((fb (make-framebuffer-backend :width 80 :height 24)))
|
||||
@@ -190,8 +174,6 @@
|
||||
(is-true (fb-contains fb "Hello from toast!") "toast message appears")
|
||||
(dismiss-toast (first *toasts*))))
|
||||
|
||||
;; ─── Test: render-screen pipeline ─────────────────────────────────
|
||||
|
||||
(test render-screen-pipeline
|
||||
"render-screen processes a component tree through the full pipeline."
|
||||
(let* ((fb (make-framebuffer-backend :width 40 :height 12))
|
||||
@@ -202,8 +184,6 @@
|
||||
;; Border characters (ASCII on framebuffer)
|
||||
(is-true (fb-contains fb "+") "border renders")))
|
||||
|
||||
;; ─── Test: Full composition via framebuffer ───────────────────────
|
||||
|
||||
(test full-composition-via-fb
|
||||
"All components compose correctly on a single framebuffer."
|
||||
(let* ((fb (make-framebuffer-backend :width 60 :height 24)))
|
||||
|
||||
@@ -11,6 +11,7 @@
|
||||
|
||||
(in-suite :cl-tty-markdown-test)
|
||||
|
||||
|
||||
;; ─── Parser edge cases ─────────────────────────────────────────
|
||||
|
||||
(def-test render-markdown-nil ( )
|
||||
@@ -88,6 +89,7 @@
|
||||
"Only blank lines produce empty output."
|
||||
(is (string= "" (render-markdown (format nil "~%~%")))))
|
||||
|
||||
|
||||
;; ─── Parser tests ─────────────────────────────────────────────────────────────
|
||||
|
||||
(def-test heading-parsing ( )
|
||||
@@ -112,6 +114,7 @@
|
||||
(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)))))
|
||||
@@ -120,6 +123,7 @@
|
||||
(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)))
|
||||
@@ -156,6 +160,7 @@
|
||||
(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))
|
||||
@@ -171,6 +176,7 @@
|
||||
(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)))))
|
||||
@@ -187,6 +193,7 @@
|
||||
(let* ((result (parse-blocks "---")) (node (first result)))
|
||||
(is-true (eql :thematic-break (getf node :type)))))
|
||||
|
||||
|
||||
;; ─── Diff tests ───────────────────────────────────────────────────────────────
|
||||
|
||||
(def-test classify-diff-added ( )
|
||||
@@ -196,11 +203,12 @@
|
||||
(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 @@" ))))
|
||||
(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")))
|
||||
@@ -223,6 +231,7 @@
|
||||
(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 ( )
|
||||
@@ -259,10 +268,11 @@
|
||||
(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\")~%```~%~%---"))
|
||||
(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)))))
|
||||
|
||||
Reference in New Issue
Block a user