review fixes: 3 blocking bugs + 2 improvements

B1: modern-backend now inherits from backend (was standalone class)
B2: draw-rect y-position bug — loop now tracks row offset
B3: Layout module added to ASDF system definition
I1: 6 smoke tests replaced with behavioral tests (captured output)
I3: 6 edge case tests: empty, single-child, zero-size, deep
    nesting, large padding, negative grow

Also fixed:
- Added missing make-simple-backend constructor to simple.lisp
- Added in-package to classes.lisp and simple.lisp (SBCL's load
  restores *package* after each load, breaking batch-mode loading)
This commit is contained in:
Hermes
2026-05-11 14:08:51 +00:00
parent 2231fb6647
commit 2b6fc32425
6 changed files with 153 additions and 46 deletions

View File

@@ -118,3 +118,58 @@
(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)))))