6cd5a67a35
Load same-basename Elisp companions through the generic preview runner. Demonstrate size semantics and native help, pointer, hover and keymap behavior with isolated example state. Update Flex and Grid examples and extend reusable comparison and interaction evaluators with publication, allocation and fresh-render parity checks. Validation: make check passed, including all 72 Playground tests.
378 lines
18 KiB
EmacsLisp
378 lines
18 KiB
EmacsLisp
;;; ebox-playground-size-tests.el --- Size reference contracts -*- lexical-binding: t; -*-
|
|
|
|
;;; Commentary:
|
|
;; Keep the Size reference executable and verify declarations, arithmetic,
|
|
;; and viewport updates instead of treating descriptive labels as coverage.
|
|
|
|
;;; Code:
|
|
|
|
(require 'ert)
|
|
(require 'cl-lib)
|
|
(require 'ebox-playground)
|
|
(require 'ebox-size)
|
|
(require 'ebox-playground-flex-resize-evaluator
|
|
(expand-file-name "scripts/ebox-playground-flex-resize-evaluator.el"
|
|
ebox-playground-directory))
|
|
|
|
(defconst ebox-playground-size-test--file
|
|
(expand-file-name "examples/size-reference.ebox" ebox-playground-directory)
|
|
"Size reference checked by this suite.")
|
|
|
|
(defun ebox-playground-size-test--form ()
|
|
"Read the actual Size example through the ordinary file boundary."
|
|
(ebox-playground--evaluate-form
|
|
(ebox-playground--read-file ebox-playground-size-test--file)))
|
|
|
|
(defun ebox-playground-size-test--lists (form)
|
|
"Return the nonempty lists recursively contained in FORM."
|
|
(when (consp form)
|
|
(cons form (cl-mapcan #'ebox-playground-size-test--lists form))))
|
|
|
|
(defun ebox-playground-size-test--nodes (form)
|
|
"Return actual DSL nodes in FORM, excluding size expressions."
|
|
(cl-remove-if-not
|
|
(lambda (item) (memq (car item) '(box text row column flex grid)))
|
|
(ebox-playground-size-test--lists form)))
|
|
|
|
(defun ebox-playground-size-test--node (id)
|
|
"Return the actual demonstration node named ID."
|
|
(or (cl-find-if
|
|
(lambda (node) (equal (format "%s" (plist-get (cdr node) :id)) id))
|
|
(ebox-playground-size-test--nodes (ebox-playground-size-test--form)))
|
|
(ert-fail (format "Missing Size demonstration: %s" id))))
|
|
|
|
(defun ebox-playground-size-test--card (id)
|
|
"Return the authored outer card containing demonstration ID."
|
|
(or (cl-find-if
|
|
(lambda (node)
|
|
(and (eq (car node) 'column)
|
|
(plist-get (cdr node) :border)
|
|
(cl-some (lambda (child)
|
|
(equal (plist-get (cdr child) :id) id))
|
|
(ebox-playground-size-test--nodes node))))
|
|
(ebox-playground-size-test--nodes (ebox-playground-size-test--form)))
|
|
(ert-fail (format "Missing Size card: %s" id))))
|
|
|
|
(defun ebox-playground-size-test--color-widths (line color)
|
|
"Return contiguous visible background COLOR widths in rendered LINE."
|
|
(let ((line (ebox-playground-flex-resize-evaluator--visual-text line))
|
|
(start 0) (run 0) widths)
|
|
(while (< start (length line))
|
|
(let ((end (next-single-property-change
|
|
start 'face line (length line))))
|
|
(if (equal (plist-get (get-text-property start 'face line) :background)
|
|
color)
|
|
(setq run (+ run (ebox-string-pixel-width
|
|
(substring line start end))))
|
|
(when (> run 0) (push run widths))
|
|
(setq run 0))
|
|
(setq start end)))
|
|
(when (> run 0) (push run widths))
|
|
(nreverse widths)))
|
|
|
|
(ert-deftest ebox-playground-size-reference-covers-values-in-real-declarations ()
|
|
"Every advertised unit, function, and keyword must occur as executable data."
|
|
(let* ((form (ebox-playground-size-test--form))
|
|
(nodes (ebox-playground-size-test--nodes form))
|
|
(lists (ebox-playground-size-test--lists form)))
|
|
(dolist (unit '(px % vw vh ch lh))
|
|
(should (cl-some (lambda (item)
|
|
(and (eq (car item) unit)
|
|
(= (length item) 2)
|
|
(numberp (cadr item))))
|
|
lists)))
|
|
(dolist (function '(calc min max clamp + - * /))
|
|
(should (cl-some (lambda (item) (eq (car item) function)) lists)))
|
|
(should (cl-some (lambda (item)
|
|
(and (memq (car item) '(px % vw vh ch lh))
|
|
(floatp (cadr item))))
|
|
lists))
|
|
(dolist (property '(:width :height :min-width :min-height
|
|
:max-width :max-height))
|
|
(dolist (value (append
|
|
(if (memq property '(:max-width :max-height))
|
|
'(none) '(auto))
|
|
'(min-content max-content fit-content stretch)))
|
|
(ert-info ((format "Missing actual %S %S demonstration" property value))
|
|
(should (cl-some (lambda (node)
|
|
(and (plist-member (cdr node) property)
|
|
(eq (plist-get (cdr node) property) value)))
|
|
nodes)))))
|
|
(should (ebox-canonical-input-p (ebox-build form)))))
|
|
|
|
(ert-deftest ebox-playground-size-reference-renders-full-document-at-three-widths ()
|
|
"The complete reference remains readable beyond its initially visible page."
|
|
(dolist (width '(320 720 1000))
|
|
(let* ((text (ebox-playground-flex-resize-evaluator--example-text
|
|
ebox-playground-size-test--file width t))
|
|
(lines (ebox-string-lines text)))
|
|
(should (string-match-p "Ebox Size Reference" text))
|
|
(should (> (length lines) 30))
|
|
(dolist (line lines)
|
|
(should (<= (ebox-string-pixel-width line) width))))))
|
|
|
|
(ert-deftest ebox-playground-size-reference-expressions-have-known-results ()
|
|
"Check the example's actual expressions against independent reference values."
|
|
(let ((context '(:percent-base 220 :viewport-width 800 :viewport-height 600
|
|
:ch 8 :lh 20)))
|
|
(dolist (case '(("size-px" :width 180)
|
|
("size-percent" :width 110)
|
|
("size-vw" :width 160)
|
|
("size-ch" :width 96)
|
|
("size-lh" :height 40)
|
|
("size-vh" :height 60)
|
|
("size-calc" :width 196)
|
|
("size-min" :width 100)
|
|
("size-max" :width 110)
|
|
("size-arithmetic" :width 60)
|
|
("size-nested" :width 160)))
|
|
(let* ((node (ebox-playground-size-test--node (car case)))
|
|
(expression (plist-get (cdr node) (cadr case))))
|
|
(ert-info ((format "Size demo %s: %S" (car case) expression))
|
|
(should (= (ebox-size-resolve expression context) (nth 2 case))))))
|
|
(should (= (ebox-size-resolve
|
|
(plist-get (cdr (ebox-playground-size-test--node
|
|
"size-percent-parent")) :width)
|
|
context)
|
|
222))))
|
|
|
|
(ert-deftest ebox-playground-size-reference-labels-keep-a-common-font ()
|
|
"Only the title is bold and only measured font samples change text size."
|
|
(let ((nodes (ebox-playground-size-test--nodes
|
|
(ebox-playground-size-test--form)))
|
|
font-samples bold-nodes)
|
|
(dolist (node nodes)
|
|
(when (plist-member (cdr node) :font-size)
|
|
(push (plist-get (cdr node) :id) font-samples))
|
|
(when (eq (plist-get (cdr node) :font-weight) 'bold)
|
|
(push node bold-nodes))
|
|
(should-not (plist-member (cdr node) :padding-block)))
|
|
(should (equal (sort font-samples #'string-lessp)
|
|
'("size-font-large" "size-font-small")))
|
|
(should (= (length bold-nodes) 1))
|
|
(should (equal (car (last (car bold-nodes))) "Ebox Size Reference"))))
|
|
|
|
(ert-deftest ebox-playground-size-reference-card-and-target-widths-match-copy ()
|
|
"Actual borders and colored targets use the stated 220/112 px references."
|
|
(dolist (case '(("size-percent" "#D97757" 222 110)
|
|
("size-calc" "#AFA3D1" 222 196)
|
|
("size-max" "#AFA3D1" 222 110)
|
|
("size-width-auto" "#7DB8CE" 114 112)
|
|
("size-width-stretch" "#7DB8CE" 114 112)
|
|
("size-max-width-none" "#7DB8CE" 114 112)))
|
|
(let* ((text (ebox-render
|
|
(ebox-build (ebox-playground-size-test--card (car case)))))
|
|
(lines (ebox-string-lines text))
|
|
(target-widths
|
|
(cl-mapcan (lambda (line)
|
|
(ebox-playground-size-test--color-widths
|
|
line (nth 1 case)))
|
|
lines)))
|
|
(ert-info ((format "Card %s" (car case)))
|
|
(should (cl-every (lambda (line)
|
|
(= (ebox-string-pixel-width line) (nth 2 case)))
|
|
lines))
|
|
(should (equal target-widths (make-list 2 (nth 3 case))))))))
|
|
|
|
(ert-deftest ebox-playground-size-reference-clipping-and-box-model-match-copy ()
|
|
"Descriptions must agree with real clipping and visible box-model content."
|
|
(dolist (id '("size-fractional-height" "size-whole-height"))
|
|
(let ((text (ebox-render
|
|
(ebox-build (ebox-playground-size-test--node id)))))
|
|
(should (= (ebox-string-height text) 2))
|
|
(should (string-match-p "line one" text))
|
|
(should (string-match-p "line two" text))
|
|
(should-not (string-match-p "line three" text))))
|
|
(let ((text (ebox-render
|
|
(ebox-build (ebox-playground-size-test--node "size-box-model")))))
|
|
(should (string-match-p "padding" text))
|
|
(should (string-match-p "inside the border" text)))
|
|
(let ((width (plist-get
|
|
(cdr (ebox-playground-size-test--node "size-fractional-width"))
|
|
:width)))
|
|
(should (= (ebox-size-resolve width '(:viewport-width 853)) 102.36))))
|
|
|
|
(ert-deftest ebox-playground-size-reference-height-equivalence-is-intentional ()
|
|
"Content height keywords agree, while lower bounds and stretch differ."
|
|
(dolist (property '("height" "min-height" "max-height"))
|
|
(dolist (keyword (cons (if (equal property "max-height") "none" "auto")
|
|
'("min-content" "max-content" "fit-content" "stretch")))
|
|
(let* ((id (format "size-%s-%s" property keyword))
|
|
(text (ebox-render
|
|
(ebox-build (ebox-playground-size-test--card id))))
|
|
(colored-lines
|
|
(cl-count-if
|
|
(lambda (line)
|
|
(ebox-playground-size-test--color-widths line "#D9C46D"))
|
|
(ebox-string-lines text)))
|
|
(expected (cond ((member keyword '("stretch" "none")) 5)
|
|
((and (equal property "min-height")
|
|
(equal keyword "auto")) 1)
|
|
(t 3))))
|
|
(ert-info ((format "%s visible height" id))
|
|
(should (= colored-lines expected)))))))
|
|
|
|
(ert-deftest ebox-playground-size-reference-long-content-shows-three-widths ()
|
|
"The same constrained text visibly separates all three intrinsic widths."
|
|
(let ((widths
|
|
(mapcar
|
|
(lambda (keyword)
|
|
(let* ((id (concat "size-width-long-" keyword))
|
|
(text (ebox-render
|
|
(ebox-build (ebox-playground-size-test--card id))))
|
|
(runs (cl-mapcan
|
|
(lambda (line)
|
|
(ebox-playground-size-test--color-widths
|
|
line "#7DB8CE"))
|
|
(ebox-string-lines text))))
|
|
;; Width, minimum, and maximum samples share one card.
|
|
(should (= (length runs) 12))
|
|
(should (cl-every (lambda (width) (= width (car runs))) runs))
|
|
;; All words survive all three constraints without being split
|
|
;; using the obsolete preferred width or clipped from the box.
|
|
(dolist (word '("red" "ink" "blue"))
|
|
(should (= (length (split-string text word)) 4)))
|
|
(car runs)))
|
|
'("min-content" "fit-content" "max-content"))))
|
|
(should (< (nth 0 widths) (nth 1 widths) (nth 2 widths)))
|
|
(should (= (nth 0 widths) (ebox-string-pixel-width "blue")))
|
|
(should (= (nth 1 widths) (* 8 (ebox-string-pixel-width "0"))))
|
|
(should (= (nth 2 widths) (ebox-string-pixel-width "red ink on blue")))))
|
|
|
|
(ert-deftest ebox-playground-size-reference-row-distinguishes-auto-and-stretch ()
|
|
"Row context makes automatic content sizing visibly shorter than stretch."
|
|
(let ((widths
|
|
(mapcar
|
|
(lambda (keyword)
|
|
(let* ((text (ebox-render
|
|
(ebox-build
|
|
(ebox-playground-size-test--card
|
|
(concat "size-width-row-" keyword)))))
|
|
(runs (cl-mapcan
|
|
(lambda (line)
|
|
(ebox-playground-size-test--color-widths
|
|
line "#7DB8CE"))
|
|
(ebox-string-lines text))))
|
|
(should runs)
|
|
(should (cl-every (lambda (width) (= width (car runs))) runs))
|
|
(car runs)))
|
|
'("auto" "stretch"))))
|
|
(should (< (car widths) (cadr widths)))
|
|
(should (= (car widths) (ebox-string-pixel-width "red ink")))
|
|
(should (= (cadr widths) 112))))
|
|
|
|
(ert-deftest ebox-playground-size-reference-functions-show-boundary-transitions ()
|
|
"Actual rendered bars distinguish capping, flooring, and both constraints."
|
|
(dolist (case '(("min" 24 96 144) ("max" 48 96 192)
|
|
("clamp" 48 96 144)))
|
|
(cl-mapc
|
|
(lambda (regime expected)
|
|
(let* ((id (format "size-function-%s-%s" (car case) regime))
|
|
(text (ebox-render
|
|
(ebox-build (ebox-playground-size-test--node id)))))
|
|
(ert-info ((format "%s rendered extent" id))
|
|
(should (= (apply #'max (mapcar #'ebox-string-pixel-width
|
|
(ebox-string-lines text)))
|
|
expected)))))
|
|
'("low" "mid" "high") (cdr case))))
|
|
|
|
(ert-deftest ebox-playground-size-reference-units-reach-painted-sizes ()
|
|
"Verify units and percentages in actual parent and viewport contexts."
|
|
(let ((ebox-viewport-width 800) (ebox-viewport-height 40))
|
|
(dolist (case '(("size-percent" "#D97757" 110 2)
|
|
("size-vw" "#D97757" 160 2)
|
|
("size-ch" "#D97757" 12 2)
|
|
("size-lh" "#D97757" 220 2)
|
|
("size-vh" "#D97757" 220 4)
|
|
("size-percent-height" "#8FAF95" 220 3)))
|
|
(let* ((text (ebox-render
|
|
(ebox-build (ebox-playground-size-test--card (car case)))))
|
|
(runs (cl-mapcan
|
|
(lambda (line)
|
|
(ebox-playground-size-test--color-widths line (nth 1 case)))
|
|
(ebox-string-lines text)))
|
|
(width (if (equal (car case) "size-ch")
|
|
(min 220 (* 12 (ebox-string-pixel-width "0")))
|
|
(nth 2 case))))
|
|
(ert-info ((format "%s painted size" (car case)))
|
|
(should (equal runs (make-list (nth 3 case) width))))))))
|
|
|
|
(ert-deftest ebox-playground-size-reference-flex-growth-has-visible-shares ()
|
|
"Equal bases expose spare-space growth without font-dependent wrapping."
|
|
(let* ((ebox-viewport-width 220)
|
|
(text (ebox-render
|
|
(ebox-build (ebox-playground-size-test--node "size-flex-grow"))))
|
|
(lines (ebox-string-lines text)))
|
|
(should (= (length lines) 2))
|
|
(dolist (line lines)
|
|
(should (= (ebox-string-pixel-width line) 220))
|
|
(should (equal (ebox-playground-size-test--color-widths line "#9FD5CB")
|
|
'(80)))
|
|
(should (equal (ebox-playground-size-test--color-widths line "#71BDB0")
|
|
'(130))))))
|
|
|
|
(ert-deftest ebox-playground-size-reference-grid-paint-shows-complete-tracks ()
|
|
"Cell backgrounds expose both lines of each track and leave the gap clear."
|
|
(let* ((ebox-viewport-width 220)
|
|
(text (ebox-render
|
|
(ebox-build (ebox-playground-size-test--node "size-grid"))))
|
|
(lines (ebox-string-lines text))
|
|
(ch (ebox-string-pixel-width "0")))
|
|
(should (= (length lines) 5))
|
|
(cl-loop for line in lines for index from 0 do
|
|
(should (= (ebox-string-pixel-width line) 220))
|
|
(dolist (case `(("#9FD5CB" . ,(* 8 ch))
|
|
("#71BDB0" . ,(- 220 (* 9 ch)))))
|
|
(should (equal
|
|
(ebox-playground-size-test--color-widths line (car case))
|
|
(unless (= index 2) (list (cdr case)))))))))
|
|
|
|
(ert-deftest ebox-playground-size-reference-clamp-reaches-all-three-regimes ()
|
|
"The responsive clamp demo must exercise its minimum, fluid value, and cap."
|
|
(let ((expression (plist-get
|
|
(cdr (ebox-playground-size-test--node "size-clamp"))
|
|
:width)))
|
|
(dolist (case '((300 . 48) (800 . 96) (2000 . 200)))
|
|
(should (= (ebox-size-resolve expression
|
|
(list :viewport-width (car case)))
|
|
(cdr case))))))
|
|
|
|
(ert-deftest ebox-playground-size-reference-fixed-demos-render-their-extents ()
|
|
"Fixed pixel and line demonstrations must reach the public renderer intact."
|
|
(dolist (case '(("size-px" . 180) ("size-arithmetic" . 60)))
|
|
(let ((text (ebox-render
|
|
(ebox-build (ebox-playground-size-test--node (car case))))))
|
|
(should (= (apply #'max (mapcar #'ebox-string-pixel-width
|
|
(ebox-string-lines text)))
|
|
(cdr case)))))
|
|
(should (= (ebox-string-height
|
|
(ebox-render (ebox-build
|
|
(ebox-playground-size-test--node "size-lh"))))
|
|
2)))
|
|
|
|
(ert-deftest ebox-playground-size-reference-retained-resize-matches-fresh-render ()
|
|
"Changing both viewport axes must update responsive sizes without stale output."
|
|
(let ((buffer (generate-new-buffer " *ebox-size-reference-test*"))
|
|
(ebox-runtime-idle-prewarm nil)
|
|
(ebox-runtime-idle-reflow-cache-prewarm nil))
|
|
(unwind-protect
|
|
(let ((ebox-viewport-width 720) (ebox-viewport-height 36))
|
|
(ebox-render-to-buffer
|
|
buffer (ebox-playground-view ebox-playground-size-test--file 720))
|
|
(dolist (size '((1000 48) (480 24) (720 36)))
|
|
(let* ((ebox-viewport-width (car size))
|
|
(ebox-viewport-height (cadr size))
|
|
(fresh (ebox-render
|
|
(ebox-playground-view
|
|
ebox-playground-size-test--file (car size)))))
|
|
(ebox-rerender-buffer-with-context buffer (car size) (cadr size))
|
|
(should
|
|
(equal-including-properties
|
|
(ebox-playground-flex-resize-evaluator--visual-text fresh)
|
|
(ebox-playground-flex-resize-evaluator--visual-text
|
|
(with-current-buffer buffer (buffer-string))))))))
|
|
(when (buffer-live-p buffer) (kill-buffer buffer)))))
|
|
|
|
(provide 'ebox-playground-size-tests)
|
|
;;; ebox-playground-size-tests.el ends here
|