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.
1152 lines
55 KiB
EmacsLisp
1152 lines
55 KiB
EmacsLisp
;;; ebox-playground-tests.el --- Public Ebox example tests -*- lexical-binding: t; -*-
|
|
|
|
(require 'ert)
|
|
(require 'cl-lib)
|
|
(require 'ebox-playground)
|
|
(require 'ebox-playground-flex-resize-evaluator
|
|
(expand-file-name "scripts/ebox-playground-flex-resize-evaluator.el"
|
|
ebox-playground-directory))
|
|
|
|
(defconst ebox-playground-test--fixtures
|
|
'("flex-reference.ebox" "grid-reference.ebox" "size-reference.ebox")
|
|
"Migrated and maintained `.ebox' fixtures in the playground package.")
|
|
|
|
(defun ebox-playground-test--dynamic-width ()
|
|
"Return a list-valued width from an ordinary Elisp expression."
|
|
'(px 240))
|
|
|
|
(defun ebox-playground-test--dynamic-color ()
|
|
"Return a color from an ordinary Elisp expression."
|
|
"#123456")
|
|
|
|
(defun ebox-playground-test--read-layout (file)
|
|
"Read and evaluate the layout expression in FILE."
|
|
(ebox-playground--evaluate-form (ebox-playground--read-file file) file))
|
|
|
|
(defun ebox-playground-test--boxes (form)
|
|
"Return every nested BOX form in FORM."
|
|
(when (consp form)
|
|
(append (when (eq (car form) 'box)
|
|
(list form))
|
|
(cl-mapcan #'ebox-playground-test--boxes form))))
|
|
|
|
(defun ebox-playground-test--forms-named (name form)
|
|
"Return every nested DSL form in FORM whose head is NAME."
|
|
(when (consp form)
|
|
(append (when (eq (car form) name)
|
|
(list form))
|
|
(cl-mapcan (lambda (child)
|
|
(ebox-playground-test--forms-named name child))
|
|
form))))
|
|
|
|
(defun ebox-playground-test--form-children (form)
|
|
"Return canonical author children from DSL FORM."
|
|
(let ((items (cdr form)))
|
|
(while (keywordp (car items))
|
|
(setq items (cddr items)))
|
|
items))
|
|
|
|
(defun ebox-playground-test--separator-form-p (form)
|
|
"Return non-nil for an empty gallery separator FORM, regardless of defaults."
|
|
(and (eq (car-safe form) 'box)
|
|
(null (ebox-playground-test--form-children form))
|
|
(equal (plist-get (cdr form) :bgcolor) "#FAF7F0")))
|
|
|
|
(defun ebox-playground-test--line-widths (text)
|
|
"Return rendered pixel widths for every line in TEXT."
|
|
(mapcar #'ebox-string-pixel-width
|
|
(ebox-string-lines text)))
|
|
|
|
(defun ebox-playground-test--max-line-width (text)
|
|
"Return the widest rendered pixel line in TEXT."
|
|
(apply #'max (ebox-playground-test--line-widths text)))
|
|
|
|
(defun ebox-playground-test--absolute-space-width (line)
|
|
"Return LINE's explicit pixel space width, preserving fractional precision."
|
|
(pcase (get-text-property 0 'display line)
|
|
(`(space :width (,width)) (and (numberp width) width))))
|
|
|
|
(defconst ebox-playground-test--grid-value-forms
|
|
'(":grid-template-columns (auto auto)"
|
|
":grid-template-columns (min-content max-content)"
|
|
":grid-template-columns ((px 120) (px 74))"
|
|
":padding-inline (px 2)"
|
|
":grid-template-columns ((px 192))"
|
|
":grid-template-columns ((px 88) (px 88))"
|
|
":grid-template-columns ((fr 1) (fr 2))"
|
|
":grid-template-columns ((minmax"
|
|
":grid-template-columns ((repeat"
|
|
":grid-template-rows (auto auto)"
|
|
":grid-template-rows ((fr 1) (fr 2))"
|
|
":grid-auto-columns ((px 64))"
|
|
":grid-auto-columns auto"
|
|
":grid-auto-columns (fr 1)"
|
|
":grid-auto-columns ((minmax"
|
|
":grid-auto-rows (lh 2)"
|
|
":grid-auto-rows auto"
|
|
":grid-auto-rows (fr 1)"
|
|
":grid-auto-rows ((minmax"
|
|
":grid-auto-flow row"
|
|
":grid-auto-flow column"
|
|
":gap ((lh 1) (ch 1))"
|
|
":gap ((lh 1) (px 14))"
|
|
":row-gap (lh 2)"
|
|
":column-gap (px 28)"
|
|
":grid-column 2"
|
|
":grid-row 2"
|
|
":grid-column (1 :span 2)"
|
|
":grid-row (1 :span 2)"
|
|
":grid-column (1 3)"
|
|
":grid-row (1 3)"
|
|
":grid-column-span 2"
|
|
":grid-row-span 2"
|
|
":justify-items start"
|
|
":justify-items center"
|
|
":justify-items end"
|
|
":justify-items stretch"
|
|
":align-items start"
|
|
":align-items center"
|
|
":align-items end"
|
|
":align-items stretch"
|
|
":align-items normal"
|
|
":justify-content start"
|
|
":justify-content center"
|
|
":justify-content end"
|
|
":justify-content space-between"
|
|
":justify-content space-around"
|
|
":justify-content space-evenly"
|
|
":justify-content stretch"
|
|
":justify-content normal"
|
|
":align-content start"
|
|
":align-content center"
|
|
":align-content end"
|
|
":align-content space-between"
|
|
":align-content space-around"
|
|
":align-content space-evenly"
|
|
":align-content stretch"
|
|
":align-content normal")
|
|
"Public Grid property/value fragments required in the reference fixture.")
|
|
|
|
(ert-deftest ebox-playground-tinted-content-has-effective-ink ()
|
|
"Tinted fixture text should have effective ink, including inherited colors."
|
|
(dolist (file ebox-playground-test--fixtures)
|
|
(let* ((text (ebox-playground-flex-resize-evaluator--example-text
|
|
(expand-file-name (concat "examples/" file)
|
|
ebox-playground-directory)
|
|
720 t))
|
|
(normalized (ebox-playground-flex-resize-evaluator--visual-text text)))
|
|
(dotimes (index (length normalized))
|
|
(when (string-match-p "[^[:space:]]" (substring normalized index (1+ index)))
|
|
(let ((face (get-text-property index 'face normalized)))
|
|
(when (plist-get face :background)
|
|
(should (stringp (plist-get face :foreground))))))))))
|
|
|
|
(ert-deftest ebox-playground-visual-comparison-merges-effective-faces ()
|
|
"Equivalent face grouping and runtime identities should not create differences."
|
|
(let ((before (propertize "text" 'face
|
|
'((:foreground "red" :height 1.5)
|
|
(:foreground "blue" :background "white" :height 120))
|
|
'ebox-content-idx 1))
|
|
(after (propertize "text" 'face
|
|
'(:height 180 :background "white" :foreground "red")
|
|
'ebox-content-idx 9)))
|
|
(should (equal-including-properties
|
|
(ebox-playground-flex-resize-evaluator--visual-text before)
|
|
(ebox-playground-flex-resize-evaluator--visual-text after)))))
|
|
|
|
(ert-deftest ebox-playground-visual-comparison-preserves-visible-and-interactive-changes ()
|
|
"Face, geometry, text, and interaction differences must survive normalization."
|
|
(dolist (values '((face (:foreground "red") (:foreground "blue"))
|
|
(face (:height 120) (:height 180))
|
|
(display (space :width (80)) (space :width (81)))
|
|
(help-echo "first action" "second action")
|
|
(keymap (keymap (13 . first-command))
|
|
(keymap (13 . second-command)))
|
|
(mouse-face (:foreground "red") (:foreground "blue"))))
|
|
(should-not
|
|
(equal-including-properties
|
|
(ebox-playground-flex-resize-evaluator--visual-text
|
|
(propertize "text" (nth 0 values) (nth 1 values)))
|
|
(ebox-playground-flex-resize-evaluator--visual-text
|
|
(propertize "text" (nth 0 values) (nth 2 values))))))
|
|
(should-not
|
|
(equal-including-properties
|
|
(ebox-playground-flex-resize-evaluator--visual-text "text")
|
|
(ebox-playground-flex-resize-evaluator--visual-text "changed"))))
|
|
|
|
(ert-deftest ebox-playground-spacer-auto-width-and-inherited-color-render-equally ()
|
|
"Explicit spacer height and inherited ink retain geometry and local overrides."
|
|
(let* ((ebox-viewport-width 720)
|
|
(explicit
|
|
'(column :width (px 240)
|
|
(box :width stretch :height (lh 1) :bgcolor "#FAF7F0")
|
|
(box :color "#123456" :bgcolor "#FFFFFF" "Inherited ink")
|
|
(box :color "#654321" :bgcolor "#FFFFFF" "Local ink")))
|
|
(inherited
|
|
'(column :width (px 240) :color "#123456"
|
|
(box :height (lh 1) :bgcolor "#FAF7F0")
|
|
(box :bgcolor "#FFFFFF" "Inherited ink")
|
|
(box :color "#654321" :bgcolor "#FFFFFF" "Local ink")))
|
|
(before (ebox-playground-flex-resize-evaluator--visual-text
|
|
(ebox-render (ebox-build explicit))))
|
|
(after (ebox-playground-flex-resize-evaluator--visual-text
|
|
(ebox-render (ebox-build inherited)))))
|
|
(should (equal-including-properties before after))
|
|
(should (equal (plist-get
|
|
(get-text-property (string-match "Local ink" after) 'face after)
|
|
:foreground)
|
|
"#654321"))))
|
|
|
|
(ert-deftest ebox-playground-uses-only-public-layout-apis ()
|
|
"The example should build and render through the public Ebox entry point."
|
|
(let* ((source (ebox-playground-test--read-layout
|
|
ebox-playground-default-file))
|
|
(node (ebox-playground-view))
|
|
(rendered (substring-no-properties (ebox-render node))))
|
|
(should (eq (car source) 'column))
|
|
(dolist (label '("Ebox CSS Grid Reference" "Container property:"
|
|
"120 PX"))
|
|
(should (string-match-p (regexp-quote label) rendered)))))
|
|
|
|
(ert-deftest ebox-playground-flex-evaluator-uses-public-observation ()
|
|
"Keep the Flex resize gate on public Ebox reports without advice."
|
|
(let* ((source (with-temp-buffer
|
|
(insert-file-contents
|
|
(expand-file-name
|
|
"scripts/ebox-playground-flex-resize-evaluator.el"
|
|
ebox-playground-directory))
|
|
(buffer-string)))
|
|
(resize-source
|
|
(with-temp-buffer
|
|
(insert source)
|
|
(goto-char (point-min))
|
|
;; The shared file also contains private scroll diagnostics and
|
|
;; declarative property-name metadata. Guard every resize function
|
|
;; and helper body, rather than unrelated top-level forms.
|
|
(let (functions)
|
|
(condition-case nil
|
|
(while t
|
|
(let ((form (read (current-buffer))))
|
|
(when (and (eq (car-safe form) 'defun)
|
|
(string-prefix-p
|
|
"ebox-playground-flex-resize-evaluator-"
|
|
(symbol-name (cadr form))))
|
|
(push form functions))))
|
|
(end-of-file nil))
|
|
;; Inspect API use, allowing this quoted render metadata name.
|
|
;; The oracle canonicalizes its ids; it does not call an Ebox
|
|
;; private function or read mutable runtime state through it.
|
|
(prin1-to-string
|
|
(cl-subst '(quote hover-owner-metadata)
|
|
'(quote ebox--hover-style)
|
|
(nreverse functions) :test #'equal)))))
|
|
(runner (with-temp-buffer
|
|
(insert-file-contents
|
|
(expand-file-name "scripts/flex-resize-evaluator.sh"
|
|
ebox-playground-directory))
|
|
(buffer-string)))
|
|
(makefile (with-temp-buffer
|
|
(insert-file-contents
|
|
(expand-file-name "Makefile" ebox-playground-directory))
|
|
(buffer-string))))
|
|
(should (string-match-p "ebox-playground-flex-resize-evaluator-run"
|
|
resize-source))
|
|
(should (string-match-p "ebox-buffer-set-observer" resize-source))
|
|
(should (string-match-p "evaluator-warmup-count 5" source))
|
|
(should (string-match-p "evaluator-sample-count 30" source))
|
|
(should (string-match-p "per-update p95 budget" source))
|
|
(should (string-match-p "EBOX_PLAYGROUND_FLEX_FIXTURE" runner))
|
|
(should (string-match-p "show HEAD:examples/flex-reference.ebox" runner))
|
|
(should (string-match-p "performance-prepare:" makefile))
|
|
(should (string-match-p "native-build" makefile))
|
|
(should-not (string-match-p "-l \"\$root/ebox-playground.el\"" runner))
|
|
(dolist (private '("ebox--" "advice-add" "advice-remove"
|
|
"ebox-native-reflow--"))
|
|
(should-not (string-match-p (regexp-quote private) resize-source)))))
|
|
|
|
(ert-deftest ebox-playground-keeps-layout-in-ebox-source ()
|
|
"Keep concrete gallery content out of the generic Elisp runner."
|
|
(let ((runner (with-temp-buffer
|
|
(insert-file-contents
|
|
(expand-file-name "ebox-playground.el"
|
|
ebox-playground-directory))
|
|
(buffer-string))))
|
|
(should (file-readable-p ebox-playground-default-file))
|
|
(should (string-suffix-p ".ebox" ebox-playground-default-file))
|
|
(should-not (string-match-p "FIXED TRACK" runner))
|
|
(should-not (string-match-p "PUBLIC COMPOSITION" runner))
|
|
(should-not (string-match-p "GRID TOOLKIT" runner))))
|
|
|
|
(ert-deftest ebox-playground-migrated-fixtures-render-at-the-canvas-width ()
|
|
"Every migrated fixture should render through the generic file boundary."
|
|
(let ((ebox-viewport-width 720))
|
|
(dolist (file ebox-playground-test--fixtures)
|
|
(let* ((path (expand-file-name (concat "examples/" file)
|
|
ebox-playground-directory))
|
|
(text (substring-no-properties
|
|
(ebox-render (ebox-playground-view path))))
|
|
(widths (mapcar #'ebox-string-pixel-width
|
|
(ebox-string-lines text))))
|
|
(should (file-readable-p path))
|
|
(should (stringp text))
|
|
(should (cl-every (lambda (width) (<= width 720)) widths))))))
|
|
|
|
(ert-deftest ebox-playground-flex-reference-uses-a-compact-default-viewport ()
|
|
"The public Flex file entry point should use the compact default viewport."
|
|
(let ((path (expand-file-name "examples/flex-reference.ebox"
|
|
ebox-playground-directory))
|
|
(name " *ebox-playground-flex-viewport-test*"))
|
|
(unwind-protect
|
|
(progn
|
|
(ebox-playground-open-file path name)
|
|
(with-current-buffer name
|
|
(let ((widths (mapcar #'ebox-string-pixel-width
|
|
(ebox-string-lines (buffer-string)))))
|
|
(should (cl-every (lambda (width) (<= width 720)) widths)))))
|
|
(ebox-playground-close name))))
|
|
|
|
(ert-deftest ebox-playground-flex-reference-owns-document-scrolling ()
|
|
"The Flex reference root must expose one line-oriented Ebox scroll owner."
|
|
(let ((path (expand-file-name "examples/flex-reference.ebox"
|
|
ebox-playground-directory))
|
|
(name " *ebox-playground-flex-scroll-owner-test*"))
|
|
(unwind-protect
|
|
(let ((ebox-viewport-width 720)
|
|
(ebox-viewport-height 36))
|
|
(ebox-playground-open-file path name)
|
|
(with-current-buffer name
|
|
(let* ((state (ebox--buffer-render-state (current-buffer)))
|
|
(table (plist-get state :scroll-state-table))
|
|
(region-id
|
|
(car
|
|
(sort (copy-sequence
|
|
(plist-get state :scroll-region-ids))
|
|
(lambda (left right)
|
|
(> (- (length (plist-get
|
|
(gethash left table)
|
|
:content-lines))
|
|
(plist-get (gethash left table)
|
|
:content-height))
|
|
(- (length (plist-get
|
|
(gethash right table)
|
|
:content-lines))
|
|
(plist-get (gethash right table)
|
|
:content-height))))))))
|
|
(should region-id)
|
|
(should (= (ebox--scroll-region-by region-id 1 1) 1))
|
|
(setq table
|
|
(plist-get (ebox--buffer-render-state (current-buffer))
|
|
:scroll-state-table))
|
|
(should (= (plist-get (gethash region-id table) :scroll-offset)
|
|
1)))))
|
|
(ebox-playground-close name))))
|
|
|
|
(ert-deftest ebox-playground-evaluator-normalizes-hover-owner-identities ()
|
|
"Fresh ids compare equally without discarding paint or owner partitions."
|
|
(let* ((normalize #'ebox-playground-flex-resize-evaluator--visual-text)
|
|
(left (propertize "AB" 'ebox--hover-style
|
|
'(:owner 22 :face (:background "red")
|
|
:base (:foreground "white"))))
|
|
(fresh (propertize "AB" 'ebox--hover-style
|
|
'(:owner 96 :face (:background "red")
|
|
:base (:foreground "white")))))
|
|
(should (equal-including-properties
|
|
(funcall normalize left) (funcall normalize fresh)))
|
|
(should (= (plist-get (get-text-property 0 'ebox--hover-style left) :owner) 22))
|
|
(dolist (declaration '((:owner 96 :face (:background "blue")
|
|
:base (:foreground "white"))
|
|
(:owner 96 :face (:background "red")
|
|
:base (:foreground "black"))
|
|
(:owner 97 :face (:background "red")
|
|
:base (:foreground "white"))))
|
|
(let ((changed (copy-sequence fresh)))
|
|
(put-text-property 1 2 'ebox--hover-style declaration changed)
|
|
(should-not (equal-including-properties
|
|
(funcall normalize left) (funcall normalize changed)))))))
|
|
|
|
(ert-deftest ebox-playground-interaction-evaluator-measures-and-cleans ()
|
|
"Native repeated commands report their work and release temporary state."
|
|
(let ((file (make-temp-file "ebox-interaction-evaluator-" nil ".ebox"))
|
|
(buffers (buffer-list))
|
|
(windows (window-state-get))
|
|
(functions
|
|
(mapcar (lambda (symbol) (cons symbol (symbol-function symbol)))
|
|
'(ebox--render-layout ebox-surface--surface-plan
|
|
ebox-surface--rendered-fragments ebox-surface--ensure-node-tree))))
|
|
(unwind-protect
|
|
(progn
|
|
(with-temp-file file
|
|
(prin1
|
|
'(let ((count 0))
|
|
(list 'column :width '(px 120)
|
|
(list 'text :id "count" "00")
|
|
(list 'text :keymap
|
|
(ebox-keymap-create
|
|
:activate
|
|
(lambda ()
|
|
(ebox-region-update
|
|
"count" :content (format "%02d" (cl-incf count)))))
|
|
"Add")))
|
|
(current-buffer)))
|
|
(let ((report (ebox-playground-interaction-evaluator-run
|
|
file "Add" "RET" 3 120 8)))
|
|
(should (plist-get report :fresh-parity))
|
|
(should (string-match-p "03" (plist-get report :text)))
|
|
(should (= (plist-get report :publications) 3))
|
|
(dolist (key '(:mean-ms :p95-ms :max-ms :gc-count :gc-ms :cons-cells
|
|
:layout-calls :surface-plans :fragment-scans
|
|
:fragment-characters :node-registrations))
|
|
(should (>= (plist-get report key) 0))))
|
|
(cl-letf (((symbol-function 'ebox-region-update)
|
|
(lambda (&rest _) (error "Injected command failure"))))
|
|
(should-error (ebox-playground-interaction-evaluator-run
|
|
file "Add" "RET" 3 120 8)))
|
|
(should-error (ebox-playground-interaction-evaluator-run
|
|
file "Missing" "RET" 3 120 8))
|
|
(should (equal buffers (buffer-list)))
|
|
(should (equal windows (window-state-get)))
|
|
(dolist (entry functions)
|
|
(should (eq (cdr entry) (symbol-function (car entry))))))
|
|
(delete-file file))))
|
|
|
|
(ert-deftest ebox-playground-scroll-evaluator-preserves-live-runtime ()
|
|
"Profiling multiple files preserves existing mounts, windows, and timers."
|
|
(let ((file (make-temp-file "ebox-scroll-evaluator-" nil ".ebox"))
|
|
(live (generate-new-buffer " *ebox-scroll-evaluator-live-test*"))
|
|
(ebox-runtime-idle-prewarm nil)
|
|
(ebox-runtime-idle-reflow-cache-prewarm nil)
|
|
(ebox-scroll-lazy-idle-prefetch-lines 0)
|
|
(layout '(column :width (px 120) :height (lh 4) :overflow scroll
|
|
(box "0\n1\n2\n3\n4\n5\n6\n7\n8\n9\n10\n11"))))
|
|
(unwind-protect
|
|
(progn
|
|
(with-temp-file file (prin1 (list 'quote layout) (current-buffer)))
|
|
(ebox-render-to-buffer live (ebox-build layout))
|
|
(let* ((runtime (ebox--buffer-render-state live))
|
|
(region-id
|
|
(plist-get (plist-get runtime :root-node) :region-id))
|
|
(scroll-state (ebox--scroll-get-state region-id))
|
|
(contents (with-current-buffer live (buffer-string)))
|
|
(windows (window-state-get))
|
|
(buffers (buffer-list))
|
|
(timer (run-at-time 3600 nil #'ignore))
|
|
(ebox--deferred-render-gc-timer timer))
|
|
(unwind-protect
|
|
(let* ((standard-output (lambda (_character)))
|
|
;; Exercise the GUI GC lease without displaying a buffer.
|
|
(noninteractive nil)
|
|
(reports (ebox-playground-scroll-evaluator-run
|
|
(list file file) 121 3 8)))
|
|
(should (= (length reports) 4))
|
|
(should (equal (mapcar (lambda (report)
|
|
(plist-get report :position))
|
|
reports)
|
|
'(top middle top middle)))
|
|
(dolist (report reports)
|
|
(should (plist-get report :fresh-render-parity))
|
|
(should (= (plist-get report :steps) 3))
|
|
(dolist (key '(:mean-ms :p95-ms :max-ms :root-renders
|
|
:node-styles :style-computations))
|
|
(should (>= (plist-get report key) 0))))
|
|
(should (eq runtime (ebox--buffer-render-state live)))
|
|
(should (eq scroll-state (ebox--scroll-get-state region-id)))
|
|
(should (equal-including-properties
|
|
contents (with-current-buffer live (buffer-string))))
|
|
(should (equal windows (window-state-get)))
|
|
(should (equal buffers (buffer-list)))
|
|
(should (eq ebox--deferred-render-gc-timer timer))
|
|
(should (memq timer timer-list)))
|
|
(cancel-timer timer))))
|
|
(when (buffer-live-p live) (kill-buffer live))
|
|
(delete-file file))))
|
|
|
|
(ert-deftest ebox-playground-scroll-evaluator-cleans-after-scroll-error ()
|
|
"A measured scroll failure removes advice and the evaluator's mount."
|
|
(let ((file (make-temp-file "ebox-scroll-evaluator-error-" nil ".ebox"))
|
|
(calls 0)
|
|
(original-scroll (symbol-function 'ebox--scroll-region-by))
|
|
(functions
|
|
(mapcar (lambda (symbol) (cons symbol (symbol-function symbol)))
|
|
'(ebox-surface--render-candidate
|
|
ebox-surface--apply-node-style
|
|
ebox-surface--compute-node-style)))
|
|
(buffers (buffer-list)))
|
|
(unwind-protect
|
|
(progn
|
|
(with-temp-file file
|
|
(prin1
|
|
''(column :width (px 120) :height (lh 2) :overflow scroll
|
|
(box "0\n1\n2\n3\n4\n5\n6"))
|
|
(current-buffer)))
|
|
(cl-letf (((symbol-function 'ebox--scroll-region-by)
|
|
(lambda (&rest arguments)
|
|
(when (= (cl-incf calls) 3)
|
|
(error "Injected measured scroll failure"))
|
|
(apply original-scroll arguments))))
|
|
(should-error
|
|
(ebox-playground-scroll-evaluator-run file 121 3 8)))
|
|
(should (= calls 3))
|
|
(should (equal buffers (buffer-list)))
|
|
(dolist (entry functions)
|
|
(should (eq (cdr entry) (symbol-function (car entry))))))
|
|
(delete-file file))))
|
|
|
|
(ert-deftest ebox-playground-scroll-evaluator-normalizes-only-invisible-spacers ()
|
|
"The visual oracle tolerates empty padding but retains visible differences."
|
|
(let* ((text (propertize "A" 'face '(:foreground "#123456")))
|
|
(normalize #'ebox-playground-scroll-evaluator--visual-text))
|
|
(should (equal-including-properties
|
|
(funcall normalize text)
|
|
(funcall normalize
|
|
(concat (propertize " " 'display '(space :width (0))
|
|
'face '(:foreground "#123456"))
|
|
text))))
|
|
(dolist (changed
|
|
(list (concat (propertize " " 'display '(space :width (1))) text)
|
|
(propertize "A" 'face '(:foreground "#654321"))
|
|
(propertize "B" 'face '(:foreground "#123456"))))
|
|
(should-not (equal-including-properties
|
|
(funcall normalize text)
|
|
(funcall normalize changed)))))
|
|
(dolist (carrier
|
|
(list (propertize " " 'display '(space :width (0)))
|
|
(propertize " " 'display '(space :width (0) :height 2))
|
|
(propertize " " 'display '(space :width (0) :ascent 90))
|
|
(propertize " " 'display '(space :width (0))
|
|
'face '(:height 2.0))))
|
|
(should (> (length (ebox-playground-scroll-evaluator--visual-text
|
|
(concat carrier "\nA")))
|
|
2))))
|
|
|
|
(ert-deftest ebox-playground-effective-viewport-prefers-window-text-width ()
|
|
"Interactive viewport resolution should prefer the window text width."
|
|
(let ((ebox-viewport-width nil))
|
|
(cl-letf (((symbol-function 'window-body-width)
|
|
(lambda (&optional _window _pixelwise) 987))
|
|
((symbol-function 'frame-char-width)
|
|
(lambda (&optional _frame) 8)))
|
|
(should (= (ebox-playground--effective-viewport-width
|
|
(selected-window))
|
|
971)))))
|
|
|
|
(ert-deftest ebox-playground-window-viewport-uses-ebox-sampler ()
|
|
"A preview and the Ebox resize controller share one viewport sample."
|
|
(cl-letf (((symbol-function 'ebox-viewport-window-width)
|
|
(lambda (_window) 979)))
|
|
(should (= (ebox-playground--window-viewport-width (selected-window))
|
|
979))))
|
|
|
|
(ert-deftest ebox-playground-dsl-render-uses-window-width-for-viewport ()
|
|
"C-c C-c should build viewport-dependent roots at the preview width."
|
|
(let ((preview "*Ebox Preview: /tmp/ebox-playground-viewport-render.ebox*")
|
|
(window-width 987))
|
|
(unwind-protect
|
|
(cl-letf (((symbol-function 'window-body-width)
|
|
(lambda (&optional _window _pixelwise) window-width))
|
|
((symbol-function 'frame-char-width)
|
|
(lambda (&optional _frame) 8)))
|
|
(with-temp-buffer
|
|
(setq buffer-file-name "/tmp/ebox-playground-viewport-render.ebox")
|
|
(insert "'(box :width (vw 100) :height (lh 1) \"viewport\")")
|
|
(ebox-dsl-mode)
|
|
(ebox-dsl-render)
|
|
(with-current-buffer preview
|
|
(should (= (ebox-playground-test--max-line-width
|
|
(buffer-string))
|
|
(- window-width 16))))))
|
|
(when (get-buffer preview)
|
|
(kill-buffer preview)))))
|
|
|
|
(ert-deftest ebox-playground-dsl-render-grid-reference-fits-preview-viewport ()
|
|
"C-c C-c should render the real Grid reference inside the preview viewport."
|
|
(let* ((path (expand-file-name "examples/grid-reference.ebox"
|
|
ebox-playground-directory))
|
|
(preview (format "*Ebox Preview: %s*" path))
|
|
(window-width 699)
|
|
(viewport 683))
|
|
(unwind-protect
|
|
(cl-letf (((symbol-function 'window-body-width)
|
|
(lambda (&optional _window _pixelwise) window-width))
|
|
((symbol-function 'frame-char-width)
|
|
(lambda (&optional _frame) 8)))
|
|
(delete-other-windows)
|
|
(with-temp-buffer
|
|
(setq buffer-file-name path)
|
|
(insert-file-contents path)
|
|
(ebox-dsl-mode)
|
|
(ebox-dsl-render)
|
|
(with-current-buffer preview
|
|
(should (cl-every
|
|
(lambda (width) (<= width viewport))
|
|
(ebox-playground-test--line-widths
|
|
(buffer-string)))))))
|
|
(delete-other-windows)
|
|
(when (get-buffer preview)
|
|
(kill-buffer preview)))))
|
|
|
|
(ert-deftest ebox-playground-dsl-render-keeps-source-left-of-preview ()
|
|
"C-c C-c should keep the source left of its rendered preview."
|
|
(let ((preview "*Ebox Preview: /tmp/ebox-playground-two-window.ebox*")
|
|
source)
|
|
(unwind-protect
|
|
(progn
|
|
(delete-other-windows)
|
|
(with-temp-buffer
|
|
(setq source (current-buffer)
|
|
buffer-file-name "/tmp/ebox-playground-two-window.ebox")
|
|
(insert "'(box :width (vw 100) :height (lh 1) \"two windows\")")
|
|
(ebox-dsl-mode)
|
|
(cl-letf (((symbol-function 'window-body-width)
|
|
(lambda (&optional _window _pixelwise) 987))
|
|
((symbol-function 'frame-char-width)
|
|
(lambda (&optional _frame) 8)))
|
|
(ebox-dsl-render))
|
|
(let* ((windows
|
|
(sort (copy-sequence (window-list nil 'no-minibuf))
|
|
(lambda (left right)
|
|
(< (window-left-column left)
|
|
(window-left-column right)))))
|
|
(left (car windows))
|
|
(right (cadr windows)))
|
|
(should (= (length windows) 2))
|
|
(should (eq (window-buffer left) source))
|
|
(should (eq (window-buffer right) (get-buffer preview))))))
|
|
(delete-other-windows)
|
|
(when (get-buffer preview)
|
|
(kill-buffer preview)))))
|
|
|
|
(ert-deftest ebox-playground-preview-resizes-through-ebox-viewport-update ()
|
|
"A queued preview resize should publish an incremental viewport update."
|
|
(let ((preview "*Ebox Preview: /tmp/ebox-playground-viewport-resize.ebox*")
|
|
(window-width 987)
|
|
(ebox--window-size-change-pending-frames nil)
|
|
(ebox--window-size-change-timer nil)
|
|
scheduled)
|
|
(unwind-protect
|
|
(cl-letf (((symbol-function 'window-body-width)
|
|
(lambda (&optional _window _pixelwise) window-width))
|
|
((symbol-function 'frame-char-width)
|
|
(lambda (&optional _frame) 8))
|
|
((symbol-function 'run-at-time)
|
|
(lambda (_time _repeat function &rest args)
|
|
(setq scheduled (cons function args))
|
|
'queued-viewport)))
|
|
(with-temp-buffer
|
|
(setq buffer-file-name "/tmp/ebox-playground-viewport-resize.ebox")
|
|
(insert "'(box :width (vw 100) :height (lh 1) \"viewport\")")
|
|
(ebox-dsl-mode)
|
|
(ebox-dsl-render)
|
|
(setq window-width 1234)
|
|
(with-current-buffer preview
|
|
(let ((window (get-buffer-window (current-buffer))))
|
|
(should (memq #'ebox--window-size-change
|
|
window-size-change-functions))
|
|
(let ((noninteractive nil))
|
|
(ebox--window-size-change (window-frame window))))
|
|
(should (= (ebox-playground-test--max-line-width
|
|
(buffer-string))
|
|
(- 987 16))))
|
|
(should scheduled)
|
|
(apply (car scheduled) (cdr scheduled))
|
|
(with-current-buffer preview
|
|
(should (= (ebox-playground-test--max-line-width
|
|
(buffer-string))
|
|
(- window-width 16)))
|
|
(let ((report (ebox-buffer-update-report (current-buffer))))
|
|
(should (eq (plist-get report :constraint-source) 'viewport))
|
|
(should (eq (plist-get report :strategy) 'owner-rerender))))))
|
|
(when (get-buffer preview)
|
|
(kill-buffer preview)))))
|
|
|
|
(ert-deftest ebox-playground-flex-reference-retains-stable-scroll-reflow ()
|
|
"The Flex reference should retain scroll state when its subtree is stable."
|
|
(let* ((ebox-runtime-idle-prewarm nil)
|
|
(ebox-runtime-idle-reflow-cache-prewarm nil)
|
|
(path (expand-file-name "examples/flex-reference.ebox"
|
|
ebox-playground-directory))
|
|
(name " *ebox-playground-flex-scroll-reflow-test*"))
|
|
(unwind-protect
|
|
(let* ((buffer (ebox-render-to-buffer
|
|
name (ebox-playground-view path 720)))
|
|
(old-state (ebox--buffer-render-state buffer))
|
|
(old-root-object
|
|
(plist-get (plist-get old-state :root-node)
|
|
:surface-object))
|
|
(old-scroll-ids (copy-sequence
|
|
(plist-get old-state :scroll-region-ids)))
|
|
(old-scroll-offsets
|
|
(mapcar
|
|
(lambda (region-id)
|
|
(plist-get
|
|
(gethash region-id
|
|
(plist-get old-state :scroll-state-table))
|
|
:scroll-offset))
|
|
old-scroll-ids))
|
|
(report (ebox-rerender-buffer-with-context buffer 326 36))
|
|
(new-state (ebox--buffer-render-state buffer))
|
|
(new-root-object
|
|
(plist-get (plist-get new-state :root-node)
|
|
:surface-object))
|
|
(widths
|
|
(ebox-playground-test--line-widths
|
|
(with-current-buffer buffer
|
|
(buffer-string)))))
|
|
(should (eq (plist-get report :projection-kind)
|
|
'viewport-reflow))
|
|
(should (plist-get report :runtime-published))
|
|
(should (eq old-root-object new-root-object))
|
|
(should (cl-every
|
|
(lambda (region-id)
|
|
(member region-id
|
|
(plist-get new-state :scroll-region-ids)))
|
|
old-scroll-ids))
|
|
(should (equal old-scroll-offsets
|
|
(mapcar
|
|
(lambda (region-id)
|
|
(plist-get
|
|
(gethash region-id
|
|
(plist-get new-state
|
|
:scroll-state-table))
|
|
:scroll-offset))
|
|
old-scroll-ids)))
|
|
(should (cl-every (lambda (width) (<= width 326)) widths)))
|
|
(when (get-buffer name)
|
|
(kill-buffer name)))))
|
|
|
|
(ert-deftest ebox-playground-preview-uses-canvas-redisplay-settings ()
|
|
"A preview should suppress text-editor redisplay artifacts."
|
|
(let ((preview " *ebox-playground-preview-settings-test*"))
|
|
(unwind-protect
|
|
(progn
|
|
(ebox-playground--render-input-to-buffer
|
|
preview (ebox-build '(box "preview")) 240)
|
|
(with-current-buffer preview
|
|
(should truncate-lines)
|
|
(should-not (assq 'truncation fringe-indicator-alist))
|
|
(should-not (assq 'continuation fringe-indicator-alist))
|
|
(should-not bidi-display-reordering)
|
|
(should (eq bidi-paragraph-direction 'left-to-right))))
|
|
(when (get-buffer preview)
|
|
(kill-buffer preview)))))
|
|
|
|
(ert-deftest ebox-playground-preview-display-settings-roll-back-on-render-error ()
|
|
"A failed preview render should restore its prior display settings."
|
|
(let ((preview " *ebox-playground-preview-settings-rollback-test*"))
|
|
(unwind-protect
|
|
(progn
|
|
(with-current-buffer (get-buffer-create preview)
|
|
(setq-local truncate-lines nil)
|
|
(setq-local face-remapping-alist
|
|
'((default (:background "#111111")))))
|
|
(cl-letf (((symbol-function 'ebox-render-to-buffer)
|
|
(lambda (&rest _)
|
|
(error "Injected preview render failure"))))
|
|
(should-error
|
|
(ebox-playground--render-to-preview-buffer
|
|
preview (ebox-build '(box "rollback")))))
|
|
(with-current-buffer preview
|
|
(should-not truncate-lines)
|
|
(should (equal face-remapping-alist
|
|
'((default (:background "#111111")))))))
|
|
(when (get-buffer preview)
|
|
(kill-buffer preview)))))
|
|
|
|
(ert-deftest ebox-playground-flex-reference-preserves-buffer-chrome ()
|
|
"Root canvas paint should preserve the ordinary buffer face and mode line."
|
|
(let ((preview " *ebox-playground-flex-canvas-test*")
|
|
(path (expand-file-name "examples/flex-reference.ebox"
|
|
ebox-playground-directory)))
|
|
(unwind-protect
|
|
(progn
|
|
(ebox-playground--render-input-to-buffer
|
|
preview (ebox-playground-view path 720) 720)
|
|
(with-current-buffer preview
|
|
(should-not face-remapping-alist)
|
|
(should (equal mode-line-format (default-value 'mode-line-format)))
|
|
(let ((display-signature (ebox--current-display-signature))
|
|
(matching-cache-entry-p nil)
|
|
(render-cache
|
|
(plist-get (ebox--buffer-render-state (current-buffer))
|
|
:render-cache)))
|
|
(maphash
|
|
(lambda (effective-key _entry)
|
|
(let ((signature (cadr effective-key)))
|
|
(when (and (consp signature)
|
|
(equal display-signature (car signature)))
|
|
(setq matching-cache-entry-p t))))
|
|
render-cache)
|
|
(should matching-cache-entry-p))))
|
|
(when (get-buffer preview)
|
|
(kill-buffer preview)))))
|
|
|
|
(ert-deftest ebox-playground-grid-reference-fits-preview-widths ()
|
|
"The Grid reference should stay inside split-preview width."
|
|
(let* ((viewport 691)
|
|
(path (expand-file-name "examples/grid-reference.ebox"
|
|
ebox-playground-directory))
|
|
(text (substring-no-properties
|
|
(ebox-render (ebox-playground-view path viewport)))))
|
|
(should (cl-every (lambda (width) (<= width viewport))
|
|
(ebox-playground-test--line-widths text)))))
|
|
|
|
(ert-deftest ebox-playground-grid-reference-separators-paint-the-viewport ()
|
|
"Grid reference separator Boxes should fill the active viewport canvas."
|
|
(let ((path (expand-file-name "examples/grid-reference.ebox"
|
|
ebox-playground-directory)))
|
|
(let ((separators
|
|
(cl-remove-if-not
|
|
#'ebox-playground-test--separator-form-p
|
|
(ebox-playground-test--forms-named
|
|
'box (ebox-playground-test--read-layout path)))))
|
|
(should (= (length separators) 11)))
|
|
(dolist (viewport '(691 720))
|
|
(let* ((ebox-viewport-width viewport)
|
|
(form (ebox-playground-test--read-layout path))
|
|
;; Pin this canvas contract without changing the author's root.
|
|
(_ (setcdr form (plist-put (cdr form) :width '(vw 100))))
|
|
(lines (ebox-string-lines
|
|
(ebox-render (ebox-build form))))
|
|
(separator-lines
|
|
(cl-remove-if-not
|
|
(lambda (line)
|
|
(let ((width (ebox-playground-test--absolute-space-width line)))
|
|
(and width (= width viewport))))
|
|
lines)))
|
|
(should (= (length separator-lines) 11))
|
|
(dolist (line separator-lines)
|
|
(should (= (ebox-playground-test--absolute-space-width line)
|
|
viewport))
|
|
(should (= (ebox-string-pixel-width line) viewport))
|
|
(should (equal (get-text-property 0 'face line)
|
|
'(:background "#FAF7F0"))))))))
|
|
|
|
(ert-deftest ebox-playground-default-fixture-separators-paint-the-canvas ()
|
|
"The default fixture separators should cover the preview canvas."
|
|
(let* ((ebox-viewport-width 720)
|
|
(form (ebox-playground-test--read-layout ebox-playground-default-file))
|
|
(_ (setcdr form (plist-put (cdr form) :width '(vw 100))))
|
|
(lines (ebox-string-lines
|
|
(ebox-render (ebox-build form))))
|
|
(separators 0))
|
|
(dolist (line lines)
|
|
(when (let ((width (ebox-playground-test--absolute-space-width line)))
|
|
(and width (= width 720)))
|
|
(setq separators (1+ separators))
|
|
(should (equal (get-text-property 0 'face line)
|
|
'(:background "#FAF7F0")))))
|
|
(should (> separators 0))))
|
|
|
|
(ert-deftest ebox-playground-separators-follow-a-narrower-root ()
|
|
"Explicit and auto gallery separators fill a root narrower than the viewport."
|
|
(dolist (fixture '(("flex-reference.ebox" . 12)
|
|
("grid-reference.ebox" . 11)))
|
|
(dolist (omit-width '(nil t))
|
|
(let* ((ebox-viewport-width 1000)
|
|
(path (expand-file-name (concat "examples/" (car fixture))
|
|
ebox-playground-directory))
|
|
(form (ebox-playground-test--read-layout path))
|
|
(parent-width 900))
|
|
;; Inspect the entire gallery independently of the author's height.
|
|
(setcdr form (plist-put (cdr form) :width '(vw 90)))
|
|
(setcdr form (plist-put (cdr form) :height 'auto))
|
|
(cl-remf (cdr form) :overflow)
|
|
(setcdr form (append '(:overflow visible) (cdr form)))
|
|
(dolist (box (ebox-playground-test--form-children form))
|
|
(when (and (eq (car-safe box) 'box)
|
|
(null (ebox-playground-test--form-children box)))
|
|
(should (equal (plist-get (cdr box) :height) '(lh 1)))
|
|
(if omit-width
|
|
(cl-remf (cdr box) :width)
|
|
(setcdr box (plist-put (cdr box) :width 'stretch)))))
|
|
(let* ((lines (ebox-string-lines (ebox-render (ebox-build form))))
|
|
(separators
|
|
(cl-remove-if-not
|
|
(lambda (line)
|
|
(let ((face (get-text-property 0 'face line)))
|
|
(and (ebox-playground-test--absolute-space-width line)
|
|
(or (equal face '(:background "#FAF7F0"))
|
|
(equal (car-safe face)
|
|
'(:background "#FAF7F0"))))))
|
|
lines)))
|
|
(should (= (length separators) (cdr fixture)))
|
|
(dolist (line separators)
|
|
(should (= (ebox-playground-test--absolute-space-width line)
|
|
parent-width))))))))
|
|
|
|
(ert-deftest ebox-playground-grid-reference-covers-public-properties ()
|
|
"The Grid reference should cover every public property and supported value form."
|
|
(let ((source
|
|
(prin1-to-string
|
|
(ebox-playground-test--read-layout
|
|
(expand-file-name "examples/grid-reference.ebox"
|
|
ebox-playground-directory)))))
|
|
(dolist (property '(:grid-template-columns :grid-template-rows
|
|
:grid-auto-columns :grid-auto-rows :grid-auto-flow
|
|
:gap :row-gap :column-gap
|
|
:justify-items :align-items :justify-content
|
|
:align-content :grid-column :grid-row
|
|
:grid-column-span :grid-row-span))
|
|
(should (string-match-p (regexp-quote (symbol-name property)) source)))
|
|
(dolist (fragment ebox-playground-test--grid-value-forms)
|
|
(should (string-match-p (regexp-quote fragment) source)))))
|
|
|
|
(ert-deftest ebox-playground-opens-and-closes-buffer ()
|
|
"The public open and close commands should own their buffer lifecycle."
|
|
(let ((name " *ebox-playground-test*"))
|
|
(unwind-protect
|
|
(progn
|
|
(ebox-playground-open name)
|
|
(should (buffer-live-p (get-buffer name)))
|
|
(with-current-buffer name
|
|
(should (string-match-p "Ebox CSS Grid Reference"
|
|
(buffer-string)))))
|
|
(ebox-playground-close name))))
|
|
|
|
(ert-deftest ebox-playground-fits-a-compact-gui-window ()
|
|
"Keep the default gallery inside a compact 720 px preview canvas."
|
|
(let* ((viewport 720)
|
|
(ebox-viewport-width viewport)
|
|
(form (ebox-playground-test--read-layout ebox-playground-default-file))
|
|
(_ (setcdr form (plist-put (cdr form) :width '(vw 100))))
|
|
(input (ebox-build form))
|
|
(rendered (ebox-render input))
|
|
(widths (mapcar #'ebox-string-pixel-width
|
|
(ebox-string-lines rendered)))
|
|
(maximum (apply #'max widths)))
|
|
(should (= maximum viewport))))
|
|
|
|
(ert-deftest ebox-playground-registers-ebox-file-mode ()
|
|
"Open Ebox DSL files in the package-owned major mode."
|
|
(with-temp-buffer
|
|
(setq buffer-file-name "/tmp/ebox-playground-mode-test.ebox")
|
|
(set-auto-mode)
|
|
(should (eq major-mode 'ebox-dsl-mode))
|
|
(should (eq (key-binding (kbd "C-c C-c")) #'ebox-dsl-render))
|
|
(should (string-match-p "C-c C-c" header-line-format))))
|
|
|
|
(ert-deftest ebox-playground-renders-ebox-file-mode-source ()
|
|
"Render a file-mode buffer through the public Ebox build path."
|
|
(let ((preview "*Ebox Preview: /tmp/ebox-playground-render-test.ebox*"))
|
|
(unwind-protect
|
|
(with-temp-buffer
|
|
(setq buffer-file-name "/tmp/ebox-playground-render-test.ebox")
|
|
(insert "'(box :width (px 240) \"Rendered from .ebox\")")
|
|
(ebox-dsl-mode)
|
|
(ebox-dsl-render)
|
|
(should (eq (window-buffer (selected-window)) (current-buffer)))
|
|
(should (get-buffer-window (get-buffer preview)))
|
|
(with-current-buffer preview
|
|
(should (string-match-p "Rendered from .ebox" (buffer-string)))))
|
|
(when (get-buffer preview)
|
|
(kill-buffer preview)))))
|
|
|
|
(ert-deftest ebox-playground-evaluates-quoted-layout-as-data ()
|
|
"Quoted layout lists and symbols reach Ebox without extra evaluation."
|
|
(let* ((expected '(box :width (px 240) :padding ((lh 0) (px 4))
|
|
:text-align center "Literal values"))
|
|
(form (ebox-playground--evaluate-form
|
|
(ebox-playground--read-form
|
|
"'(box :width (px 240) :padding ((lh 0) (px 4))
|
|
:text-align center \"Literal values\")")))
|
|
(node (ebox-build form)))
|
|
(should (equal form expected))
|
|
(should (equal (ebox-style-node-specified-value node :width) '(px 240)))
|
|
(should (equal (ebox-style-node-specified-value node :padding-inline-start)
|
|
'(px 4)))
|
|
(should (eq (ebox-style-node-specified-value node :text-align) 'center))))
|
|
|
|
(ert-deftest ebox-playground-evaluates-backquoted-property-expressions ()
|
|
"Use ordinary unquote expressions to calculate property values."
|
|
(let* ((form (ebox-playground--evaluate-form
|
|
'(let ((width (ebox-playground-test--dynamic-width))
|
|
(color (ebox-playground-test--dynamic-color)))
|
|
`(box :width ,width :color ,color
|
|
:padding ((lh 0) (px 4)) :text-align center
|
|
"Dynamic property values"))))
|
|
(node (ebox-build form)))
|
|
(should (equal (ebox-style-node-specified-value node :width) '(px 240)))
|
|
(should (equal (ebox-style-node-specified-value node :color) "#123456"))
|
|
(should (equal
|
|
(ebox-style-node-specified-value node :padding-inline-start)
|
|
'(px 4)))
|
|
(should (eq (ebox-style-node-specified-value node :text-align)
|
|
'center))))
|
|
|
|
(ert-deftest ebox-playground-evaluates-lexical-children-and-text ()
|
|
"Lexical closures can produce spliced child lists and dynamic text."
|
|
(let* ((source
|
|
"(let ((labels '(\"one\" \"two\"))
|
|
(make-child (let ((prefix \"Item: \"))
|
|
(lambda (label)
|
|
`(box ,(concat prefix label))))))
|
|
`(column :padding ((lh 0) (ch ,(length labels)))
|
|
,@(mapcar make-child labels)))")
|
|
(form (ebox-playground--evaluate-form
|
|
(ebox-playground--read-form source)))
|
|
(rendered (substring-no-properties (ebox-render (ebox-build form)))))
|
|
(should (equal form '(column :padding ((lh 0) (ch 2))
|
|
(box "Item: one") (box "Item: two"))))
|
|
(should (string-match-p "Item: one" rendered))
|
|
(should (string-match-p "Item: two" rendered))))
|
|
|
|
(ert-deftest ebox-playground-does-not-evaluate-quoted-property-data ()
|
|
"A property that resembles executable code remains literal data."
|
|
(let ((form (ebox-playground--evaluate-form
|
|
'(quote (box :width (error "Must remain data") "Text")))))
|
|
(should (equal form
|
|
'(box :width (error "Must remain data") "Text")))))
|
|
|
|
(ert-deftest ebox-playground-rejects-multiple-or-incomplete-trailing-forms ()
|
|
"Exactly one complete Elisp expression is allowed in a source file."
|
|
(dolist (source '("'(box \"one\")\n'(box \"two\")"
|
|
"'(box \"one\")\n("
|
|
"'(box \"one\")\n\"unfinished"))
|
|
(should-error (ebox-playground--read-form source) :type 'user-error))
|
|
(should (equal (ebox-playground--read-form
|
|
"; Header\n'(box \"one\") ; Trailing comment\n")
|
|
'(quote (box "one")))))
|
|
|
|
(ert-deftest ebox-playground-file-and-buffer-share-elisp-evaluation ()
|
|
"File previews and editor buffers build the same computed layout."
|
|
(let* ((source "(let ((body \"Computed body\"))
|
|
`(box :width (px 240) ,body))")
|
|
(file (make-temp-file "ebox-playground-evaluation-" nil ".ebox" source)))
|
|
(unwind-protect
|
|
(with-temp-buffer
|
|
(insert source)
|
|
(ebox-dsl-mode)
|
|
(let ((buffer-form (ebox-playground--source-form)))
|
|
(should (equal buffer-form '(box :width (px 240) "Computed body")))
|
|
(should (equal (ebox-render (ebox-playground-view file 720))
|
|
(ebox-render (ebox-build buffer-form))))))
|
|
(delete-file file))))
|
|
|
|
(defvar ebox-playground-test--companion-value nil
|
|
"Dynamically isolated value written by temporary companion fixtures.")
|
|
|
|
(defvar ebox-playground-test--companion-loads 0
|
|
"Number of source loads performed by a temporary companion fixture.")
|
|
|
|
(defun ebox-playground-test--call-with-companion-files (function)
|
|
"Call FUNCTION with temporary DSL, companion, and preview names; clean up."
|
|
(let* ((directory (make-temp-file "ebox-playground-companion-" t))
|
|
(file (expand-file-name "example.ebox" directory))
|
|
(companion (expand-file-name "example.el" directory))
|
|
(preview (generate-new-buffer-name " *ebox-companion-test*"))
|
|
(ebox-playground-test--companion-value nil)
|
|
(ebox-playground-test--companion-loads 0)
|
|
(load-history load-history))
|
|
(unwind-protect
|
|
(funcall function file companion preview)
|
|
(ebox-playground-close preview)
|
|
(ebox-playground-close (format "*Ebox Preview: %s*" file))
|
|
(delete-directory directory t))))
|
|
|
|
(ert-deftest ebox-playground-companion-reloads-exact-source-before-file-evaluation ()
|
|
"Reload an edited sibling source, regardless of bytecode or current directory."
|
|
(ebox-playground-test--call-with-companion-files
|
|
(lambda (file companion _preview)
|
|
(with-temp-file file
|
|
(insert "(list 'box ebox-playground-test--companion-value)"))
|
|
(with-temp-file companion
|
|
(insert ";;; -*- lexical-binding: t; -*-\n")
|
|
(insert "(setq ebox-playground-test--companion-value \"stale bytecode\")"))
|
|
(should (byte-compile-file companion))
|
|
(let ((default-directory temporary-file-directory)
|
|
(load-prefer-newer nil))
|
|
(dolist (value '("first source" "edited source"))
|
|
(with-temp-file companion
|
|
(insert ";;; -*- lexical-binding: t; -*-\n")
|
|
(prin1 `(progn
|
|
(cl-incf ebox-playground-test--companion-loads)
|
|
(setq ebox-playground-test--companion-value ,value))
|
|
(current-buffer)))
|
|
;; An ordinary suffix-selecting load would choose the newer .elc.
|
|
(set-file-times companion
|
|
(time-subtract (current-time) (seconds-to-time 60)))
|
|
(should (string-match-p
|
|
value (ebox-render (ebox-playground-view file 240))))
|
|
(should-not (equal ebox-playground-test--companion-value
|
|
"stale bytecode"))))
|
|
(should (= ebox-playground-test--companion-loads 2)))))
|
|
|
|
(ert-deftest ebox-playground-companion-source-command-reloads-and-preserves-preview ()
|
|
"C-c C-c loads the sibling before unsaved DSL and preserves a failed preview."
|
|
(ebox-playground-test--call-with-companion-files
|
|
(lambda (file companion _preview)
|
|
(with-temp-file file (insert "'(box \"Saved disk layout\")"))
|
|
(save-window-excursion
|
|
(with-temp-buffer
|
|
(setq buffer-file-name file)
|
|
(insert "(list 'box ebox-playground-test--companion-value)")
|
|
(ebox-dsl-mode)
|
|
(let ((default-directory temporary-file-directory)
|
|
(preview (format "*Ebox Preview: %s*" file))
|
|
(ebox-viewport-width 240))
|
|
(dolist (value '("first buffer preview" "edited buffer preview"))
|
|
(with-temp-file companion
|
|
(insert ";;; -*- lexical-binding: t; -*-\n")
|
|
(prin1 `(progn
|
|
(cl-incf ebox-playground-test--companion-loads)
|
|
(setq ebox-playground-test--companion-value ,value))
|
|
(current-buffer)))
|
|
(call-interactively (key-binding (kbd "C-c C-c")))
|
|
(with-current-buffer preview
|
|
(should (string-match-p value (buffer-string)))
|
|
(should-not (string-match-p "Saved disk layout" (buffer-string)))))
|
|
(should (= ebox-playground-test--companion-loads 2))
|
|
(let ((before (with-current-buffer preview (buffer-string)))
|
|
(existing (get-buffer preview)))
|
|
(with-temp-file companion
|
|
(insert ";;; -*- lexical-binding: t; -*-\n")
|
|
(insert "(error \"Companion source failed\")"))
|
|
(should-error
|
|
(call-interactively (key-binding (kbd "C-c C-c"))))
|
|
(should (eq existing (get-buffer preview)))
|
|
(with-current-buffer preview
|
|
(should (equal-including-properties before (buffer-string)))))))))))
|
|
|
|
(ert-deftest ebox-playground-companion-file-load-error-preserves-mounted-preview ()
|
|
"A failed companion leaves existing preview contents and region handles live."
|
|
(ebox-playground-test--call-with-companion-files
|
|
(lambda (file companion preview)
|
|
(with-temp-file file
|
|
(insert "(list 'box :id \"kept\" ebox-playground-test--companion-value)"))
|
|
(with-temp-file companion
|
|
(insert ";;; -*- lexical-binding: t; -*-\n")
|
|
(insert "(setq ebox-playground-test--companion-value \"Before failure\")"))
|
|
(let* ((buffer (ebox-playground-open-file file preview))
|
|
(handle (ebox-region-resolve buffer "kept"))
|
|
(before (with-current-buffer buffer (buffer-string))))
|
|
(with-temp-file companion
|
|
(insert ";;; -*- lexical-binding: t; -*-\n")
|
|
(insert "(error \"Companion load failed\")"))
|
|
(should-error (ebox-playground-open-file file preview))
|
|
(should (eq buffer (get-buffer preview)))
|
|
(with-current-buffer buffer
|
|
(should (equal-including-properties before (buffer-string))))
|
|
(ebox-region-update handle :content "Still mounted")
|
|
(with-current-buffer buffer
|
|
(should (string-match-p "Still mounted" (buffer-string))))))))
|
|
|
|
(ert-deftest ebox-playground-companion-is-optional-and-bytecode-alone-is-ignored ()
|
|
"Unpaired files and editor buffers keep working without loading stray bytecode."
|
|
(ebox-playground-test--call-with-companion-files
|
|
(lambda (file companion preview)
|
|
(with-temp-file file (insert "'(box \"Standalone example\")"))
|
|
(with-temp-file (concat companion "c")
|
|
(insert "(error \"A bytecode-only companion must not load\")"))
|
|
(let ((buffer (ebox-playground-open-file file preview)))
|
|
(with-current-buffer buffer
|
|
(should (string-match-p "Standalone example" (buffer-string)))))
|
|
(with-temp-buffer
|
|
(setq buffer-file-name file)
|
|
(insert-file-contents file)
|
|
(ebox-dsl-mode)
|
|
(should (equal (ebox-playground--source-form)
|
|
'(box "Standalone example")))))))
|
|
|
|
(provide 'ebox-playground-tests)
|
|
|
|
;;; ebox-playground-tests.el ends here
|