fix: dialog draw-border arg, markdown/slot nil guards, +integration test suite
This commit is contained in:
Hermes Agent
263
tests/integration-tests.lisp
Normal file
263
tests/integration-tests.lisp
Normal file
@@ -0,0 +1,263 @@
|
||||
;;; 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.
|
||||
|
||||
(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)
|
||||
|
||||
;; ─── 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)))
|
||||
(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)))
|
||||
(loop for y from start-row below max-row
|
||||
collect (fb-string fb 0 y w))))
|
||||
|
||||
(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))
|
||||
(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 0 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))
|
||||
(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 with value ───────────────────────────────────
|
||||
|
||||
(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 5)))
|
||||
(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 5
|
||||
(let* ((cells (fb-framebuffer fb))
|
||||
(cursor-char (cell-char (aref cells 0 5))))
|
||||
(is (eql #\█ cursor-char) "cursor block is drawn at position 5"))))
|
||||
|
||||
;; ─── 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))
|
||||
(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 with children ────────────────────────────────
|
||||
|
||||
(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 renders options ─────────────────────────────────
|
||||
|
||||
(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 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))
|
||||
(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 with render ────────────────────────────
|
||||
|
||||
(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 renders ──────────────────────────────────────────
|
||||
|
||||
(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 ─────────────────────────────────
|
||||
|
||||
(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 framebuffer ───────────────────────
|
||||
|
||||
(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 6)))
|
||||
(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")))
|
||||
Reference in New Issue
Block a user