test: provide reusable existing-frame Ebox resize benchmark
This commit is contained in:
parent
2328e05b45
commit
c06f9ef2dc
@ -8,6 +8,10 @@
|
|||||||
|
|
||||||
- GUI 与性能自动化先查 `scripts/README.md`、`scripts/emacs-gui-verifier.el`
|
- GUI 与性能自动化先查 `scripts/README.md`、`scripts/emacs-gui-verifier.el`
|
||||||
及既有 Makefile 入口;公共机制归 `scripts/`,具体业务场景归示例仓库。
|
及既有 Makefile 入口;公共机制归 `scripts/`,具体业务场景归示例仓库。
|
||||||
|
- 连续 resize 使用 `scripts/benchmark-ebox-resize.el` 的
|
||||||
|
`ebox-resize-benchmark-start`,适用于现有 ETAF 或独立 Ebox buffer。
|
||||||
|
按 README 选择范围、轮数和新证据文件;先验证前台与已加载版本,保留全部样本,
|
||||||
|
检查 `:valid` 与 `:within-limit`,同时比较内容规模,不能只比较 p95。
|
||||||
- 遇到重复的渲染、交互、resize 或验证需求,优先扩展已登记入口。稳定的通用
|
- 遇到重复的渲染、交互、resize 或验证需求,优先扩展已登记入口。稳定的通用
|
||||||
操作应主动固化为带参数、验证和说明的仓库工具,随后更新工具索引及本节路由。
|
操作应主动固化为带参数、验证和说明的仓库工具,随后更新工具索引及本节路由。
|
||||||
- `.omx/` 中的临时诊断是历史调查材料,不是日常运行入口。不要从中复制新的
|
- `.omx/` 中的临时诊断是历史调查材料,不是日常运行入口。不要从中复制新的
|
||||||
|
|||||||
10
Makefile
10
Makefile
@ -1,10 +1,10 @@
|
|||||||
EMACS ?= emacs
|
EMACS ?= emacs
|
||||||
LOAD_PATH = -L . -L examples -L scripts -L ../ebox -L ../tp -L ../ecss
|
LOAD_PATH = -L . -L examples -L scripts -L ../ebox -L ../tp -L ../ecss
|
||||||
SOURCES = etaf-view.el etaf-compiler.el etaf-component.el etaf-scheduler.el etaf-reactive.el etaf-observer.el etaf-context.el etaf-theme-tp.el etaf-resource.el etaf-data.el etaf-generation.el etaf-host.el etaf-retirement.el etaf-render-port.el etaf-renderer.el etaf-runtime.el etaf-behavior.el etaf-actions.el etaf-events.el etaf-performance.el etaf.el scripts/emacs-gui-verifier.el scripts/benchmark-scheduler-context.el
|
SOURCES = etaf-view.el etaf-compiler.el etaf-component.el etaf-scheduler.el etaf-reactive.el etaf-observer.el etaf-context.el etaf-theme-tp.el etaf-resource.el etaf-data.el etaf-generation.el etaf-host.el etaf-retirement.el etaf-render-port.el etaf-renderer.el etaf-runtime.el etaf-behavior.el etaf-actions.el etaf-events.el etaf-performance.el etaf.el scripts/emacs-gui-verifier.el scripts/benchmark-scheduler-context.el scripts/benchmark-ebox-resize.el
|
||||||
EXAMPLES = examples/etaf-counter-example.el examples/etaf-data-example.el examples/etaf-resource-example.el
|
EXAMPLES = examples/etaf-counter-example.el examples/etaf-data-example.el examples/etaf-resource-example.el
|
||||||
TESTS = tests/etaf-tests.el tests/etaf-compiler-tests.el tests/etaf-component-frontends-tests.el tests/etaf-render-view-tests.el tests/etaf-dynamic-components-tests.el tests/etaf-event-forwarding-tests.el tests/etaf-resource-tests.el tests/etaf-data-tests.el tests/etaf-theme-tp-tests.el tests/etaf-examples-tests.el tests/etaf-observer-tests.el tests/etaf-performance-tests.el tests/etaf-gui-verifier-tests.el tests/etaf-m0a-current-characterization-tests.el tests/etaf-interaction-contract-tests.el tests/etaf-m0b-component-manifest-tests.el tests/etaf-render-port-tests.el tests/etaf-generation-tests.el tests/etaf-host-tests.el tests/etaf-retirement-tests.el tests/etaf-scheduler-tests.el tests/etaf-g1-cross-layer-tests.el
|
TESTS = tests/etaf-tests.el tests/etaf-compiler-tests.el tests/etaf-component-frontends-tests.el tests/etaf-render-view-tests.el tests/etaf-dynamic-components-tests.el tests/etaf-event-forwarding-tests.el tests/etaf-resource-tests.el tests/etaf-data-tests.el tests/etaf-theme-tp-tests.el tests/etaf-examples-tests.el tests/etaf-observer-tests.el tests/etaf-performance-tests.el tests/etaf-gui-verifier-tests.el tests/etaf-m0a-current-characterization-tests.el tests/etaf-interaction-contract-tests.el tests/etaf-m0b-component-manifest-tests.el tests/etaf-render-port-tests.el tests/etaf-generation-tests.el tests/etaf-host-tests.el tests/etaf-retirement-tests.el tests/etaf-scheduler-tests.el tests/etaf-g1-cross-layer-tests.el tests/etaf-resize-benchmark-tests.el
|
||||||
|
|
||||||
.PHONY: test compile load checkdoc docs-check metadata-check scheduler-benchmark check clean
|
.PHONY: test compile load checkdoc docs-check metadata-check scheduler-benchmark resize-benchmark-tests check clean
|
||||||
|
|
||||||
test: compile
|
test: compile
|
||||||
$(EMACS) -Q --batch $(LOAD_PATH) --eval "(setq load-prefer-newer t)" \
|
$(EMACS) -Q --batch $(LOAD_PATH) --eval "(setq load-prefer-newer t)" \
|
||||||
@ -32,6 +32,10 @@ scheduler-benchmark:
|
|||||||
-l scripts/benchmark-scheduler-context.el \
|
-l scripts/benchmark-scheduler-context.el \
|
||||||
-f etaf-scheduler-benchmark-run
|
-f etaf-scheduler-benchmark-run
|
||||||
|
|
||||||
|
resize-benchmark-tests:
|
||||||
|
$(EMACS) -Q --batch $(LOAD_PATH) --eval '(setq load-prefer-newer t)' \
|
||||||
|
-l tests/etaf-resize-benchmark-tests.el -f ert-run-tests-batch-and-exit
|
||||||
|
|
||||||
checkdoc:
|
checkdoc:
|
||||||
$(EMACS) -Q --batch --eval '(progn (require (quote checkdoc)) (dolist (directory (list "." "examples" "scripts")) (dolist (file (directory-files directory t)) (when (string-suffix-p ".el" file) (checkdoc-file file)))))'
|
$(EMACS) -Q --batch --eval '(progn (require (quote checkdoc)) (dolist (directory (list "." "examples" "scripts")) (dolist (file (directory-files directory t)) (when (string-suffix-p ".el" file) (checkdoc-file file)))))'
|
||||||
|
|
||||||
|
|||||||
@ -13,6 +13,9 @@ scenarios live in their respective example repositories:
|
|||||||
- `emacs-gui-verifier.el` defines `Scenario`, ordered `Action`, run-local
|
- `emacs-gui-verifier.el` defines `Scenario`, ordered `Action`, run-local
|
||||||
`Context`, checkpoint sequencing, assertions, completion, and fail-closed
|
`Context`, checkpoint sequencing, assertions, completion, and fail-closed
|
||||||
evidence finalization.
|
evidence finalization.
|
||||||
|
- `benchmark-ebox-resize.el` drives continuous pixel-width sweeps of any
|
||||||
|
existing mounted Ebox buffer, including ETAF apps, without taking over its
|
||||||
|
observer. See the existing-server entry below.
|
||||||
- The legacy isolated runner `run-emacs-gui-verification.sh` owns one named daemon, explicit load paths,
|
- The legacy isolated runner `run-emacs-gui-verification.sh` owns one named daemon, explicit load paths,
|
||||||
external application activation, recorder lifecycle, driver loading, report
|
external application activation, recorder lifecycle, driver loading, report
|
||||||
generation, and exact cleanup.
|
generation, and exact cleanup.
|
||||||
@ -48,3 +51,70 @@ Only `VERDICT=PASS` completes that runner's evidence bundle. An existing-server
|
|||||||
run reports its actual interaction assertions and inspected screenshots
|
run reports its actual interaction assertions and inspected screenshots
|
||||||
separately. A failed recorder is never evidence of continuous capture, and
|
separately. A failed recorder is never evidence of continuous capture, and
|
||||||
neither screenshots nor recording establish an operation latency bound.
|
neither screenshots nor recording establish an operation latency bound.
|
||||||
|
|
||||||
|
## Continuous resize on the existing server
|
||||||
|
|
||||||
|
Use this entry for resize performance investigations instead of copying the
|
||||||
|
historical `.omx/component-api-implementation/*continuous-resize*.el` probes.
|
||||||
|
First show the intended buffer in the user's existing foreground GUI frame.
|
||||||
|
Preserve its font and chrome. Compile changed product modules before loading
|
||||||
|
them; `make compile` in this repository also compiles the benchmark tool.
|
||||||
|
|
||||||
|
```sh
|
||||||
|
emacsclient --eval '(progn
|
||||||
|
(load "/path/to/etaf/scripts/benchmark-ebox-resize.elc" nil t t)
|
||||||
|
(ebox-resize-benchmark-start "*Your app*" 480 1400
|
||||||
|
:step 32 :rounds 3 :output "/tmp/resize-run-1.eldata"))'
|
||||||
|
```
|
||||||
|
|
||||||
|
The bounds are outer-frame pixels. Every round goes from narrow to wide and
|
||||||
|
back, including both endpoints even when the step does not divide the range.
|
||||||
|
The last measured request returns to the initial width. Consecutive equal
|
||||||
|
widths are omitted because they request no resize; no warmup or slow sample is
|
||||||
|
dropped. The function returns immediately. Poll or cancel this owned run with:
|
||||||
|
|
||||||
|
```elisp
|
||||||
|
(ebox-resize-benchmark-status)
|
||||||
|
(ebox-resize-benchmark-cancel)
|
||||||
|
```
|
||||||
|
|
||||||
|
`:delay` (default 0.01 seconds) runs between completed publications;
|
||||||
|
`:timeout` (default 5 seconds) bounds startup, publication and final settling.
|
||||||
|
The tool waits for a preceding render's GC lease to end before recording the
|
||||||
|
baseline, and for its own run's lease to end before accepting the final result.
|
||||||
|
Unsupported sizes,
|
||||||
|
changed targets/focus/font/height, publication failures and cancellation produce
|
||||||
|
invalid/incomplete evidence. Advice and timers are removed on success, error,
|
||||||
|
quit and timeout. Failure leaves the last applied width; it does not fight a
|
||||||
|
user's subsequent window changes. No server, frame, application buffer, observer, profiler
|
||||||
|
or GC policy is created/replaced to make the benchmark pass.
|
||||||
|
|
||||||
|
Use a **new output path** each time. UTF-8 `.eldata` reports retain all requests,
|
||||||
|
all completed samples, actual published dimensions, node/text counts, GC,
|
||||||
|
per-operation CPU time, code origins and hashes. Optional `:phases '(FUNCTIONS…)`
|
||||||
|
records inclusive phase durations for loaded `ebox-`, `tp-` and `etaf-` provider
|
||||||
|
functions. The driver and outer publication boundary cannot be selected as
|
||||||
|
phases; nested durations must not be summed.
|
||||||
|
Publication timing ends when the real public Ebox viewport call returns.
|
||||||
|
Request→publication also includes event-loop delivery. Neither metric proves
|
||||||
|
compositor presentation, absence of flicker, or every interaction's correctness;
|
||||||
|
use the existing visual scenario/capture tools for those claims.
|
||||||
|
|
||||||
|
`:valid t` requires complete correctly attributed publication coverage.
|
||||||
|
`:within-limit t` additionally requires **every** request→publication sample to
|
||||||
|
meet `:limit-ms` (default 50). Inspect p95 **and** max, including GC samples.
|
||||||
|
Compare payload counts at matching widths before making speedup claims. A
|
||||||
|
different page size/content or loaded version is a different baseline.
|
||||||
|
|
||||||
|
Code origins and disk hashes alone cannot establish when a running function was
|
||||||
|
loaded. After recompilation, `:reload-files '("/checkout/ebox/ebox-viewport.elc" …)`
|
||||||
|
explicitly loads the chosen fresh bytecode before instrumentation. `:code`
|
||||||
|
contains every explicitly loaded file's canonical path, source/bytecode hashes
|
||||||
|
and load result, plus observed core function and benchmark driver origins;
|
||||||
|
matching origins are marked `:reloaded t`. Choose the affected modules; do not reload
|
||||||
|
application component declarations blindly. Without this option, report code
|
||||||
|
origin observations separately from independent evidence of a fresh GUI load.
|
||||||
|
|
||||||
|
Run the tool's regression checks with `make resize-benchmark-tests`; they also
|
||||||
|
run in the full `make check` gate. Application-specific data setup and interaction
|
||||||
|
assertions remain in the example repositories, not this resize driver.
|
||||||
|
|||||||
497
scripts/benchmark-ebox-resize.el
Normal file
497
scripts/benchmark-ebox-resize.el
Normal file
@ -0,0 +1,497 @@
|
|||||||
|
;;; benchmark-ebox-resize.el --- Existing-frame resize benchmark -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;; SPDX-License-Identifier: GPL-3.0-or-later
|
||||||
|
|
||||||
|
;;; Commentary:
|
||||||
|
|
||||||
|
;; Drive any mounted Ebox buffer through a pixel-width sweep in its existing
|
||||||
|
;; GUI frame. This includes ETAF apps without depending on ETAF Runtime.
|
||||||
|
;; Publication completion, rather than a fixed sleep, advances each request.
|
||||||
|
;; The visual scenario engine remains responsible for screenshots/interaction
|
||||||
|
;; assertions; this tool measures request and publication boundaries only.
|
||||||
|
;; Internal Ebox state is read for bounded diagnostics, never mutated.
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'cl-lib)
|
||||||
|
(require 'ebox)
|
||||||
|
(require 'ebox-viewport)
|
||||||
|
|
||||||
|
(declare-function profiler-running-p "profiler" ())
|
||||||
|
(declare-function ebox-native-reflow-runtime-report "ebox-native-reflow" ())
|
||||||
|
|
||||||
|
(defvar ebox-resize-benchmark--run nil
|
||||||
|
"The sole active run, including its owned timers and instrumentation.")
|
||||||
|
(defvar ebox-resize-benchmark--last-result nil
|
||||||
|
"Scalar report for the most recently finished run.")
|
||||||
|
(defvar ebox-resize-benchmark--phases nil
|
||||||
|
"Dynamically bound phase counters for the current measured publication.")
|
||||||
|
(defvar ebox-resize-benchmark--inside nil
|
||||||
|
"Non-nil inside the outer measured public viewport operation.")
|
||||||
|
|
||||||
|
(defun ebox-resize-benchmark--widths (minimum maximum step rounds initial)
|
||||||
|
"Build MINIMUM–MAXIMUM sweeps using STEP and ROUNDS, returning to INITIAL.
|
||||||
|
Consecutive duplicate widths, which request no change, are omitted."
|
||||||
|
(unless (and (integerp minimum) (> minimum 0)
|
||||||
|
(integerp maximum) (> maximum minimum)
|
||||||
|
(integerp step) (> step 0)
|
||||||
|
(integerp rounds) (> rounds 0))
|
||||||
|
(error "Resize requires positive integer bounds, step and rounds; min < max"))
|
||||||
|
(let* ((ascending (number-sequence minimum maximum step))
|
||||||
|
(up (if (= (car (last ascending)) maximum) ascending
|
||||||
|
(append ascending (list maximum))))
|
||||||
|
(cycle (append up (cdr (reverse up))))
|
||||||
|
(previous initial) widths)
|
||||||
|
(dolist (width (append (apply #'append (make-list rounds cycle))
|
||||||
|
(list initial)))
|
||||||
|
(unless (= width previous) (push width widths))
|
||||||
|
(setq previous width))
|
||||||
|
(nreverse widths)))
|
||||||
|
|
||||||
|
(defun ebox-resize-benchmark--summary (values)
|
||||||
|
"Return count, p50, p95 and max for all numeric VALUES."
|
||||||
|
(when values
|
||||||
|
(let ((sorted (sort (copy-sequence values) #'<)))
|
||||||
|
(list :count (length values)
|
||||||
|
:p50-ms (nth (1- (ceiling (* .5 (length values)))) sorted)
|
||||||
|
:p95-ms (nth (1- (ceiling (* .95 (length values)))) sorted)
|
||||||
|
:max-ms (car (last sorted))))))
|
||||||
|
|
||||||
|
(defun ebox-resize-benchmark--condition (condition)
|
||||||
|
"Summarize CONDITION without printing arbitrary condition data."
|
||||||
|
(list :symbol (car condition)
|
||||||
|
:message (if (stringp (cadr condition))
|
||||||
|
(truncate-string-to-width (cadr condition) 512 nil nil t)
|
||||||
|
"Non-text condition data omitted")))
|
||||||
|
|
||||||
|
(defun ebox-resize-benchmark--hash-file (file)
|
||||||
|
"Return FILE's literal SHA-256."
|
||||||
|
(with-temp-buffer
|
||||||
|
(insert-file-contents-literally file)
|
||||||
|
(secure-hash 'sha256 (current-buffer))))
|
||||||
|
|
||||||
|
(defun ebox-resize-benchmark--file-evidence (file)
|
||||||
|
"Return canonical FILE and source paths with their literal hashes."
|
||||||
|
(let* ((path (file-truename file))
|
||||||
|
(source (if (string-suffix-p ".elc" path) (substring path 0 -1) path)))
|
||||||
|
(list :file path :sha256 (ebox-resize-benchmark--hash-file path)
|
||||||
|
:source (and (file-readable-p source) (file-truename source))
|
||||||
|
:source-sha256 (and (file-readable-p source)
|
||||||
|
(ebox-resize-benchmark--hash-file source)))))
|
||||||
|
|
||||||
|
(defun ebox-resize-benchmark--code (files)
|
||||||
|
"Reload explicitly supplied compiled FILES and report relevant code origins.
|
||||||
|
Never reload application declarations implicitly. Without FILES, origin and
|
||||||
|
disk hashes are observations, not proof that memory matches current bytecode."
|
||||||
|
(dolist (file files)
|
||||||
|
(unless (and (stringp file) (string-suffix-p ".elc" file)
|
||||||
|
(file-readable-p file)
|
||||||
|
(not (file-newer-than-file-p (substring file 0 -1) file)))
|
||||||
|
(error "Missing or stale compiled reload file: %s" file)))
|
||||||
|
(let ((reloads
|
||||||
|
(mapcar (lambda (file)
|
||||||
|
(let* ((evidence (ebox-resize-benchmark--file-evidence file))
|
||||||
|
(loaded (load (plist-get evidence :file) nil t t)))
|
||||||
|
(unless (equal evidence (ebox-resize-benchmark--file-evidence file))
|
||||||
|
(error "Reload file changed while loading: %s" file))
|
||||||
|
(append evidence (list :loaded (and loaded t))))) files)))
|
||||||
|
(list :reload-files reloads :functions
|
||||||
|
(mapcar
|
||||||
|
(lambda (symbol)
|
||||||
|
(let* ((origin (symbol-file symbol 'defun))
|
||||||
|
(source (and origin
|
||||||
|
(if (string-suffix-p ".elc" origin)
|
||||||
|
(substring origin 0 -1) origin))))
|
||||||
|
(unless (and origin (file-readable-p origin))
|
||||||
|
(error "No readable origin for resize function: %s" symbol))
|
||||||
|
(when (and (string-suffix-p ".elc" origin)
|
||||||
|
(file-newer-than-file-p source origin))
|
||||||
|
(error "Recompile stale resize bytecode: %s" origin))
|
||||||
|
(list :function symbol :origin origin
|
||||||
|
:origin-sha256 (ebox-resize-benchmark--hash-file origin)
|
||||||
|
:source-sha256 (and (file-readable-p source)
|
||||||
|
(ebox-resize-benchmark--hash-file source))
|
||||||
|
:reloaded (and (member (file-truename origin)
|
||||||
|
(mapcar #'file-truename files)) t))))
|
||||||
|
'(ebox-rerender-buffer-with-context ebox--window-size-change
|
||||||
|
ebox-surface-update-buffer-viewport
|
||||||
|
ebox-incremental-prepare-viewport-commit ebox-resize-benchmark-start)))))
|
||||||
|
|
||||||
|
(defun ebox-resize-benchmark--payload (buffer)
|
||||||
|
"Read bounded workload facts from BUFFER, without copying runtime graphs."
|
||||||
|
(let* ((state (and (buffer-live-p buffer) (ebox--buffer-render-state buffer)))
|
||||||
|
(nodes (plist-get state :node-table)))
|
||||||
|
(list :nodes (and (hash-table-p nodes) (hash-table-count nodes))
|
||||||
|
:characters (and (buffer-live-p buffer)
|
||||||
|
(with-current-buffer buffer (buffer-size)))
|
||||||
|
:viewport (list (plist-get state :viewport-width)
|
||||||
|
(plist-get state :viewport-height)))))
|
||||||
|
|
||||||
|
(defun ebox-resize-benchmark--guard ()
|
||||||
|
"Require the captured foreground buffer, frame, font and height."
|
||||||
|
(let* ((run ebox-resize-benchmark--run)
|
||||||
|
(frame (plist-get run :frame))
|
||||||
|
(window (plist-get run :window))
|
||||||
|
(buffer (plist-get run :buffer)))
|
||||||
|
(unless (and (frame-live-p frame) (display-graphic-p frame)
|
||||||
|
(eq frame (selected-frame)) (eq t (frame-visible-p frame))
|
||||||
|
(eq t (frame-focus-state frame)) (window-live-p window)
|
||||||
|
(eq window (selected-window))
|
||||||
|
(eq buffer (window-buffer window))
|
||||||
|
(ebox-surface-buffer-mounted-p buffer)
|
||||||
|
(equal (frame-parameter frame 'font) (plist-get run :font))
|
||||||
|
(= (frame-pixel-height frame) (plist-get run :height))
|
||||||
|
(not (active-minibuffer-window)))
|
||||||
|
(error "Resize target, focus, font, height or mount changed"))))
|
||||||
|
|
||||||
|
(defun ebox-resize-benchmark--phase (name original &rest arguments)
|
||||||
|
"Record inclusive NAME timing around ORIGINAL called with ARGUMENTS."
|
||||||
|
(if (not ebox-resize-benchmark--phases)
|
||||||
|
(apply original arguments)
|
||||||
|
(let ((started (float-time)) (gc-start gc-elapsed))
|
||||||
|
(unwind-protect (apply original arguments)
|
||||||
|
(let ((row (or (gethash name ebox-resize-benchmark--phases)
|
||||||
|
(puthash name (vector 0 0.0 0.0)
|
||||||
|
ebox-resize-benchmark--phases))))
|
||||||
|
(cl-incf (aref row 0))
|
||||||
|
(cl-incf (aref row 1) (* 1000 (- (float-time) started)))
|
||||||
|
(cl-incf (aref row 2) (* 1000 (- gc-elapsed gc-start))))))))
|
||||||
|
|
||||||
|
(defun ebox-resize-benchmark--write (file report)
|
||||||
|
"Write REPORT as UTF-8 data to a new FILE, without overwriting evidence."
|
||||||
|
(let ((coding-system-for-write 'utf-8-unix))
|
||||||
|
(with-temp-buffer
|
||||||
|
(prin1 report (current-buffer))
|
||||||
|
(insert "\n")
|
||||||
|
(write-region (point-min) (point-max) file nil 'silent nil 'excl))))
|
||||||
|
|
||||||
|
(defun ebox-resize-benchmark--finish (status &optional condition)
|
||||||
|
"Release owned resources and record STATUS and optional CONDITION."
|
||||||
|
(let ((run ebox-resize-benchmark--run))
|
||||||
|
(when run
|
||||||
|
;; Cleanup precedes report construction: even a dead buffer or write
|
||||||
|
;; failure cannot leave a timed benchmark attached to the application.
|
||||||
|
(setq ebox-resize-benchmark--run nil)
|
||||||
|
(dolist (key '(:timer :watchdog))
|
||||||
|
(when (timerp (plist-get run key)) (cancel-timer (plist-get run key))))
|
||||||
|
(advice-remove 'ebox-rerender-buffer-with-context
|
||||||
|
#'ebox-resize-benchmark--publication)
|
||||||
|
(dolist (binding (plist-get run :bindings))
|
||||||
|
(advice-remove (car binding) (cdr binding)))
|
||||||
|
(let* ((samples (nreverse (plist-get run :samples)))
|
||||||
|
(valid (and (eq status 'complete)
|
||||||
|
(= (length samples) (plist-get run :planned-count))
|
||||||
|
(cl-every (lambda (sample) (plist-get sample :published)) samples)))
|
||||||
|
(publication (ebox-resize-benchmark--summary
|
||||||
|
(delq nil (mapcar (lambda (s) (plist-get s :publication-ms)) samples))))
|
||||||
|
(latency (ebox-resize-benchmark--summary
|
||||||
|
(delq nil (mapcar (lambda (s) (plist-get s :request-to-published-ms)) samples))))
|
||||||
|
(report
|
||||||
|
(list :format-version 1 :status status :valid valid
|
||||||
|
:failure (and condition (ebox-resize-benchmark--condition condition))
|
||||||
|
:pid (emacs-pid) :emacs-version emacs-version
|
||||||
|
:system-type system-type :buffer (plist-get run :buffer-name)
|
||||||
|
:font (plist-get run :font) :height (plist-get run :height)
|
||||||
|
:range (plist-get run :range) :rounds (plist-get run :rounds)
|
||||||
|
:step (plist-get run :step) :delay (plist-get run :delay)
|
||||||
|
:requested-widths (plist-get run :widths)
|
||||||
|
:start-width (plist-get run :start-width)
|
||||||
|
:gc-before (plist-get run :gc-policy)
|
||||||
|
:gc-after (list gc-cons-threshold gc-cons-percentage)
|
||||||
|
:whole-run-gcs (- gcs-done (plist-get run :gcs))
|
||||||
|
:whole-run-gc-ms (* 1000 (- gc-elapsed (plist-get run :gc)))
|
||||||
|
:code (plist-get run :code) :native (plist-get run :native)
|
||||||
|
:payload-before (plist-get run :payload)
|
||||||
|
:payload-after (ebox-resize-benchmark--payload (plist-get run :buffer))
|
||||||
|
:planned-count (plist-get run :planned-count)
|
||||||
|
:requested-count (length samples)
|
||||||
|
:completed-count (cl-count-if (lambda (s) (plist-get s :published)) samples)
|
||||||
|
:publication publication :request-to-published latency
|
||||||
|
:limit-ms (plist-get run :limit)
|
||||||
|
:within-limit (and valid latency
|
||||||
|
(<= (plist-get latency :max-ms) (plist-get run :limit)))
|
||||||
|
:phase-columns '(calls inclusive-ms gc-ms)
|
||||||
|
:samples samples)))
|
||||||
|
(setq ebox-resize-benchmark--last-result report)
|
||||||
|
(condition-case write-error
|
||||||
|
(ebox-resize-benchmark--write (plist-get run :output) report)
|
||||||
|
((error quit)
|
||||||
|
(setq ebox-resize-benchmark--last-result
|
||||||
|
(plist-put report :evidence-write-error
|
||||||
|
(ebox-resize-benchmark--condition write-error)))
|
||||||
|
(setf (plist-get ebox-resize-benchmark--last-result :status) 'failed
|
||||||
|
(plist-get ebox-resize-benchmark--last-result :valid) nil
|
||||||
|
(plist-get ebox-resize-benchmark--last-result :within-limit) nil)
|
||||||
|
(message "Resize evidence could not be written: %s"
|
||||||
|
(plist-get (ebox-resize-benchmark--condition write-error) :message))
|
||||||
|
(unless condition (signal (car write-error) (cdr write-error)))))))))
|
||||||
|
|
||||||
|
(defun ebox-resize-benchmark--abort (condition)
|
||||||
|
"Record failure and clean up before re-signaling original CONDITION."
|
||||||
|
(condition-case report-error
|
||||||
|
(ebox-resize-benchmark--finish 'failed condition)
|
||||||
|
((error quit)
|
||||||
|
(message "Resize failure report unavailable: %s"
|
||||||
|
(plist-get (ebox-resize-benchmark--condition report-error) :message))))
|
||||||
|
(signal (car condition) (cdr condition)))
|
||||||
|
|
||||||
|
(defun ebox-resize-benchmark--schedule ()
|
||||||
|
"Schedule the next request after the configured event-loop delay."
|
||||||
|
(setf (plist-get ebox-resize-benchmark--run :timer)
|
||||||
|
(run-at-time (plist-get ebox-resize-benchmark--run :delay)
|
||||||
|
nil #'ebox-resize-benchmark--next)))
|
||||||
|
|
||||||
|
(defun ebox-resize-benchmark--timeout ()
|
||||||
|
"Fail a request that did not publish within its configured deadline."
|
||||||
|
(when ebox-resize-benchmark--run
|
||||||
|
(ebox-resize-benchmark--finish 'failed '(error "Resize publication timed out"))))
|
||||||
|
|
||||||
|
(defun ebox-resize-benchmark--settled ()
|
||||||
|
"Wait for the product's own GC lease to restore, without changing policy."
|
||||||
|
(when ebox-resize-benchmark--run
|
||||||
|
(condition-case condition
|
||||||
|
(progn
|
||||||
|
(ebox-resize-benchmark--guard)
|
||||||
|
(cond
|
||||||
|
((and (not ebox--deferred-render-gc-state)
|
||||||
|
(equal (list gc-cons-threshold gc-cons-percentage)
|
||||||
|
(plist-get ebox-resize-benchmark--run :gc-policy)))
|
||||||
|
(ebox-resize-benchmark--finish 'complete))
|
||||||
|
((>= (float-time) (plist-get ebox-resize-benchmark--run :settle-deadline))
|
||||||
|
(error "GC policy did not restore before the settle deadline"))
|
||||||
|
(t
|
||||||
|
(setf (plist-get ebox-resize-benchmark--run :timer)
|
||||||
|
(run-at-time .05 nil #'ebox-resize-benchmark--settled)))))
|
||||||
|
((error quit) (ebox-resize-benchmark--abort condition)))))
|
||||||
|
|
||||||
|
(defun ebox-resize-benchmark--publication (original buffer width &optional height)
|
||||||
|
"Measure ORIGINAL publishing BUFFER for WIDTH and HEIGHT."
|
||||||
|
(if (or ebox-resize-benchmark--inside (not ebox-resize-benchmark--run)
|
||||||
|
(not (plist-get ebox-resize-benchmark--run :armed))
|
||||||
|
(not (eq (get-buffer buffer) (plist-get ebox-resize-benchmark--run :buffer))))
|
||||||
|
(funcall original buffer width height)
|
||||||
|
(let* ((ebox-resize-benchmark--inside t)
|
||||||
|
(run ebox-resize-benchmark--run)
|
||||||
|
(sample (plist-get run :current))
|
||||||
|
(expected (and sample (not (plist-get sample :published))))
|
||||||
|
(phase-data (make-hash-table :test #'eq))
|
||||||
|
before-failure failure result completed)
|
||||||
|
(unwind-protect
|
||||||
|
(progn
|
||||||
|
(condition-case condition (ebox-resize-benchmark--guard)
|
||||||
|
(error (setq before-failure condition)))
|
||||||
|
(let ((started (float-time)) (cpu (current-cpu-time))
|
||||||
|
(gc gc-elapsed) (gcs gcs-done)
|
||||||
|
(policy (list gc-cons-threshold gc-cons-percentage)))
|
||||||
|
;; Attribution errors belong to this diagnostic, not the app.
|
||||||
|
;; Always execute the real call once and preserve its outcome.
|
||||||
|
(condition-case condition
|
||||||
|
(let ((ebox-resize-benchmark--phases phase-data))
|
||||||
|
(setq result (funcall original buffer width height)))
|
||||||
|
((error quit) (setq failure condition)))
|
||||||
|
(let ((finished (float-time)) (cpu-end (current-cpu-time))
|
||||||
|
(gc-end gc-elapsed) (gcs-end gcs-done))
|
||||||
|
;; An observer may cancel this run or start a replacement.
|
||||||
|
;; Never mutate a retired sample or schedule through a new run.
|
||||||
|
(when (eq run ebox-resize-benchmark--run)
|
||||||
|
(condition-case condition
|
||||||
|
(progn
|
||||||
|
(unless (and expected (eq sample (plist-get run :current)))
|
||||||
|
(error "Unattributed or duplicate publication during resize"))
|
||||||
|
(let ((payload (ebox-resize-benchmark--payload (get-buffer buffer)))
|
||||||
|
(window (plist-get run :window)) phases)
|
||||||
|
(maphash (lambda (name values) (push (cons name values) phases))
|
||||||
|
phase-data)
|
||||||
|
(setf (plist-get sample :publication-ms) (* 1000 (- finished started))
|
||||||
|
(plist-get sample :request-to-published-ms)
|
||||||
|
(* 1000 (- finished (plist-get sample :requested-at)))
|
||||||
|
(plist-get sample :cpu-ms)
|
||||||
|
(* 1000.0 (/ (- (car cpu-end) (car cpu)) (float (cdr cpu))))
|
||||||
|
(plist-get sample :gc-ms) (* 1000 (- gc-end gc))
|
||||||
|
(plist-get sample :gcs) (- gcs-end gcs)
|
||||||
|
(plist-get sample :gc-policy) policy
|
||||||
|
(plist-get sample :payload) payload
|
||||||
|
(plist-get sample :phases) phases
|
||||||
|
(plist-get sample :foreground-before) (not before-failure))
|
||||||
|
(when failure (signal (car failure) (cdr failure)))
|
||||||
|
(when before-failure (signal (car before-failure) (cdr before-failure)))
|
||||||
|
(ebox-resize-benchmark--guard)
|
||||||
|
(setf (plist-get sample :foreground-after) t)
|
||||||
|
(unless (and (= (frame-pixel-width (plist-get run :frame))
|
||||||
|
(plist-get sample :width))
|
||||||
|
(equal (list width height)
|
||||||
|
(list (ebox-viewport-window-width window)
|
||||||
|
(window-body-height window)))
|
||||||
|
(equal (list width height) (plist-get payload :viewport)))
|
||||||
|
(error "Requested, actual and published viewport dimensions disagree"))
|
||||||
|
(when (> finished (+ (plist-get sample :requested-at)
|
||||||
|
(plist-get run :timeout)))
|
||||||
|
(error "Resize publication exceeded its deadline"))
|
||||||
|
(setf (plist-get sample :published) t)
|
||||||
|
(cancel-timer (plist-get run :watchdog))
|
||||||
|
(setf (plist-get run :watchdog) nil)
|
||||||
|
(ebox-resize-benchmark--schedule)))
|
||||||
|
((error quit) (ebox-resize-benchmark--observation-failed run condition))))))
|
||||||
|
(setq completed t)
|
||||||
|
(if failure (signal (car failure) (cdr failure)) result))
|
||||||
|
(unless completed
|
||||||
|
(ebox-resize-benchmark--observation-failed
|
||||||
|
run '(error "Publication exited before observation completed")))))))
|
||||||
|
|
||||||
|
(defun ebox-resize-benchmark--observation-failed (run condition)
|
||||||
|
"Retire captured RUN with CONDITION without changing a product return value."
|
||||||
|
(when (eq run ebox-resize-benchmark--run)
|
||||||
|
(condition-case report-error
|
||||||
|
(ebox-resize-benchmark--finish 'failed condition)
|
||||||
|
((error quit)
|
||||||
|
(message "Resize failure report unavailable: %s"
|
||||||
|
(plist-get (ebox-resize-benchmark--condition report-error) :message))))))
|
||||||
|
|
||||||
|
(defun ebox-resize-benchmark--ready-p (run)
|
||||||
|
"Arm RUN after preceding rendering has released its GC lease."
|
||||||
|
(or (plist-get run :armed)
|
||||||
|
(cond
|
||||||
|
((>= (float-time) (plist-get run :ready-deadline))
|
||||||
|
(error "Preceding render did not settle before the startup deadline"))
|
||||||
|
(ebox--deferred-render-gc-state
|
||||||
|
(ebox-resize-benchmark--schedule)
|
||||||
|
nil)
|
||||||
|
(t
|
||||||
|
(setf (plist-get run :gc-policy) (list gc-cons-threshold gc-cons-percentage)
|
||||||
|
(plist-get run :gcs) gcs-done
|
||||||
|
(plist-get run :gc) gc-elapsed
|
||||||
|
(plist-get run :payload)
|
||||||
|
(ebox-resize-benchmark--payload (plist-get run :buffer))
|
||||||
|
(plist-get run :armed) t)))))
|
||||||
|
|
||||||
|
(defun ebox-resize-benchmark--next ()
|
||||||
|
"Issue one resize, then return to Emacs until its publication completes."
|
||||||
|
(when ebox-resize-benchmark--run
|
||||||
|
(condition-case condition
|
||||||
|
(let ((inhibit-quit nil))
|
||||||
|
(ebox-resize-benchmark--guard)
|
||||||
|
(let* ((run ebox-resize-benchmark--run)
|
||||||
|
(frame (plist-get run :frame))
|
||||||
|
(width (car (plist-get run :remaining))))
|
||||||
|
(setf (plist-get run :timer) nil)
|
||||||
|
(when (ebox-resize-benchmark--ready-p run)
|
||||||
|
(if (not width)
|
||||||
|
(progn
|
||||||
|
(setf (plist-get run :settle-deadline)
|
||||||
|
(+ (float-time) (plist-get run :timeout)))
|
||||||
|
(ebox-resize-benchmark--settled))
|
||||||
|
;; Allocate every mutable slot before sharing this record with
|
||||||
|
;; the publication callback: plist setters may replace a head
|
||||||
|
;; when adding a previously absent key.
|
||||||
|
(let ((sample (list :index (1+ (length (plist-get run :samples)))
|
||||||
|
:width width :requested-at (float-time)
|
||||||
|
:publication-ms nil :request-to-published-ms nil
|
||||||
|
:cpu-ms nil :gc-ms nil :gcs nil :gc-policy nil
|
||||||
|
:payload nil :phases nil :published nil
|
||||||
|
:foreground-before nil :foreground-after nil))
|
||||||
|
(frame-resize-pixelwise t))
|
||||||
|
(setf (plist-get run :remaining) (cdr (plist-get run :remaining))
|
||||||
|
(plist-get run :current) sample
|
||||||
|
(plist-get run :samples) (cons sample (plist-get run :samples))
|
||||||
|
(plist-get run :watchdog)
|
||||||
|
(run-at-time (plist-get run :timeout) nil
|
||||||
|
#'ebox-resize-benchmark--timeout))
|
||||||
|
(set-frame-size frame
|
||||||
|
(- width (- (frame-pixel-width frame)
|
||||||
|
(frame-text-width frame)))
|
||||||
|
(frame-text-height frame) t)
|
||||||
|
(redisplay t))))))
|
||||||
|
((error quit) (ebox-resize-benchmark--abort condition)))))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(cl-defun ebox-resize-benchmark-start
|
||||||
|
(buffer minimum maximum &key (step 32) (rounds 3) (delay .01)
|
||||||
|
(timeout 5.0) (limit-ms 50.0) output reload-files phases)
|
||||||
|
"Resize existing BUFFER from MINIMUM to MAXIMUM outer-frame pixels.
|
||||||
|
STEP and ROUNDS control repeated narrow→wide→narrow sweeps. The final measured
|
||||||
|
request restores the starting width. OUTPUT must name a new evidence file.
|
||||||
|
DELAY spaces completed publications; TIMEOUT bounds startup and publication.
|
||||||
|
LIMIT-MS applies to all request→publication samples, including GC and first use.
|
||||||
|
RELOAD-FILES explicitly reloads fresh compiled modules before measurement.
|
||||||
|
PHASES names loaded ebox-/tp-/etaf- functions for inclusive diagnostics.
|
||||||
|
Use `ebox-resize-benchmark-status' to poll and `ebox-resize-benchmark-cancel'
|
||||||
|
to stop. Failure stops at the current width. No frame or server is created,
|
||||||
|
no application observer is replaced, and no GC/font policy is changed."
|
||||||
|
(when ebox-resize-benchmark--run (error "A resize benchmark is already active"))
|
||||||
|
(unless (and (stringp output) (not (file-exists-p output))
|
||||||
|
(file-directory-p (file-name-directory (expand-file-name output)))
|
||||||
|
(numberp delay) (> delay 0) (numberp timeout) (> timeout delay)
|
||||||
|
(numberp limit-ms) (> limit-ms 0))
|
||||||
|
(error "Resize requires a new output path and positive delay/timeout/limit"))
|
||||||
|
(when (and (fboundp 'profiler-running-p) (profiler-running-p))
|
||||||
|
(error "Stop profiling before collecting resize latency"))
|
||||||
|
(dolist (name phases)
|
||||||
|
(unless (and (symbolp name) (fboundp name)
|
||||||
|
(string-match-p "\\`\\(?:ebox\\|tp\\|etaf\\)-" (symbol-name name))
|
||||||
|
(not (string-prefix-p "ebox-resize-benchmark-" (symbol-name name)))
|
||||||
|
(not (eq name 'ebox-rerender-buffer-with-context)))
|
||||||
|
(error "Invalid or duplicate outer measurement phase: %s" name)))
|
||||||
|
(let* ((target (get-buffer buffer))
|
||||||
|
(frame (selected-frame))
|
||||||
|
(initial (frame-pixel-width frame))
|
||||||
|
(widths (ebox-resize-benchmark--widths minimum maximum step rounds initial)))
|
||||||
|
(setq ebox-resize-benchmark--last-result nil
|
||||||
|
ebox-resize-benchmark--run
|
||||||
|
(list :buffer target :buffer-name (and target (buffer-name target))
|
||||||
|
:frame frame :window (selected-window)
|
||||||
|
:font (frame-parameter frame 'font) :height (frame-pixel-height frame)
|
||||||
|
:gc-policy (list gc-cons-threshold gc-cons-percentage)
|
||||||
|
:gcs gcs-done :gc gc-elapsed :code nil :native nil :payload nil
|
||||||
|
:start-width initial :widths widths :remaining widths
|
||||||
|
:planned-count (length widths) :range (list minimum maximum)
|
||||||
|
:rounds rounds :step step :delay delay :timeout timeout
|
||||||
|
:limit limit-ms :output (expand-file-name output)
|
||||||
|
:timer nil :watchdog nil :current nil :samples nil
|
||||||
|
:bindings nil :settle-deadline nil :armed nil :ready-deadline nil))
|
||||||
|
(condition-case condition
|
||||||
|
(progn
|
||||||
|
(ebox-resize-benchmark--guard)
|
||||||
|
(setf (plist-get ebox-resize-benchmark--run :code)
|
||||||
|
(ebox-resize-benchmark--code reload-files)
|
||||||
|
(plist-get ebox-resize-benchmark--run :native)
|
||||||
|
(and (fboundp 'ebox-native-reflow-runtime-report)
|
||||||
|
(ebox-native-reflow-runtime-report))
|
||||||
|
(plist-get ebox-resize-benchmark--run :payload)
|
||||||
|
(ebox-resize-benchmark--payload target)
|
||||||
|
(plist-get ebox-resize-benchmark--run :gcs) gcs-done
|
||||||
|
(plist-get ebox-resize-benchmark--run :gc) gc-elapsed)
|
||||||
|
(ebox-resize-benchmark--guard)
|
||||||
|
(setf (plist-get ebox-resize-benchmark--run :ready-deadline)
|
||||||
|
(+ (float-time) timeout))
|
||||||
|
(dolist (name (delete-dups (copy-sequence phases)))
|
||||||
|
(let ((wrapper (apply-partially #'ebox-resize-benchmark--phase name)))
|
||||||
|
(push (cons name wrapper) (plist-get ebox-resize-benchmark--run :bindings))
|
||||||
|
(advice-add name :around wrapper)))
|
||||||
|
(advice-add 'ebox-rerender-buffer-with-context :around
|
||||||
|
#'ebox-resize-benchmark--publication)
|
||||||
|
(ebox-resize-benchmark--schedule)
|
||||||
|
(ebox-resize-benchmark-status))
|
||||||
|
((error quit) (ebox-resize-benchmark--abort condition)))))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun ebox-resize-benchmark-status ()
|
||||||
|
"Return bounded progress or the last run's completion/latency summary."
|
||||||
|
(if ebox-resize-benchmark--run
|
||||||
|
(list :status 'running
|
||||||
|
:requested (length (plist-get ebox-resize-benchmark--run :samples))
|
||||||
|
:planned (plist-get ebox-resize-benchmark--run :planned-count)
|
||||||
|
:output (plist-get ebox-resize-benchmark--run :output))
|
||||||
|
(cl-loop for key in '(:status :valid :failure :completed-count :planned-count
|
||||||
|
:publication :request-to-published :within-limit
|
||||||
|
:evidence-write-error)
|
||||||
|
append (list key (plist-get ebox-resize-benchmark--last-result key)))))
|
||||||
|
|
||||||
|
;;;###autoload
|
||||||
|
(defun ebox-resize-benchmark-cancel ()
|
||||||
|
"Stop this benchmark and release its timers and advice."
|
||||||
|
(interactive)
|
||||||
|
(ebox-resize-benchmark--finish 'cancelled '(quit "Resize cancelled"))
|
||||||
|
(ebox-resize-benchmark-status))
|
||||||
|
|
||||||
|
(provide 'benchmark-ebox-resize)
|
||||||
|
;;; benchmark-ebox-resize.el ends here
|
||||||
337
tests/etaf-resize-benchmark-tests.el
Normal file
337
tests/etaf-resize-benchmark-tests.el
Normal file
@ -0,0 +1,337 @@
|
|||||||
|
;;; etaf-resize-benchmark-tests.el --- Resize driver contracts -*- lexical-binding: t; -*-
|
||||||
|
|
||||||
|
;;; Code:
|
||||||
|
|
||||||
|
(require 'ert)
|
||||||
|
(require 'cl-lib)
|
||||||
|
(require 'benchmark-ebox-resize)
|
||||||
|
|
||||||
|
(defmacro etaf-resize-test--with-run (&rest body)
|
||||||
|
"Evaluate BODY with isolated evidence and deterministic frame/publication IO."
|
||||||
|
(declare (indent 0) (debug t))
|
||||||
|
`(let* ((directory (make-temp-file "etaf-resize-test-" t))
|
||||||
|
(output (expand-file-name "result.eldata" directory))
|
||||||
|
(buffer (generate-new-buffer " *resize-test*"))
|
||||||
|
(ebox-resize-benchmark--run nil)
|
||||||
|
(ebox-resize-benchmark--last-result nil)
|
||||||
|
(ebox--deferred-render-gc-state nil)
|
||||||
|
(width 600))
|
||||||
|
(unwind-protect
|
||||||
|
(cl-letf (((symbol-function 'ebox-resize-benchmark--guard) #'ignore)
|
||||||
|
((symbol-function 'ebox-resize-benchmark--code) (lambda (_) nil))
|
||||||
|
((symbol-function 'ebox-native-reflow-runtime-report) #'ignore)
|
||||||
|
((symbol-function 'ebox-resize-benchmark--payload)
|
||||||
|
(lambda (_buffer) (list :nodes 3 :characters 4 :viewport (list width 24))))
|
||||||
|
((symbol-function 'frame-pixel-width) (lambda (&optional _) width))
|
||||||
|
((symbol-function 'frame-text-width) (lambda (&optional _) width))
|
||||||
|
((symbol-function 'frame-text-height) (lambda (&optional _) 400))
|
||||||
|
((symbol-function 'ebox-viewport-window-width) (lambda (_) width))
|
||||||
|
((symbol-function 'window-body-height) (lambda (&rest _) 24))
|
||||||
|
((symbol-function 'redisplay) #'ignore)
|
||||||
|
((symbol-function 'set-frame-size)
|
||||||
|
(lambda (_frame new-width _height &optional _) (setq width new-width))))
|
||||||
|
,@body)
|
||||||
|
(when ebox-resize-benchmark--run
|
||||||
|
(ebox-resize-benchmark-cancel))
|
||||||
|
(when (buffer-live-p buffer) (kill-buffer buffer))
|
||||||
|
(delete-directory directory t))))
|
||||||
|
|
||||||
|
(defun etaf-resize-test--tick ()
|
||||||
|
"Consume the owned driver timer and execute one request synchronously."
|
||||||
|
(cancel-timer (plist-get ebox-resize-benchmark--run :timer))
|
||||||
|
(ebox-resize-benchmark--next))
|
||||||
|
|
||||||
|
(ert-deftest etaf-resize-widths-cover-both-endpoints-and-return ()
|
||||||
|
"Non-divisible ranges retain their widest point on every sweep."
|
||||||
|
(should (equal (ebox-resize-benchmark--widths 400 505 40 2 600)
|
||||||
|
'(400 440 480 505 480 440 400 440 480 505 480 440 400 600)))
|
||||||
|
(should (equal (ebox-resize-benchmark--widths 400 500 100 1 400)
|
||||||
|
'(500 400)))
|
||||||
|
(dolist (args '((0 500 1 1 400) (500 400 1 1 400)
|
||||||
|
(400 500 0 1 400) (400 500 1 0 400)))
|
||||||
|
(should-error (apply #'ebox-resize-benchmark--widths args))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-resize-completion-keeps-every-publication-and-restores-width ()
|
||||||
|
"Only successful publication advances the driver; all samples are retained."
|
||||||
|
(etaf-resize-test--with-run
|
||||||
|
(ebox-resize-benchmark-start buffer 400 800 :step 200 :rounds 1 :delay 10 :timeout 20 :output output)
|
||||||
|
(let ((planned (plist-get ebox-resize-benchmark--run :planned-count)))
|
||||||
|
(dotimes (_ planned)
|
||||||
|
(etaf-resize-test--tick)
|
||||||
|
(should-not (plist-get ebox-resize-benchmark--run :timer))
|
||||||
|
(should (timerp (plist-get ebox-resize-benchmark--run :watchdog)))
|
||||||
|
(should (eq :published
|
||||||
|
(ebox-resize-benchmark--publication (lambda (&rest _) :published)
|
||||||
|
buffer width 24)))
|
||||||
|
(should (timerp (plist-get ebox-resize-benchmark--run :timer)))
|
||||||
|
(should-not (plist-get ebox-resize-benchmark--run :watchdog)))
|
||||||
|
(etaf-resize-test--tick)
|
||||||
|
(should-not ebox-resize-benchmark--run)
|
||||||
|
(should (= width 600))
|
||||||
|
(should (plist-get ebox-resize-benchmark--last-result :valid))
|
||||||
|
(should (= planned (plist-get ebox-resize-benchmark--last-result :completed-count)))
|
||||||
|
(should (file-exists-p output))
|
||||||
|
(should-not (advice-member-p #'ebox-resize-benchmark--publication
|
||||||
|
'ebox-rerender-buffer-with-context)))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-resize-publication-error-and-quit-preserve-cause-and-cleanup ()
|
||||||
|
"Original errors and C-g cannot leave advice or timers attached."
|
||||||
|
(dolist (failure '((error "original publication failure") (quit "publication interrupted")))
|
||||||
|
(etaf-resize-test--with-run
|
||||||
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
||||||
|
(etaf-resize-test--tick)
|
||||||
|
(let ((watchdog (plist-get ebox-resize-benchmark--run :watchdog)) caught)
|
||||||
|
(condition-case condition
|
||||||
|
(ebox-resize-benchmark--publication
|
||||||
|
(lambda (&rest _) (signal (car failure) (cdr failure))) buffer width 24)
|
||||||
|
((error quit) (setq caught condition)))
|
||||||
|
(should (equal caught failure))
|
||||||
|
(should-not ebox-resize-benchmark--run)
|
||||||
|
(should-not (memq watchdog timer-list))
|
||||||
|
(should-not (advice-member-p #'ebox-resize-benchmark--publication
|
||||||
|
'ebox-rerender-buffer-with-context))
|
||||||
|
(should (= 0 (plist-get ebox-resize-benchmark--last-result :completed-count)))
|
||||||
|
(should-not (plist-get ebox-resize-benchmark--last-result :valid))))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-resize-timeout-is-incomplete-and-releases-owned-resources ()
|
||||||
|
"No publication must produce failed evidence, never a successful sample."
|
||||||
|
(etaf-resize-test--with-run
|
||||||
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
||||||
|
(etaf-resize-test--tick)
|
||||||
|
(let ((watchdog (plist-get ebox-resize-benchmark--run :watchdog)))
|
||||||
|
(ebox-resize-benchmark--timeout)
|
||||||
|
(should-not ebox-resize-benchmark--run)
|
||||||
|
(should-not (memq watchdog timer-list))
|
||||||
|
(should (eq 'failed (plist-get ebox-resize-benchmark--last-result :status)))
|
||||||
|
(should (= 1 (plist-get ebox-resize-benchmark--last-result :requested-count)))
|
||||||
|
(should (= 0 (plist-get ebox-resize-benchmark--last-result :completed-count))))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-resize-report-failure-preserves-publication-failure ()
|
||||||
|
"A secondary write failure is visible while the original error survives."
|
||||||
|
(etaf-resize-test--with-run
|
||||||
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
||||||
|
(let (warning)
|
||||||
|
(cl-letf (((symbol-function 'ebox-resize-benchmark--write)
|
||||||
|
(lambda (&rest _) (error "disk failure")))
|
||||||
|
((symbol-function 'message)
|
||||||
|
(lambda (format-string &rest args)
|
||||||
|
(setq warning (apply #'format format-string args)))))
|
||||||
|
(should (equal '(error "original")
|
||||||
|
(should-error (ebox-resize-benchmark--abort '(error "original"))))))
|
||||||
|
(should (string-match-p "disk failure" warning))
|
||||||
|
(should (plist-get ebox-resize-benchmark--last-result :evidence-write-error))
|
||||||
|
(should-not ebox-resize-benchmark--run))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-resize-partial-installation-releases-earlier-phase-advice ()
|
||||||
|
"Instrumentation setup failure cleans previously installed advice."
|
||||||
|
(etaf-resize-test--with-run
|
||||||
|
(let ((original-add (symbol-function 'advice-add)) (calls 0))
|
||||||
|
(cl-letf (((symbol-function 'advice-add)
|
||||||
|
(lambda (&rest args)
|
||||||
|
(if (= 2 (cl-incf calls)) (error "injected install failure")
|
||||||
|
(apply original-add args)))))
|
||||||
|
(should-error
|
||||||
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20
|
||||||
|
:phases '(ebox-viewport-window-width ebox-surface-buffer-revision)
|
||||||
|
:output output)))
|
||||||
|
(should-not ebox-resize-benchmark--run)
|
||||||
|
(let (remaining)
|
||||||
|
(advice-mapc (lambda (_fn _props) (setq remaining t)) 'ebox-viewport-window-width)
|
||||||
|
(should-not remaining)))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-resize-mismatched-viewport-cannot-count-as-publication ()
|
||||||
|
"A call returning normally is insufficient when published geometry differs."
|
||||||
|
(etaf-resize-test--with-run
|
||||||
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
||||||
|
(etaf-resize-test--tick)
|
||||||
|
(should (eq :real-result
|
||||||
|
(ebox-resize-benchmark--publication (lambda (&rest _) :real-result)
|
||||||
|
buffer (1+ width) 24)))
|
||||||
|
(should-not (plist-get ebox-resize-benchmark--last-result :valid))
|
||||||
|
(should (= 0 (plist-get ebox-resize-benchmark--last-result :completed-count)))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-resize-writer-refuses-existing-evidence ()
|
||||||
|
"A later invocation must not silently overwrite a previous report."
|
||||||
|
(etaf-resize-test--with-run
|
||||||
|
(ebox-resize-benchmark--write output '(:original t))
|
||||||
|
(should-error (ebox-resize-benchmark--write output '(:replacement t)))
|
||||||
|
(with-temp-buffer
|
||||||
|
(insert-file-contents output)
|
||||||
|
(should (equal '(:original t) (read (current-buffer)))))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-resize-nested-publication-counts-only-the-outer-call ()
|
||||||
|
"Nested public calls belong to the same measured viewport request."
|
||||||
|
(etaf-resize-test--with-run
|
||||||
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
||||||
|
(etaf-resize-test--tick)
|
||||||
|
(should
|
||||||
|
(eq :outer
|
||||||
|
(ebox-resize-benchmark--publication
|
||||||
|
(lambda (&rest _)
|
||||||
|
(ebox-resize-benchmark--publication #'ignore buffer width 24)
|
||||||
|
:outer)
|
||||||
|
buffer width 24)))
|
||||||
|
(should (= 1 (length (plist-get ebox-resize-benchmark--run :samples))))
|
||||||
|
(should (timerp (plist-get ebox-resize-benchmark--run :timer)))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-resize-successful-coverage-without-written-evidence-fails ()
|
||||||
|
"Successful calls cannot yield a passed tool result if evidence was lost."
|
||||||
|
(etaf-resize-test--with-run
|
||||||
|
(ebox-resize-benchmark-start buffer 400 800 :step 400 :rounds 1
|
||||||
|
:delay 10 :timeout 20 :output output)
|
||||||
|
(dotimes (_ (plist-get ebox-resize-benchmark--run :planned-count))
|
||||||
|
(etaf-resize-test--tick)
|
||||||
|
(ebox-resize-benchmark--publication #'ignore buffer width 24))
|
||||||
|
(cl-letf (((symbol-function 'ebox-resize-benchmark--write)
|
||||||
|
(lambda (&rest _) (error "disk failure")))
|
||||||
|
((symbol-function 'message) #'ignore))
|
||||||
|
(should-error (etaf-resize-test--tick)))
|
||||||
|
(should-not ebox-resize-benchmark--run)
|
||||||
|
(should (eq 'failed (plist-get ebox-resize-benchmark--last-result :status)))
|
||||||
|
(should-not (plist-get ebox-resize-benchmark--last-result :valid))
|
||||||
|
(should-not (plist-get ebox-resize-benchmark--last-result :within-limit))
|
||||||
|
(should (plist-get ebox-resize-benchmark--last-result :evidence-write-error))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-resize-unattributed-call-still-executes-product-once ()
|
||||||
|
"Diagnostic attribution failure must not prevent real application work."
|
||||||
|
(etaf-resize-test--with-run
|
||||||
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
||||||
|
(etaf-resize-test--tick)
|
||||||
|
(ebox-resize-benchmark--publication #'ignore buffer width 24)
|
||||||
|
(let ((calls 0))
|
||||||
|
(should (eq :real-result
|
||||||
|
(ebox-resize-benchmark--publication
|
||||||
|
(lambda (&rest _) (cl-incf calls) :real-result) buffer width 24)))
|
||||||
|
(should (= calls 1))
|
||||||
|
(should-not ebox-resize-benchmark--run)
|
||||||
|
(should-not (plist-get ebox-resize-benchmark--last-result :valid)))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-resize-cancel-from-product-callback-cannot-rearm-run ()
|
||||||
|
"Cancellation inside a publication prevents its old callback from rearming."
|
||||||
|
(etaf-resize-test--with-run
|
||||||
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
||||||
|
(etaf-resize-test--tick)
|
||||||
|
(should (eq :real-result
|
||||||
|
(ebox-resize-benchmark--publication
|
||||||
|
(lambda (&rest _) (ebox-resize-benchmark-cancel) :real-result)
|
||||||
|
buffer width 24)))
|
||||||
|
(should-not ebox-resize-benchmark--run)
|
||||||
|
(should (eq 'cancelled (plist-get ebox-resize-benchmark--last-result :status)))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-resize-old-publication-cannot-reschedule-replacement-run ()
|
||||||
|
"A callback may replace the benchmark; old completion cannot own its timer."
|
||||||
|
(etaf-resize-test--with-run
|
||||||
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
||||||
|
(etaf-resize-test--tick)
|
||||||
|
(let (new-run new-timer)
|
||||||
|
(ebox-resize-benchmark--publication
|
||||||
|
(lambda (&rest _)
|
||||||
|
(ebox-resize-benchmark-cancel)
|
||||||
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20
|
||||||
|
:output (expand-file-name "new.eldata" directory))
|
||||||
|
(setq new-run ebox-resize-benchmark--run
|
||||||
|
new-timer (plist-get new-run :timer)))
|
||||||
|
buffer width 24)
|
||||||
|
(should (eq new-run ebox-resize-benchmark--run))
|
||||||
|
(should (eq new-timer (plist-get new-run :timer)))
|
||||||
|
(should-not (plist-get new-run :samples)))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-resize-publication-boundary-detects-transient-focus-loss ()
|
||||||
|
"Losing focus before publication invalidates it even if the call restores it."
|
||||||
|
(etaf-resize-test--with-run
|
||||||
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
||||||
|
(etaf-resize-test--tick)
|
||||||
|
(let (focused)
|
||||||
|
(cl-letf (((symbol-function 'ebox-resize-benchmark--guard)
|
||||||
|
(lambda () (unless focused (error "lost focus")))))
|
||||||
|
(should (eq :real-result
|
||||||
|
(ebox-resize-benchmark--publication
|
||||||
|
(lambda (&rest _) (setq focused t) :real-result) buffer width 24))))
|
||||||
|
(should-not ebox-resize-benchmark--run)
|
||||||
|
(should-not (plist-get ebox-resize-benchmark--last-result :valid)))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-resize-blocking-publication-cannot-hide-expired-deadline ()
|
||||||
|
"Completion must check the deadline even if the event loop could not poll it."
|
||||||
|
(etaf-resize-test--with-run
|
||||||
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
||||||
|
(etaf-resize-test--tick)
|
||||||
|
(setf (plist-get (plist-get ebox-resize-benchmark--run :current) :requested-at)
|
||||||
|
(- (float-time) 30))
|
||||||
|
(should (eq :real-result
|
||||||
|
(ebox-resize-benchmark--publication (lambda (&rest _) :real-result)
|
||||||
|
buffer width 24)))
|
||||||
|
(should-not ebox-resize-benchmark--run)
|
||||||
|
(should-not (plist-get ebox-resize-benchmark--last-result :valid))
|
||||||
|
(should (> (plist-get (car (plist-get ebox-resize-benchmark--last-result :samples))
|
||||||
|
:request-to-published-ms) 20000))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-resize-code-evidence-includes-every-reload-and-the-driver ()
|
||||||
|
"Explicitly loaded modules need evidence even without a sentinel function."
|
||||||
|
(let* ((directory (make-temp-file "etaf-resize-code-" t))
|
||||||
|
(source (expand-file-name "etaf-resize-evidence-fixture.el" directory))
|
||||||
|
(compiled (concat source "c"))
|
||||||
|
(features (copy-sequence features)))
|
||||||
|
(unwind-protect
|
||||||
|
(progn
|
||||||
|
(with-temp-file source
|
||||||
|
(insert ";;; -*- lexical-binding: t; -*-\n"
|
||||||
|
"(provide 'etaf-resize-evidence-fixture)\n"))
|
||||||
|
(should (byte-compile-file source))
|
||||||
|
(let* ((code (ebox-resize-benchmark--code (list compiled)))
|
||||||
|
(reload (car (plist-get code :reload-files)))
|
||||||
|
(driver (cl-find 'ebox-resize-benchmark-start (plist-get code :functions)
|
||||||
|
:key (lambda (entry) (plist-get entry :function)))))
|
||||||
|
(should (featurep 'etaf-resize-evidence-fixture))
|
||||||
|
(should (equal (plist-get reload :file) (file-truename compiled)))
|
||||||
|
(should (plist-get reload :loaded))
|
||||||
|
(should (equal (plist-get reload :sha256)
|
||||||
|
(ebox-resize-benchmark--hash-file compiled)))
|
||||||
|
(should (equal (plist-get reload :source-sha256)
|
||||||
|
(ebox-resize-benchmark--hash-file source)))
|
||||||
|
(should (plist-get driver :origin-sha256))))
|
||||||
|
(delete-directory directory t))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-resize-start-waits-for-existing-gc-lease-without-measuring-it ()
|
||||||
|
"A preceding render must settle before recording the benchmark baseline."
|
||||||
|
(etaf-resize-test--with-run
|
||||||
|
(let ((ebox--deferred-render-gc-state '(:busy t))
|
||||||
|
(gc-cons-threshold (* 128 1024 1024))
|
||||||
|
(gc-cons-percentage .1))
|
||||||
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
||||||
|
(etaf-resize-test--tick)
|
||||||
|
(should-not (plist-get ebox-resize-benchmark--run :samples))
|
||||||
|
(should (= width 600))
|
||||||
|
(should (eq :prior-render
|
||||||
|
(ebox-resize-benchmark--publication
|
||||||
|
(lambda (&rest _) :prior-render) buffer width 24)))
|
||||||
|
(setq ebox--deferred-render-gc-state nil gc-cons-threshold (* 16 1024 1024))
|
||||||
|
(etaf-resize-test--tick)
|
||||||
|
(should (plist-get ebox-resize-benchmark--run :armed))
|
||||||
|
(should (= width 400))
|
||||||
|
(should (equal (plist-get ebox-resize-benchmark--run :gc-policy)
|
||||||
|
(list gc-cons-threshold gc-cons-percentage))))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-resize-startup-lease-wait-is-bounded ()
|
||||||
|
"A stuck preceding render fails without issuing a benchmark resize."
|
||||||
|
(etaf-resize-test--with-run
|
||||||
|
(let ((ebox--deferred-render-gc-state '(:busy t)))
|
||||||
|
(ebox-resize-benchmark-start buffer 400 800 :delay 10 :timeout 20 :output output)
|
||||||
|
(setf (plist-get ebox-resize-benchmark--run :ready-deadline) (1- (float-time)))
|
||||||
|
(should-error (etaf-resize-test--tick))
|
||||||
|
(should (= width 600))
|
||||||
|
(should-not ebox-resize-benchmark--run)
|
||||||
|
(should-not (plist-get ebox-resize-benchmark--last-result :valid))
|
||||||
|
(should (= 0 (plist-get ebox-resize-benchmark--last-result :requested-count))))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-resize-phase-selection-rejects-the-measurement-machinery ()
|
||||||
|
"Instrumentation cannot recursively time its own clock and bookkeeping."
|
||||||
|
(etaf-resize-test--with-run
|
||||||
|
(dolist (phase '(float-time gethash ebox-resize-benchmark--payload
|
||||||
|
ebox-rerender-buffer-with-context))
|
||||||
|
(should-error (ebox-resize-benchmark-start buffer 400 800
|
||||||
|
:phases (list phase) :output output)))
|
||||||
|
(should-not ebox-resize-benchmark--run)
|
||||||
|
(should-not (file-exists-p output))))
|
||||||
|
|
||||||
|
(provide 'etaf-resize-benchmark-tests)
|
||||||
|
;;; etaf-resize-benchmark-tests.el ends here
|
||||||
Loading…
Reference in New Issue
Block a user