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
176 lines
7.0 KiB
Common Lisp
176 lines
7.0 KiB
Common Lisp
(defpackage :cl-tty-layout-test
|
|
(:use :cl :fiveam :cl-tty.layout)
|
|
(:export #:run-tests))
|
|
(in-package :cl-tty-layout-test)
|
|
|
|
(def-suite layout-suite :description "Layout engine tests")
|
|
(in-suite layout-suite)
|
|
|
|
(defun run-tests ()
|
|
(let ((result (run 'layout-suite)))
|
|
(fiveam:explain! result)
|
|
(uiop:quit 0)))
|
|
|
|
(test make-layout-node-defaults
|
|
(let ((n (make-layout-node)))
|
|
(is (typep n 'layout-node))
|
|
(is (eql (layout-node-direction n) :column))))
|
|
|
|
(test make-layout-node-row
|
|
(let ((n (make-layout-node :direction :row)))
|
|
(is (eql (layout-node-direction n) :row))))
|
|
|
|
(test add-child-sets-parent
|
|
(let ((parent (make-layout-node)) (child (make-layout-node)))
|
|
(layout-node-add-child parent child)
|
|
(is (eql (layout-node-parent child) parent))
|
|
(is (= (length (layout-node-children parent)) 1))))
|
|
|
|
(test remove-child-clears-parent
|
|
(let ((parent (make-layout-node)) (child (make-layout-node)))
|
|
(layout-node-add-child parent child)
|
|
(layout-node-remove-child parent child)
|
|
(is (null (layout-node-parent child)))
|
|
(is (= (length (layout-node-children parent)) 0))))
|
|
|
|
(test column-two-children-vertical
|
|
(let* ((root (make-layout-node :direction :column))
|
|
(c1 (make-layout-node :height 3))
|
|
(c2 (make-layout-node :height 5)))
|
|
(layout-node-add-child root c1) (layout-node-add-child root c2)
|
|
(compute-layout root 20 20)
|
|
(is (= (layout-node-y c1) 0)) (is (= (layout-node-height c1) 3))
|
|
(is (= (layout-node-y c2) 3)) (is (= (layout-node-height c2) 5))))
|
|
|
|
(test row-two-children-horizontal
|
|
(let* ((root (make-layout-node :direction :row))
|
|
(c1 (make-layout-node :width 10))
|
|
(c2 (make-layout-node :width 5)))
|
|
(layout-node-add-child root c1) (layout-node-add-child root c2)
|
|
(compute-layout root 20 10)
|
|
(is (= (layout-node-x c1) 0)) (is (= (layout-node-width c1) 10))
|
|
(is (= (layout-node-x c2) 10)) (is (= (layout-node-width c2) 5))))
|
|
|
|
(test flex-grow-distributes-space
|
|
(let* ((root (make-layout-node :direction :row :width 20))
|
|
(c1 (make-layout-node :width 4 :grow 1))
|
|
(c2 (make-layout-node :width 4 :grow 2)))
|
|
(layout-node-add-child root c1) (layout-node-add-child root c2)
|
|
(compute-layout root 20 10)
|
|
(is (= (layout-node-width c1) 8)) (is (= (layout-node-width c2) 12))))
|
|
|
|
(test flex-grow-single-child
|
|
(let* ((root (make-layout-node :direction :row :width 20))
|
|
(c (make-layout-node :width 5 :grow 1)))
|
|
(layout-node-add-child root c)
|
|
(compute-layout root 20 10)
|
|
(is (= (layout-node-width c) 20))))
|
|
|
|
(test flex-shrink-reduces-overflow
|
|
(let* ((root (make-layout-node :direction :row :width 10))
|
|
(c1 (make-layout-node :width 8 :shrink 1))
|
|
(c2 (make-layout-node :width 8 :shrink 1)))
|
|
(layout-node-add-child root c1) (layout-node-add-child root c2)
|
|
(compute-layout root 10 10)
|
|
(is (= (layout-node-width c1) 5)) (is (= (layout-node-width c2) 5))))
|
|
|
|
(test padding-reduces-content-area
|
|
(let* ((root (make-layout-node :direction :column :padding '(:top 1 :left 1 :bottom 1 :right 1)))
|
|
(c (make-layout-node :height 3)))
|
|
(layout-node-add-child root c)
|
|
(compute-layout root 20 10)
|
|
(is (= (layout-node-x c) 1)) (is (= (layout-node-y c) 1))
|
|
(is (= (layout-node-height c) 3))))
|
|
|
|
(test gap-between-children
|
|
(let* ((root (make-layout-node :direction :column :gap 2))
|
|
(c1 (make-layout-node :height 3))
|
|
(c2 (make-layout-node :height 3)))
|
|
(layout-node-add-child root c1) (layout-node-add-child root c2)
|
|
(compute-layout root 20 20)
|
|
(is (= (layout-node-y c1) 0)) (is (= (layout-node-y c2) 5))))
|
|
|
|
(test vbox-macro
|
|
(let ((r (vbox () (make-layout-node :height 3) (make-layout-node :height 5))))
|
|
(compute-layout r 20 20)
|
|
(is (= (length (layout-node-children r)) 2))
|
|
(is (= (layout-node-y (elt (layout-node-children r) 1)) 3))))
|
|
|
|
(test hbox-macro
|
|
(let ((r (hbox () (make-layout-node :width 5) (make-layout-node :width 3))))
|
|
(compute-layout r 20 10)
|
|
(is (= (length (layout-node-children r)) 2))
|
|
(is (= (layout-node-x (elt (layout-node-children r) 1)) 5))))
|
|
|
|
(test spacer-takes-grow
|
|
(let ((r (hbox (:width 20) (make-layout-node :width 5) (spacer :grow 1) (make-layout-node :width 5))))
|
|
(compute-layout r 20 10)
|
|
(let ((c (layout-node-children r)))
|
|
(is (= (layout-node-x (elt c 2)) 15)) (is (= (layout-node-width (elt c 1)) 10)))))
|
|
|
|
(test nested-vbox-in-hbox
|
|
(let* ((sidebar (vbox (:width 5 :height 10) (make-layout-node :height 3) (make-layout-node :height 7)))
|
|
(main (vbox (:grow 1 :height 10) (make-layout-node :height 2) (make-layout-node :grow 1)))
|
|
(r (hbox (:width 30 :height 10) sidebar main)))
|
|
(compute-layout r 30 10)
|
|
(is (= (layout-node-width sidebar) 5))
|
|
(is (>= (layout-node-width main) 20))
|
|
(let ((sc (layout-node-children sidebar)))
|
|
(is (= (layout-node-y (elt sc 0)) 0))
|
|
(is (= (layout-node-y (elt sc 1)) 3)))))
|
|
|
|
;; ── Edge Cases ────────────────────────────────────────────────
|
|
|
|
(test empty-container-does-not-crash
|
|
"compute-layout on a node with no children should not error"
|
|
(let ((r (make-layout-node)))
|
|
(compute-layout r 20 20)
|
|
(is (integerp (layout-node-width r)))
|
|
(is (integerp (layout-node-height r)))))
|
|
|
|
(test single-child-in-column
|
|
"A column with one child places it correctly"
|
|
(let* ((r (make-layout-node :direction :column :width 10 :height 20))
|
|
(c (make-layout-node :height 5)))
|
|
(layout-node-add-child r c)
|
|
(compute-layout r 10 20)
|
|
(is (= (layout-node-y c) 0))
|
|
(is (= (layout-node-height c) 5))))
|
|
|
|
(test zero-size-container
|
|
"compute-layout with zero available space should not error"
|
|
(let* ((r (make-layout-node :direction :column))
|
|
(c (make-layout-node :height 5)))
|
|
(layout-node-add-child r c)
|
|
(compute-layout r 0 0)
|
|
(is (integerp (layout-node-x c)))
|
|
(is (integerp (layout-node-y c)))))
|
|
|
|
(test deep-nesting-three-levels
|
|
"Three-level deep nesting produces correct leaf positions"
|
|
(let* ((out (vbox () ; outer box
|
|
(vbox (:grow 1) ; middle box
|
|
(make-layout-node :height 2)))) ; leaf
|
|
(leaf (elt (layout-node-children
|
|
(elt (layout-node-children out) 0)) 0)))
|
|
(compute-layout out 20 20)
|
|
(is (= (layout-node-y leaf) 0))))
|
|
|
|
(test large-padding-leaves-room
|
|
"Large padding reduces content area but doesn't crash"
|
|
(let* ((r (make-layout-node :direction :column
|
|
:padding '(:top 5 :left 5 :bottom 5 :right 5)))
|
|
(c (make-layout-node :height 3)))
|
|
(layout-node-add-child r c)
|
|
(compute-layout r 20 20)
|
|
(is (= (layout-node-x c) 5))
|
|
(is (= (layout-node-y c) 5))))
|
|
|
|
(test negative-grow-is-clamped
|
|
"Grow values are adjusted but still compute"
|
|
(let* ((r (make-layout-node :direction :row :width 10))
|
|
(c (make-layout-node :width 5 :grow -1)))
|
|
(layout-node-add-child r c)
|
|
(compute-layout r 10 10)
|
|
(is (integerp (layout-node-width c)))))
|