diff --git a/AGENTS.md b/AGENTS.md index f7631f5..82c1007 100644 --- a/AGENTS.md +++ b/AGENTS.md @@ -10,6 +10,9 @@ 及既有 Makefile 入口;公共机制归 `scripts/`,具体业务场景归示例仓库。 - 现有 Emacs 的截图与录像默认保留用户当前应用焦点,使用已登记的窗口捕获 入口;后台视觉证据须检查内容更新,后台耗时与前台输入到显示延迟分别报告。 +- 交互回调测量使用 `etaf-gui-verifier-measure-action`,按 scripts/README.md + 固定场景、计时边界与前后台条件;保留全部样本,阶段记录按 observer runtime ID + 隔离,不能用可复用的 buffer 名隔离。该入口不证明 compositor 已呈现。 - 连续 resize 使用 `scripts/benchmark-ebox-resize.el` 的 `ebox-resize-benchmark-start`,适用于现有 ETAF 或独立 Ebox buffer。 按 README 选择范围、轮数和新证据文件;先验证前台与已加载版本,保留全部样本, diff --git a/README.md b/README.md index a32e73d..b258cde 100644 --- a/README.md +++ b/README.md @@ -116,6 +116,13 @@ computes operation p50/p95/max statistics on demand, while `etaf-performance-operation-stage-summary` groups one operation's flat stages by provider category. `etaf-performance-records` returns defensive operation and stage snapshots; caller mutation cannot rewrite retained history. +Pass a numeric observer runtime ID to `etaf-performance-records` to select one +mount's history even when a buffer name is reused. Summary and report functions +use all retained records when called without an argument; an explicit `nil` +means an empty selection. The exported environment describes report generation, +not each historical operation. These synchronous operation durations do not +measure physical input-to-presentation latency; use the GUI measurement entry +in [scripts/README.md](scripts/README.md) for per-action condition checks. Use `etaf-performance-call-operation` or `etaf-performance-with-operation` to trace an arbitrary operation that has no diff --git a/README.zh-CN.md b/README.zh-CN.md index f9339b9..1be5b07 100644 --- a/README.zh-CN.md +++ b/README.zh-CN.md @@ -108,6 +108,11 @@ p50/p95/max、每次 operation、GC 增量和有序 provider 阶段;面板 hea `etaf-performance-operation-stage-summary` 则按 provider category 汇总单次 operation 的 flat 阶段。`etaf-performance-records` 返回 operation/stage 的防御性 快照,调用方修改返回值不会改写已保留的历史。 +向 `etaf-performance-records` 传入 observer 报告中的数字 runtime ID,可以隔离 +同名 buffer 重建前后的记录。summary/report 函数省略参数时读取全部历史, +显式传入 `nil` 时保持空结果。导出的环境是生成报告时的状态,不是每次历史操作 +的状态;同步 operation 耗时也不等于物理输入到画面呈现的延迟。逐次 GUI 条件 +检查使用 [scripts/README.md](scripts/README.md) 中的测量入口。 没有内置公共边界的任意操作,可以使用 `etaf-performance-call-operation` 或 `etaf-performance-with-operation` diff --git a/docs/user-guide.en.md b/docs/user-guide.en.md index 90a705c..f9169f4 100644 --- a/docs/user-guide.en.md +++ b/docs/user-guide.en.md @@ -765,6 +765,14 @@ requested. `etaf-performance-operation-stage-summary` groups the flat stages of one recorded operation by provider category. `etaf-performance-records` returns defensive operation and stage snapshots; caller mutation cannot alter retained history. +Its optional numeric runtime ID selects the identity from observer reports, +including history from a retired mount whose buffer name has since been reused. +Summary and report functions read all retained records when their argument is +omitted; explicit `nil` keeps an empty selection empty. The report's environment +is observed at export time, not at every recorded operation. Runtime durations +end at synchronous return and do not certify input-to-presentation latency; +use [the GUI action measurement entry](../scripts/README.md#measuring-an-existing-gui-action) +to record per-action foreground/target conditions and callback wall/CPU/GC time. Use `etaf-performance-call-operation` or `etaf-performance-with-operation` for application work that does not enter through a built-in public boundary. Both diff --git a/docs/user-guide.zh.md b/docs/user-guide.zh.md index 4d0d121..af8061e 100644 --- a/docs/user-guide.zh.md +++ b/docs/user-guide.zh.md @@ -733,6 +733,11 @@ Ebox、TP、Data、Resource 与 SQLite 可以贡献按 sequence 排列的 flat p `etaf-performance-operation-stage-summary` 会按 provider category 汇总某条记录 中的 flat 阶段。`etaf-performance-records` 返回 operation/stage 的防御性快照, 调用方修改返回值不会影响保留的历史。 +该函数可选的数字 runtime ID 来自 observer 报告,可隔离 buffer 同名重建前后的 +记录。summary/report 函数省略参数时读取全部历史,显式传入 `nil` 时保持空结果。 +报告中的环境是导出时观测的状态,不是每次历史操作的状态。Runtime 耗时截至 +同步调用返回,不能证明输入到画面呈现的延迟;逐次前后台、目标与回调 wall/CPU/GC +检查使用[GUI action 测量入口](../scripts/README.md#measuring-an-existing-gui-action)。 没有经过内置公共边界的应用操作可以使用 `etaf-performance-call-operation`/`etaf-performance-with-operation`;它们直接委托 diff --git a/etaf-performance.el b/etaf-performance.el index c29e284..75a063b 100644 --- a/etaf-performance.el +++ b/etaf-performance.el @@ -112,12 +112,24 @@ :stages (mapcar #'etaf-performance--copy-stage (etaf-performance-operation-stages operation)))) -(defun etaf-performance-records () - "Return newest-first immutable snapshots of completed records." - (if etaf-performance--record-ring - (mapcar #'etaf-performance--copy-operation - (ring-elements etaf-performance--record-ring)) - nil)) +(defun etaf-performance-records (&optional runtime-id) + "Return newest-first immutable snapshots of completed records. +When RUNTIME-ID is non-nil, select only that integer observer report identity, +as exposed by `etaf-performance-operation-runtime-id'. This also selects +historical records after unmount or reuse of a buffer name. Omitted or nil +RUNTIME-ID selects all retained records." + (unless (or (null runtime-id) (integerp runtime-id)) + (signal 'wrong-type-argument (list 'integerp runtime-id))) + (let ((records (and etaf-performance--record-ring + (ring-elements etaf-performance--record-ring)))) + (mapcar #'etaf-performance--copy-operation + (if runtime-id + (seq-filter + (lambda (operation) + (equal runtime-id + (etaf-performance-operation-runtime-id operation))) + records) + records)))) (defun etaf-performance--percentile (samples percentile) "Return nearest-rank PERCENTILE from numeric SAMPLES." @@ -180,10 +192,12 @@ durations may overlap and are therefore never presented as exclusive time." (> (plist-get left :duration-ms) (plist-get right :duration-ms)))))) -(defun etaf-performance-summary (&optional records) - "Summarize completed RECORDS by operation kind and label." +(cl-defun etaf-performance-summary + (&optional (records (etaf-performance-records))) + "Summarize completed RECORDS by operation kind and label. +Omitted RECORDS selects all retained records; explicit nil selects none." (let ((groups (make-hash-table :test #'equal)) result) - (dolist (operation (or records (etaf-performance-records))) + (dolist (operation records) (let ((key (cons (etaf-performance-operation-kind operation) (etaf-performance-operation-label operation)))) (puthash key @@ -469,20 +483,23 @@ BATTERY-OUTPUT identifies the active source; CUSTOM-OUTPUT contains settings." :power-state (etaf-performance--power-state))) ;;;###autoload -(defun etaf-performance-report-data (&optional records) - "Return a portable report for completed performance RECORDS." - (let ((records (or records (etaf-performance-records)))) - (list :format-version etaf-performance-report-format-version - :generated-at (format-time-string "%Y-%m-%dT%H:%M:%S%z") - :environment (etaf-performance-environment-data) - :summary (etaf-performance-summary records) - :operations - (mapcar #'etaf-performance--operation-report-data - (reverse (copy-sequence records)))))) +(cl-defun etaf-performance-report-data + (&optional (records (etaf-performance-records))) + "Return a portable report for completed performance RECORDS. +Omitted RECORDS selects all retained records; explicit nil selects none." + (list :format-version etaf-performance-report-format-version + :generated-at (format-time-string "%Y-%m-%dT%H:%M:%S%z") + :environment (etaf-performance-environment-data) + :summary (etaf-performance-summary records) + :operations + (mapcar #'etaf-performance--operation-report-data + (reverse (copy-sequence records))))) ;;;###autoload -(defun etaf-performance-report-string (&optional records) - "Return completed performance RECORDS as a readable report string." +(cl-defun etaf-performance-report-string + (&optional (records (etaf-performance-records))) + "Return completed performance RECORDS as a readable report string. +Omitted RECORDS selects all retained records; explicit nil selects none." (concat ";; ETAF performance report\n" (pp-to-string (etaf-performance-report-data records)))) diff --git a/scripts/README.md b/scripts/README.md index 65db0fd..a2d8984 100644 --- a/scripts/README.md +++ b/scripts/README.md @@ -13,7 +13,8 @@ scenarios live in their respective example repositories: - `emacs-gui-verifier.el` defines `Scenario`, ordered `Action`, run-local `Context`, checkpoint sequencing, assertions, completion, and fail-closed - evidence finalization. + evidence finalization. Its `etaf-gui-verifier-measure-action` entry records + callback wall/CPU/GC time and GUI conditions without taking application focus. - `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. @@ -68,6 +69,44 @@ Lisp callbacks and runtime timing do not require application activation; report them as background measurements, separately from foreground input-to-display latency. Use Emacs-local operations while another app is active, not global input. +## Measuring an existing GUI action + +Reuse `etaf-gui-verifier-measure-action` with the adapter's Context and Action: + +```elisp +;; Prepare the target control and fixture before entering the measured callback. +(etaf-gui-verifier-measure-action context action t) +(car (etaf-gui-verifier-context-measurements context)) +``` + +The final `t` requires an already selected foreground target. It rejects a +background, hidden, unknown or wrong target before running the action, and +invalidates a sample if focus, target, font or geometry changes. It never raises +Emacs. Omit that argument for background functional work; those samples are +explicitly labeled and must not be reported as foreground latency. + +Timing covers exactly `Action.execute`, excluding target inspection, +checkpoints and the verifier's intentional settle waits. Keep fixture setup, +control lookup and focus navigation outside an activation measurement. If the +chosen boundary includes an explicit `redisplay`, put that call in `execute` +and describe the boundary accordingly. Returning from redisplay still does not +prove compositor presentation. Each record says `presentation_measured=nil`. + +Context retains every measurement, including first use, warmups, failures and +rejections. Failed callbacks retain their own timing and original condition; +rejections have no duration. Checkpoints export only the most recent record. +Report the full sample count and all-sample maximum as well as any explicitly +labeled steady-state statistics. Compare identical payload/page size, viewport, +loaded code, recording mode and foreground class; do not discard a slow group +because another run is faster. The historical `.omx/component-api-implementation/ +current-workbench-sample.el` probe is superseded by this measurement boundary. + +For provider traces, scope `etaf-performance-records` by its numeric observer +runtime ID, not buffer name, which can be reused after unmount. Pass the selected +records explicitly to summary/export functions: an empty selection stays empty. +Check operation IDs/counts as well as runtime ID when sampling the same mounted +instance again; the recorder's bounded history is not a per-run sample store. + ## Continuous resize on the existing server Use this entry for resize performance investigations instead of copying the diff --git a/scripts/emacs-gui-verifier.el b/scripts/emacs-gui-verifier.el index be58182..254cb46 100644 --- a/scripts/emacs-gui-verifier.el +++ b/scripts/emacs-gui-verifier.el @@ -34,7 +34,8 @@ (cl-defstruct (etaf-gui-verifier-context (:constructor etaf-gui-verifier--context-create)) "Mutable execution state owned only by one verifier run." - scenario target-buffer data (action-count 0) (last-duration-ms 0.0)) + scenario target-buffer data (action-count 0) (last-duration-ms 0.0) + measurements) (defun etaf-gui-verifier-context-put (context key value) "Store adapter VALUE for KEY in CONTEXT and return VALUE." @@ -45,6 +46,138 @@ "Return CONTEXT adapter value KEY, or DEFAULT when absent." (alist-get key (etaf-gui-verifier-context-data context) default)) +(defun etaf-gui-verifier--measurement-state (context) + "Return CONTEXT's live identities followed by JSON-safe GUI facts." + (let* ((frame (selected-frame)) + (window (selected-window)) + (target (etaf-gui-verifier-context-target-buffer context)) + (selected-buffer (window-buffer window)) + (focus (frame-focus-state frame))) + (cons + (list frame window target selected-buffer) + `((graphic . ,(and (display-graphic-p frame) t)) + (focus . ,(cond ((eq focus t) "foreground") + ((null focus) "background") + (t "unknown"))) + (frame_name . ,(frame-parameter frame 'name)) + (frame_window_id . ,(frame-parameter frame 'window-id)) + (frame_visible . ,(pcase (frame-visible-p frame) + ('t "visible") ('icon "icon") (_ "hidden"))) + (target_buffer . ,(and (buffer-live-p target) (buffer-name target))) + (selected_buffer . ,(buffer-name selected-buffer)) + (target_selected . ,(and (buffer-live-p target) + (eq target selected-buffer))) + (font . ,(format "%s" (frame-parameter frame 'font))) + (frame_width_px . ,(frame-pixel-width frame)) + (frame_height_px . ,(frame-pixel-height frame)) + (window_edges_px . ,(vconcat (window-pixel-edges window))) + (inhibit_quit . ,(and inhibit-quit t)) + (inhibit_redisplay . ,(and inhibit-redisplay t)) + (noninteractive . ,(and noninteractive t)))))) + +(defun etaf-gui-verifier-measure-action (context action &optional require-foreground) + "Measure ACTION's execute callback once with CONTEXT; return its exact result. +Retain a JSON-safe measurement in CONTEXT's measurements, newest first, +including failed or quit callbacks, and update the legacy last duration. +Wall/CPU/GC timing covers only the callback, excluding GUI-state snapshots and +the verifier's later checkpoints, redisplay, and settling. Calls made inside +the callback are included. No focus or execution bindings change. + +With REQUIRE-FOREGROUND, reject a non-graphical, unfocused, unknown, hidden, +or unselected target before invoking the callback. Rejection retains an +untimed record and clears the legacy duration. Changes to frame/window/buffer +identities, graphical display, focus, visibility, native window ID, target +selection, font, frame pixel size, or window pixel edges invalidate the record +and, when foreground is required, signal after a successful callback. Frame +and buffer names and execution bindings are diagnostic observations, not +identity guards. Callback errors and quits propagate with their original data. +A closing snapshot quit is recorded and propagated after a successful callback, +but never replaces an existing callback error or quit. + +Background callbacks are allowed by default and labeled accordingly. A +valid record requires a successful callback with a live selected target in +an unchanged environment; even a foreground record does not certify +input-to-presentation latency." + (let* ((before (etaf-gui-verifier--measurement-state context)) + (facts (cdr before)) + (foreground (if (alist-get 'graphic facts) + (alist-get 'focus facts) + "unknown")) + (status "rejected") + started cpu-start gc-start gcs-start result changed snapshot-quit) + (unwind-protect + (progn + (when (and require-foreground + (not (and (equal foreground "foreground") + (equal (alist-get 'frame_visible facts) "visible") + (alist-get 'target_selected facts)))) + (error "GUI action requires a selected foreground target: %s" + (etaf-gui-verifier-action-id action))) + (setq cpu-start (current-cpu-time) + gc-start gc-elapsed + gcs-start gcs-done + started (float-time)) + (condition-case condition + (progn + (setq result + (funcall (etaf-gui-verifier-action-execute action) context) + status "success")) + ((error quit) + (setq status (if (eq (car condition) 'quit) "quit" "error")) + (signal (car condition) (cdr condition))))) + (let* ((finished (and started (float-time))) + (cpu-end (and started (current-cpu-time))) + (gc-end gc-elapsed) + (gcs-end gcs-done) + (wall-ms (and started (* 1000.0 (- finished started)))) + ;; Snapshot failure must not replace an action's error or quit. + (after (and started + (condition-case condition + (etaf-gui-verifier--measurement-state context) + (quit (setq snapshot-quit condition) nil) + (error nil))))) + (setq changed + (and started + (or (not (equal (car before) (car after))) + (cl-some + (lambda (key) + (not (equal (alist-get key facts) + (alist-get key (cdr after))))) + '(graphic focus frame_visible frame_window_id + target_selected font frame_width_px frame_height_px + window_edges_px))))) + (when (and snapshot-quit (equal status "success")) + (setq status "quit")) + (when (and changed require-foreground (equal status "success")) + (setq status "invalid")) + (setf (etaf-gui-verifier-context-last-duration-ms context) wall-ms) + (push + `((action_id . ,(etaf-gui-verifier-action-id action)) + (boundary . "action.execute callback") + (presentation_measured . nil) + (status . ,status) + (valid . ,(and (equal status "success") (not changed) + (alist-get 'target_selected facts))) + (foreground . ,(if changed "changed" foreground)) + (foreground_required . ,(and require-foreground t)) + (wall_ms . ,wall-ms) + (cpu_ms . ,(and cpu-end + (* 1000.0 + (- (/ (float (car cpu-end)) (cdr cpu-end)) + (/ (float (car cpu-start)) (cdr cpu-start)))))) + (gc_count . ,(and started (- gcs-end gcs-start))) + (gc_ms . ,(and started (* 1000.0 (- gc-end gc-start)))) + (before . ,facts) + (after . ,(cdr after))) + (etaf-gui-verifier-context-measurements context)))) + ;; An action's nonlocal failure bypasses this point and keeps precedence. + (when snapshot-quit + (signal (car snapshot-quit) (cdr snapshot-quit))) + (when (equal status "invalid") + (error "GUI action environment changed during callback: %s" + (etaf-gui-verifier-action-id action))) + result)) + (defun etaf-gui-verifier-context-select-buffer (context buffer) "Select live BUFFER as CONTEXT's single-window target." (unless (buffer-live-p buffer) @@ -86,7 +219,9 @@ (cons 'action_count (etaf-gui-verifier-context-action-count context)) (cons 'duration_ms - (etaf-gui-verifier-context-last-duration-ms context))) + (etaf-gui-verifier-context-last-duration-ms context)) + (cons 'last_measurement + (car (etaf-gui-verifier-context-measurements context)))) (and function (funcall function context))))) (defun etaf-gui-verifier--checkpoint @@ -140,10 +275,7 @@ (assertions (etaf-gui-verifier-action-assertions action))) (etaf-gui-verifier--checkpoint context action-id "before-action" nil) - (let ((started (float-time))) - (funcall (etaf-gui-verifier-action-execute action) context) - (setf (etaf-gui-verifier-context-last-duration-ms context) - (* 1000.0 (- (float-time) started)))) + (etaf-gui-verifier-measure-action context action) (cl-incf (etaf-gui-verifier-context-action-count context)) (etaf-gui-verifier--checkpoint context action-id "after-action" nil) diff --git a/tests/etaf-gui-verifier-tests.el b/tests/etaf-gui-verifier-tests.el index e2bb7a9..68d6060 100644 --- a/tests/etaf-gui-verifier-tests.el +++ b/tests/etaf-gui-verifier-tests.el @@ -4,8 +4,416 @@ (require 'ert) (require 'cl-lib) +(require 'json) (require 'emacs-gui-verifier) +(ert-deftest etaf-gui-verifier-measures-success-and-original-failure () + "Each callback retains its own timing, result, and error condition." + (let* ((scenario (etaf-gui-verifier-scenario-create :name "measurement")) + (context (etaf-gui-verifier--context-create :scenario scenario)) + (result (list 'exact-result)) + (error-data (list "original failure" result)) + (wall-times '(1.0 1.002 10.0 10.03)) + (cpu-times '((1000 . 1000) (1004 . 1000) + (2000 . 1000) (2010 . 1000))) + (gcs-done 5) (gc-elapsed 0.1) + (calls 0)) + (cl-letf (((symbol-function 'float-time) + (lambda (&optional _time) (pop wall-times))) + ((symbol-function 'current-cpu-time) + (lambda () (pop cpu-times)))) + (should + (eq result + (etaf-gui-verifier-measure-action + context + (etaf-gui-verifier-action-create + :id "success" + :execute (lambda (current) + (should (eq current context)) + (cl-incf calls) + result))))) + (should + (equal (cons 'error error-data) + (should-error + (etaf-gui-verifier-measure-action + context + (etaf-gui-verifier-action-create + :id "failure" + :execute (lambda (_current) + (cl-incf calls) + (cl-incf gcs-done 2) + (cl-incf gc-elapsed 0.003) + (signal 'error error-data)))))))) + (should (= calls 2)) + (let* ((measurements (etaf-gui-verifier-context-measurements context)) + (failed (car measurements)) + (succeeded (cadr measurements)) + (adapter (etaf-gui-verifier--adapter-data context))) + (should (= (length measurements) 2)) + (should (equal (alist-get 'status succeeded) "success")) + (should (equal (alist-get 'status failed) "error")) + (should (equal (alist-get 'action_id failed) "failure")) + (should-not (alist-get 'valid failed)) + (should (< (abs (- (alist-get 'wall_ms failed) 30.0)) 0.001)) + (should (< (abs (- (alist-get 'wall_ms succeeded) 2.0)) 0.001)) + (should (< (abs (- (alist-get 'cpu_ms failed) 10.0)) 0.001)) + (should (= (alist-get 'gc_count failed) 2)) + (should (< (abs (- (alist-get 'gc_ms failed) 3.0)) 0.001)) + (should (= (alist-get 'duration_ms adapter) + (alist-get 'wall_ms failed))) + (should (eq (alist-get 'last_measurement adapter) failed)) + (should-not (assq 'measurements adapter))))) + +(ert-deftest etaf-gui-verifier-labels-callback-context-without-changing-it () + "Foreground, background, and unknown callbacks keep their execution context." + (let* ((focus t) (calls 0) + (inhibit-quit t) (inhibit-redisplay t) + (threshold gc-cons-threshold) (percentage gc-cons-percentage) + (context + (etaf-gui-verifier--context-create + :target-buffer (window-buffer (selected-window))))) + (cl-letf (((symbol-function 'display-graphic-p) + (lambda (&optional _frame) t)) + ((symbol-function 'frame-focus-state) + (lambda (&optional _frame) focus)) + ((symbol-function 'redisplay) + (lambda (&rest _arguments) (ert-fail "Forced redisplay"))) + ((symbol-function 'sit-for) + (lambda (&rest _arguments) (ert-fail "Waited for display"))) + ((symbol-function 'garbage-collect) + (lambda () (ert-fail "Forced GC")))) + (dolist (state '((t "foreground") (nil "background") (unknown "unknown"))) + (setq focus (car state)) + (should + (eq 'exact-result + (etaf-gui-verifier-measure-action + context + (etaf-gui-verifier-action-create + :id "context" + :execute (lambda (_context) + (cl-incf calls) + (should inhibit-quit) + (should inhibit-redisplay) + (should (= gc-cons-threshold threshold)) + (should (= gc-cons-percentage percentage)) + 'exact-result)) + (eq focus t)))) + (let* ((measurement + (car (etaf-gui-verifier-context-measurements context))) + (before (alist-get 'before measurement))) + (should (equal (alist-get 'foreground measurement) (cadr state))) + (should (equal (alist-get 'status measurement) "success")) + (should (alist-get 'valid measurement)) + (should (alist-get 'inhibit_quit before)) + (should (alist-get 'inhibit_redisplay before)) + (should (eq (alist-get 'noninteractive before) noninteractive)) + (should (stringp (json-serialize measurement)))))) + (should (= calls 3)))) + +(ert-deftest etaf-gui-verifier-unselected-target-runs-with-invalid-timing () + "An unchanged unselected target permits the callback but invalidates timing." + (let* ((target (generate-new-buffer " *etaf-gui-unselected-target*")) + (context (etaf-gui-verifier--context-create :target-buffer target)) + (result (list 'exact-result)) + (calls 0)) + (unwind-protect + (cl-letf (((symbol-function 'display-graphic-p) + (lambda (&optional _frame) t)) + ((symbol-function 'frame-focus-state) + (lambda (&optional _frame) nil))) + (should + (eq result + (etaf-gui-verifier-measure-action + context + (etaf-gui-verifier-action-create + :id "unselected-target" + :execute (lambda (_context) + (cl-incf calls) + result))))) + (should (= calls 1)) + (let ((measurement + (car (etaf-gui-verifier-context-measurements context)))) + (should (equal (alist-get 'status measurement) "success")) + (should (equal (alist-get 'foreground measurement) "background")) + (should (equal (alist-get 'before measurement) + (alist-get 'after measurement))) + (should-not (alist-get 'target_selected + (alist-get 'before measurement))) + (should-not (alist-get 'valid measurement)) + (should (numberp (alist-get 'wall_ms measurement))))) + (kill-buffer target)))) + +(ert-deftest etaf-gui-verifier-foreground-rejection-does-not-execute-or-focus () + "Foreground requirements reject absent focus or targets before execution." + (let ((focus t) (graphic t) (calls 0) + (context (etaf-gui-verifier--context-create))) + (cl-letf (((symbol-function 'display-graphic-p) + (lambda (&optional _frame) graphic)) + ((symbol-function 'frame-focus-state) + (lambda (&optional _frame) focus)) + ((symbol-function 'raise-frame) + (lambda (&rest _arguments) (ert-fail "Raised frame"))) + ((symbol-function 'select-frame-set-input-focus) + (lambda (&rest _arguments) (ert-fail "Changed focus"))) + ((symbol-function 'x-focus-frame) + (lambda (&rest _arguments) (ert-fail "Focused frame")))) + (dolist (state '((nil t t) (unknown t t) (t nil t) (t t nil))) + (setq focus (nth 0 state) graphic (nth 1 state)) + (setf (etaf-gui-verifier-context-target-buffer context) + (and (nth 2 state) (window-buffer (selected-window)))) + (should-error + (etaf-gui-verifier-measure-action + context + (etaf-gui-verifier-action-create + :id "foreground-only" :execute (lambda (_context) (cl-incf calls))) + t)) + (let ((measurement + (car (etaf-gui-verifier-context-measurements context)))) + (should (equal (alist-get 'status measurement) "rejected")) + (should-not (alist-get 'valid measurement)) + (should-not (alist-get 'wall_ms measurement))))) + (should (zerop calls)))) + +(ert-deftest etaf-gui-verifier-retains-valid-timing-when-frame-title-changes () + "A GC count in the frame title must not invalidate a stable target." + (let* ((gcs-done 713) + (calls 0) + (result (list 'exact-result)) + (frame-parameter-function (symbol-function 'frame-parameter)) + (context + (etaf-gui-verifier--context-create + :target-buffer (window-buffer (selected-window))))) + (cl-letf (((symbol-function 'display-graphic-p) + (lambda (&optional _frame) t)) + ((symbol-function 'frame-focus-state) + (lambda (&optional _frame) t)) + ((symbol-function 'frame-parameter) + (lambda (frame parameter) + (if (eq parameter 'name) (format "GC%d" gcs-done) + (funcall frame-parameter-function frame parameter))))) + (should + (eq result + (etaf-gui-verifier-measure-action + context + (etaf-gui-verifier-action-create + :id "title-update" + :execute (lambda (_context) + (cl-incf calls) + (cl-incf gcs-done) + result)) + t)))) + (should (= calls 1)) + (let ((measurement + (car (etaf-gui-verifier-context-measurements context)))) + (should (equal (alist-get 'status measurement) "success")) + (should (equal (alist-get 'foreground measurement) "foreground")) + (should (alist-get 'valid measurement)) + (should (= (alist-get 'gc_count measurement) 1)) + (should (equal (alist-get 'frame_name (alist-get 'before measurement)) + "GC713")) + (should (equal (alist-get 'frame_name (alist-get 'after measurement)) + "GC714"))))) + +(ert-deftest etaf-gui-verifier-invalidates-replaced-selected-target () + "A different live selected buffer remains an identity change." + (let ((target (generate-new-buffer " *etaf-gui-original-target*")) + (replacement (generate-new-buffer " *etaf-gui-replacement-target*")) + (calls 0)) + (unwind-protect + (save-window-excursion + (switch-to-buffer target) + (let ((context (etaf-gui-verifier--context-create :target-buffer target))) + (cl-letf (((symbol-function 'display-graphic-p) + (lambda (&optional _frame) t)) + ((symbol-function 'frame-focus-state) + (lambda (&optional _frame) t))) + (should-error + (etaf-gui-verifier-measure-action + context + (etaf-gui-verifier-action-create + :id "replace-selected-target" + :execute (lambda (_context) + (cl-incf calls) + (setf (etaf-gui-verifier-context-target-buffer context) + replacement) + (set-window-buffer (selected-window) replacement))) + t))) + (should (= calls 1)) + (let ((measurement + (car (etaf-gui-verifier-context-measurements context)))) + (should (alist-get 'target_selected + (alist-get 'before measurement))) + (should (alist-get 'target_selected + (alist-get 'after measurement))) + (should (equal (alist-get 'status measurement) "invalid")) + (should-not (alist-get 'valid measurement))))) + (kill-buffer target) + (kill-buffer replacement)))) + +(ert-deftest etaf-gui-verifier-invalidates-changed-foreground-environment () + "Changed focus, target, font, or dimensions invalidate strict timing." + (let ((focus t) (width 800) (font "original-font") (calls 0) + (frame-parameter-function (symbol-function 'frame-parameter)) + (context (etaf-gui-verifier--context-create))) + (cl-letf (((symbol-function 'display-graphic-p) + (lambda (&optional _frame) t)) + ((symbol-function 'frame-focus-state) + (lambda (&optional _frame) focus)) + ((symbol-function 'frame-pixel-width) + (lambda (&optional _frame) width)) + ((symbol-function 'frame-parameter) + (lambda (frame parameter) + (if (eq parameter 'font) font + (funcall frame-parameter-function frame parameter))))) + (dolist (change '(focus target font dimensions)) + (setq focus t width 800 font "original-font") + (setf (etaf-gui-verifier-context-target-buffer context) + (window-buffer (selected-window))) + (should-error + (etaf-gui-verifier-measure-action + context + (etaf-gui-verifier-action-create + :id (symbol-name change) + :execute + (lambda (_context) + (cl-incf calls) + (pcase change + ('focus (setq focus nil)) + ('target + (setf (etaf-gui-verifier-context-target-buffer context) nil)) + ('font (setq font "changed-font")) + ('dimensions (setq width 900))))) + t)) + (let ((measurement + (car (etaf-gui-verifier-context-measurements context)))) + (should (equal (alist-get 'status measurement) "invalid")) + (should (equal (alist-get 'foreground measurement) "changed")) + (should-not (alist-get 'valid measurement)) + (should (numberp (alist-get 'wall_ms measurement)))))) + (should (= calls 4)))) + +(ert-deftest etaf-gui-verifier-preserves-quit-despite-focus-change () + "A quit keeps its exact data even if strict environment checks also fail." + (let* ((focus t) + (quit-data (list 'original-quit)) + (context + (etaf-gui-verifier--context-create + :target-buffer (window-buffer (selected-window))))) + (cl-letf (((symbol-function 'display-graphic-p) + (lambda (&optional _frame) t)) + ((symbol-function 'frame-focus-state) + (lambda (&optional _frame) focus))) + (should + (equal (cons 'quit quit-data) + (condition-case condition + (etaf-gui-verifier-measure-action + context + (etaf-gui-verifier-action-create + :id "quit" + :execute (lambda (_context) + (setq focus nil) + (signal 'quit quit-data))) + t) + (quit condition))))) + (let ((measurement + (car (etaf-gui-verifier-context-measurements context)))) + (should (equal (alist-get 'status measurement) "quit")) + (should (equal (alist-get 'foreground measurement) "changed")) + (should-not (alist-get 'valid measurement)) + (should (numberp (alist-get 'wall_ms measurement)))))) + +(ert-deftest etaf-gui-verifier-retains-timing-despite-closing-snapshot-failure () + "Snapshot errors and quits preserve action failures and retain fresh timing." + (dolist (action-outcome '(error quit success)) + (dolist (snapshot-outcome '(error quit)) + (let* ((context + (etaf-gui-verifier--context-create + :target-buffer (window-buffer (selected-window)) + :last-duration-ms 999.0)) + (before (etaf-gui-verifier--measurement-state context)) + (result (list 'exact-result)) + (action-data (list "original-action-failure" result)) + (snapshot-data (list "snapshot-interrupted" result)) + (wall-times '(1.0 1.025)) + (calls 0) (snapshots 0) observed-condition returned) + (cl-letf (((symbol-function 'float-time) + (lambda (&optional _time) (pop wall-times))) + ((symbol-function 'etaf-gui-verifier--measurement-state) + (lambda (_context) + (if (= (cl-incf snapshots) 1) before + (signal snapshot-outcome snapshot-data))))) + (setq returned + (condition-case condition + (etaf-gui-verifier-measure-action + context + (etaf-gui-verifier-action-create + :id "snapshot-failure" + :execute (lambda (_context) + (cl-incf calls) + (if (eq action-outcome 'success) result + (signal action-outcome action-data))))) + ((error quit) + (setq observed-condition condition) + nil)))) + (should (= calls 1)) + (should (= snapshots 2)) + (cond + ((not (eq action-outcome 'success)) + (should (eq (car observed-condition) action-outcome)) + (should (eq (cdr observed-condition) action-data))) + ((eq snapshot-outcome 'quit) + (should (eq (car observed-condition) 'quit)) + (should (eq (cdr observed-condition) snapshot-data))) + (t + (should-not observed-condition) + (should (eq returned result)))) + (let* ((measurements (etaf-gui-verifier-context-measurements context)) + (measurement (car measurements))) + (should (= (length measurements) 1)) + (should-not (alist-get 'valid measurement)) + (should-not (alist-get 'after measurement)) + (should + (equal (alist-get 'status measurement) + (symbol-name + (if (and (eq action-outcome 'success) + (eq snapshot-outcome 'quit)) + 'quit action-outcome)))) + (should (< (abs (- (alist-get 'wall_ms measurement) 25.0)) 0.001)) + (should (= (etaf-gui-verifier-context-last-duration-ms context) + (alist-get 'wall_ms measurement)))))))) + +(ert-deftest etaf-gui-verifier-measures-callback-without-settle-or-checkpoints () + "The action callback is timed separately from checkpoints and settling." + (let ((context (etaf-gui-verifier--context-create)) + (clock 0.0) events) + (cl-letf (((symbol-function 'float-time) + (lambda (&optional _time) clock)) + ((symbol-function 'etaf-gui-verifier--checkpoint) + (lambda (_context _id phase _screenshot &optional _extra) + (cl-incf clock 1.0) + (push phase events))) + ((symbol-function 'etaf-gui-verifier--settle-action) + (lambda (_context _action) + (cl-incf clock 2.0) + (push 'settle events)))) + (etaf-gui-verifier--run-action + context + (etaf-gui-verifier-action-create + :id "callback-only" + :execute (lambda (_context) + (cl-incf clock 0.025) + (push 'execute events))))) + (should (< (abs (- (etaf-gui-verifier-context-last-duration-ms context) + 25.0)) + 0.001)) + (should (equal (nreverse events) + '("before-action" execute "after-action" + settle "after-redisplay"))) + (let ((measurement + (car (etaf-gui-verifier-context-measurements context)))) + (should (equal (alist-get 'boundary measurement) "action.execute callback")) + (should-not (alist-get 'presentation_measured measurement))))) + (ert-deftest etaf-gui-verifier-runs-and-settles-without-raising-frame () "Actions and settled checkpoints must complete without raising Emacs." (let ((context (etaf-gui-verifier--context-create)) diff --git a/tests/etaf-performance-tests.el b/tests/etaf-performance-tests.el index 29bcd03..bfd6731 100644 --- a/tests/etaf-performance-tests.el +++ b/tests/etaf-performance-tests.el @@ -236,6 +236,89 @@ (plist-get (etaf-performance-stage-metadata stage) :detail))))))) +(ert-deftest etaf-performance-records-filter-by-runtime-report-identity () + "Select isolated history by report identity when buffer names are reused." + (etaf-performance-test--isolated + (dolist (entry '((1 101 "first mount") + (1 202 "second mount") + (2 101 "first unmount"))) + (etaf-performance--retain + (etaf-performance--operation-create + :id (nth 0 entry) :runtime-id (nth 1 entry) :label (nth 2 entry) + :buffer-name " *reused performance buffer*" + :metadata '(:detail ("stable"))))) + (should (= 3 (length (etaf-performance-records)))) + (should (equal (etaf-performance-records) + (etaf-performance-records nil))) + (let ((first (etaf-performance-records 101)) + (second (etaf-performance-records 202))) + (should (equal '("first unmount" "first mount") + (mapcar #'etaf-performance-operation-label first))) + (should (equal '("second mount") + (mapcar #'etaf-performance-operation-label second))) + (setf (etaf-performance-operation-label (car first)) "changed") + (setcar (plist-get (etaf-performance-operation-metadata (car first)) + :detail) + "changed") + (let ((retained (car (etaf-performance-records 101)))) + (should (equal "first unmount" + (etaf-performance-operation-label retained))) + (should (equal '("stable") + (plist-get (etaf-performance-operation-metadata retained) + :detail))))) + (should-not (etaf-performance-records 303)) + (should-error (etaf-performance-records "101") + :type 'wrong-type-argument))) + +(ert-deftest etaf-performance-summary-keeps-explicit-empty-selection () + "An omitted selection summarizes all records; an explicit nil stays empty." + (etaf-performance-test--isolated + (etaf-performance--retain + (etaf-performance--operation-create + :kind 'report :label "retained fixture" :elapsed 1.0)) + (should (= 1 (length (etaf-performance-summary)))) + (should-not (etaf-performance-summary nil)))) + +(ert-deftest etaf-performance-report-data-keeps-explicit-empty-selection () + "An empty data export cannot fall back to previously retained records." + (etaf-performance-test--isolated + (etaf-performance--retain + (etaf-performance--operation-create + :kind 'report :label "retained fixture" :elapsed 1.0)) + (let ((all (etaf-performance-report-data)) + (empty (etaf-performance-report-data nil))) + (should (= 1 (length (plist-get all :summary)))) + (should (= 1 (length (plist-get all :operations)))) + (should-not (plist-get empty :summary)) + (should-not (plist-get empty :operations))))) + +(ert-deftest etaf-performance-report-string-keeps-explicit-empty-selection () + "Report strings preserve both omitted and explicitly empty selections." + (etaf-performance-test--isolated + (etaf-performance--retain + (etaf-performance--operation-create + :kind 'report :label "retained fixture" :elapsed 1.0)) + (let ((all (read (etaf-performance-report-string))) + (empty (read (etaf-performance-report-string nil)))) + (should (= 1 (length (plist-get all :summary)))) + (should (= 1 (length (plist-get all :operations)))) + (should-not (plist-get empty :summary)) + (should-not (plist-get empty :operations))))) + +(ert-deftest etaf-performance-reports-keep-empty-runtime-selection () + "An unmatched runtime report identity produces empty summary and exports." + (etaf-performance-test--isolated + (etaf-performance--retain + (etaf-performance--operation-create + :runtime-id 101 :kind 'report :label "retained fixture" :elapsed 1.0)) + (let ((records (etaf-performance-records 202))) + (should-not records) + (should-not (etaf-performance-summary records)) + (dolist (report (list (etaf-performance-report-data records) + (read (etaf-performance-report-string records)))) + (should-not (plist-get report :summary)) + (should-not (plist-get report :operations)))))) + (ert-deftest etaf-performance-summary-uses-flat-duration () "Summaries expose percentiles and overlapping provider durations honestly." (etaf-performance-test--isolated