a9670a5cd7
- 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.
244 lines
10 KiB
Common Lisp
244 lines
10 KiB
Common 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)
|
|
|
|
(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)))))
|
|
|
|
(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)))))
|
|
|
|
(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-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")))
|
|
|
|
(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")))
|
|
|
|
(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"))))
|
|
|
|
(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")))
|
|
|
|
(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"))))
|
|
|
|
(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")))
|
|
|
|
(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)))
|
|
|
|
(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)))
|
|
|
|
(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*))))
|
|
|
|
(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")))
|
|
|
|
(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")))
|