811d51a4f2
Rename: cl-tty avoids naming collision with Quicklisp's cl-tui (naryl/cl-tui, a cl-charms-based ncurses library). Our project is pure escape-sequence CL. v0.9.0 adds: - Dialog base class: modal overlay with backdrop, centered panel, size variants (:small/:medium/:large), stack-based management - Dialog subclasses: alert, confirm, select-dialog, prompt-dialog - Toast notifications: transient, top-right corner, auto-dismiss, colored variants (info/success/warning/error) - 78 tests total, 100% passing ASDF: read-time package references (+fiveam:+) replaced with find-symbol so .asd loads without FiveAM pre-loaded
167 lines
6.6 KiB
Common Lisp
167 lines
6.6 KiB
Common Lisp
(defpackage :cl-tty-box-test
|
|
(:use :cl :fiveam :cl-tty.backend :cl-tty.layout :cl-tty.box)
|
|
(:export #:run-tests))
|
|
(in-package :cl-tty-box-test)
|
|
|
|
(def-suite box-suite :description "Box renderable tests")
|
|
(in-suite box-suite)
|
|
|
|
(defun run-tests ()
|
|
(let ((result (run 'box-suite)))
|
|
(fiveam:explain! result)
|
|
(uiop:quit 0)))
|
|
|
|
(defun make-capturing-backend ()
|
|
(let* ((s (make-string-output-stream))
|
|
(b (make-modern-backend :output-stream s)))
|
|
(values b s)))
|
|
|
|
;; ── Box Tests ─────────────────────────────────────────────────
|
|
|
|
(test box-creates-with-defaults
|
|
"A box created with no arguments has reasonable defaults"
|
|
(let ((b (make-box)))
|
|
(is (typep b 'box))
|
|
(is (typep (box-layout-node b) 'layout-node))))
|
|
|
|
(test box-renders-border
|
|
"A box with border draws border characters"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((bx (make-box :border-style :single :width 10 :height 5)))
|
|
(compute-layout (box-layout-node bx) 10 5)
|
|
(render-box bx b)
|
|
(let ((out (get-output-stream-string s)))
|
|
(is (search "┌" out) "top-left corner")
|
|
(is (search "┐" out) "top-right corner")
|
|
(is (search "└" out) "bottom-left corner")
|
|
(is (search "┘" out) "bottom-right corner")))))
|
|
|
|
(test box-renders-background
|
|
"A box with background color fills interior"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((bx (make-box :bg :red :width 5 :height 3)))
|
|
(compute-layout (box-layout-node bx) 5 3)
|
|
(render-box bx b)
|
|
(let ((out (get-output-stream-string s)))
|
|
(is (search "┌" out) "border with background")
|
|
(is (search "41m" out) "SGR background for red")))))
|
|
|
|
(test box-renders-title
|
|
"A box with title renders the title text"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((bx (make-box :title "Hello" :width 12 :height 3)))
|
|
(compute-layout (box-layout-node bx) 12 3)
|
|
(render-box bx b)
|
|
(let ((out (get-output-stream-string s)))
|
|
(is (search "Hello" out) "title text should appear")))))
|
|
|
|
(test box-without-border
|
|
"A box with border-style nil draws no border"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((bx (make-box :border-style nil :bg :red :width 5 :height 3)))
|
|
(compute-layout (box-layout-node bx) 5 3)
|
|
(render-box bx b)
|
|
(let ((out (get-output-stream-string s)))
|
|
(is (search "41m" out) "background still renders")
|
|
(is-false (search "┌" out) "no top-left corner")))))
|
|
|
|
(test box-zero-size
|
|
"A box with any zero dimension renders nothing"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((bx (make-box :border-style :single :width 0 :height 0)))
|
|
(compute-layout (box-layout-node bx) 0 0)
|
|
(render-box bx b)
|
|
(is (string= (get-output-stream-string s) "")
|
|
"zero-size box produces no output"))))
|
|
|
|
(test box-single-column
|
|
"A box with width 1 renders nothing (needs min 2 for border)"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((bx (make-box :border-style :single :width 1 :height 5)))
|
|
(compute-layout (box-layout-node bx) 1 5)
|
|
(render-box bx b)
|
|
(is (string= (get-output-stream-string s) "")
|
|
"width=1 box renders nothing"))))
|
|
|
|
(test box-minimum-size
|
|
"A box with minimum non-zero size still renders"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((bx (make-box :border-style :single :width 2 :height 2)))
|
|
(compute-layout (box-layout-node bx) 2 2)
|
|
(render-box bx b)
|
|
(let ((out (get-output-stream-string s)))
|
|
(is (search "┌" out) "2x2 box still has borders")))))
|
|
|
|
;; ── Text and Span Tests ───────────────────────────────────────
|
|
|
|
(test text-creates-with-defaults
|
|
"A text created with no arguments has reasonable defaults"
|
|
(let ((txt (make-text "")))
|
|
(is (typep txt 'text))
|
|
(is (typep (text-layout-node txt) 'layout-node))))
|
|
|
|
(test text-renders-content
|
|
"A text renders its content at position"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((tx (make-text "Hello" :width 10 :height 1)))
|
|
(compute-layout (text-layout-node tx) 10 1)
|
|
(render-text tx b)
|
|
(let ((out (get-output-stream-string s)))
|
|
(is (search "Hello" out) "content should appear")))))
|
|
|
|
(test text-empty-string
|
|
"Empty text produces no output"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((tx (make-text "" :width 10 :height 1)))
|
|
(compute-layout (text-layout-node tx) 10 1)
|
|
(render-text tx b)
|
|
(is (string= (get-output-stream-string s) "")
|
|
"empty string produces no output"))))
|
|
|
|
(test text-truncates-when-no-wrap
|
|
"Text with wrap-mode :none truncates at width"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((tx (make-text "Hello World" :width 5 :height 1
|
|
:wrap-mode :none)))
|
|
(compute-layout (text-layout-node tx) 5 1)
|
|
(render-text tx b)
|
|
(let ((out (get-output-stream-string s)))
|
|
(is (search "Hello" out) "truncated to first 5 chars")))))
|
|
|
|
(test text-word-wraps
|
|
"Text with wrap-mode :word wraps at word boundaries"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((tx (make-text "Hello brave new world" :width 6 :height 3)))
|
|
(compute-layout (text-layout-node tx) 6 3)
|
|
(render-text tx b)
|
|
(let ((out (get-output-stream-string s)))
|
|
(is (search "Hello" out) "first line")
|
|
(is (search "brave" out) "second line")
|
|
(is (search "new" out) "third line")))))
|
|
|
|
(test text-word-wrap-single-word
|
|
"A word longer than width is hard-broken at max-width"
|
|
(multiple-value-bind (b s) (make-capturing-backend)
|
|
(let ((tx (make-text "Hello" :width 3 :height 3)))
|
|
(compute-layout (text-layout-node tx) 3 3)
|
|
(render-text tx b)
|
|
(let ((out (get-output-stream-string s)))
|
|
(is (search "Hel" out) "first chunk is Hel")
|
|
(is (search "lo" out) "second chunk is lo")))))
|
|
|
|
(test span-creates-with-attributes
|
|
"A span has text and optional style attributes"
|
|
(let ((s (span "bold text" :bold t)))
|
|
(is (string= (span-text s) "bold text"))
|
|
(is-true (span-bold s))
|
|
(is-false (span-italic s))))
|
|
|
|
(test make-text-with-spans
|
|
"Text with spans stores span objects"
|
|
(let* ((sp (list (span "Hello" :bold t)
|
|
(span "World" :italic t)))
|
|
(tx (make-text "" :spans sp)))
|
|
(is (= (length (text-spans tx)) 2))
|
|
(is (string= (span-text (elt (text-spans tx) 0)) "Hello"))
|
|
(is-true (span-bold (elt (text-spans tx) 0)))))
|