fix: isolate performance records and qualify GUI callback measurements
This commit is contained in:
parent
b89cec0001
commit
0344735839
@ -10,6 +10,9 @@
|
|||||||
及既有 Makefile 入口;公共机制归 `scripts/`,具体业务场景归示例仓库。
|
及既有 Makefile 入口;公共机制归 `scripts/`,具体业务场景归示例仓库。
|
||||||
- 现有 Emacs 的截图与录像默认保留用户当前应用焦点,使用已登记的窗口捕获
|
- 现有 Emacs 的截图与录像默认保留用户当前应用焦点,使用已登记的窗口捕获
|
||||||
入口;后台视觉证据须检查内容更新,后台耗时与前台输入到显示延迟分别报告。
|
入口;后台视觉证据须检查内容更新,后台耗时与前台输入到显示延迟分别报告。
|
||||||
|
- 交互回调测量使用 `etaf-gui-verifier-measure-action`,按 scripts/README.md
|
||||||
|
固定场景、计时边界与前后台条件;保留全部样本,阶段记录按 observer runtime ID
|
||||||
|
隔离,不能用可复用的 buffer 名隔离。该入口不证明 compositor 已呈现。
|
||||||
- 连续 resize 使用 `scripts/benchmark-ebox-resize.el` 的
|
- 连续 resize 使用 `scripts/benchmark-ebox-resize.el` 的
|
||||||
`ebox-resize-benchmark-start`,适用于现有 ETAF 或独立 Ebox buffer。
|
`ebox-resize-benchmark-start`,适用于现有 ETAF 或独立 Ebox buffer。
|
||||||
按 README 选择范围、轮数和新证据文件;先验证前台与已加载版本,保留全部样本,
|
按 README 选择范围、轮数和新证据文件;先验证前台与已加载版本,保留全部样本,
|
||||||
|
|||||||
@ -116,6 +116,13 @@ computes operation p50/p95/max statistics on demand, while
|
|||||||
`etaf-performance-operation-stage-summary` groups one operation's flat stages
|
`etaf-performance-operation-stage-summary` groups one operation's flat stages
|
||||||
by provider category. `etaf-performance-records` returns defensive operation
|
by provider category. `etaf-performance-records` returns defensive operation
|
||||||
and stage snapshots; caller mutation cannot rewrite retained history.
|
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
|
Use `etaf-performance-call-operation` or
|
||||||
`etaf-performance-with-operation` to trace an arbitrary operation that has no
|
`etaf-performance-with-operation` to trace an arbitrary operation that has no
|
||||||
|
|||||||
@ -108,6 +108,11 @@ p50/p95/max、每次 operation、GC 增量和有序 provider 阶段;面板 hea
|
|||||||
`etaf-performance-operation-stage-summary` 则按 provider category 汇总单次
|
`etaf-performance-operation-stage-summary` 则按 provider category 汇总单次
|
||||||
operation 的 flat 阶段。`etaf-performance-records` 返回 operation/stage 的防御性
|
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`
|
`etaf-performance-call-operation` 或 `etaf-performance-with-operation`
|
||||||
|
|||||||
@ -765,6 +765,14 @@ requested. `etaf-performance-operation-stage-summary` groups the flat stages
|
|||||||
of one recorded operation by provider category. `etaf-performance-records`
|
of one recorded operation by provider category. `etaf-performance-records`
|
||||||
returns defensive operation and stage snapshots; caller mutation cannot alter
|
returns defensive operation and stage snapshots; caller mutation cannot alter
|
||||||
retained history.
|
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
|
Use `etaf-performance-call-operation` or `etaf-performance-with-operation` for
|
||||||
application work that does not enter through a built-in public boundary. Both
|
application work that does not enter through a built-in public boundary. Both
|
||||||
|
|||||||
@ -733,6 +733,11 @@ Ebox、TP、Data、Resource 与 SQLite 可以贡献按 sequence 排列的 flat p
|
|||||||
`etaf-performance-operation-stage-summary` 会按 provider category 汇总某条记录
|
`etaf-performance-operation-stage-summary` 会按 provider category 汇总某条记录
|
||||||
中的 flat 阶段。`etaf-performance-records` 返回 operation/stage 的防御性快照,
|
中的 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`;它们直接委托
|
`etaf-performance-call-operation`/`etaf-performance-with-operation`;它们直接委托
|
||||||
|
|||||||
@ -112,12 +112,24 @@
|
|||||||
:stages (mapcar #'etaf-performance--copy-stage
|
:stages (mapcar #'etaf-performance--copy-stage
|
||||||
(etaf-performance-operation-stages operation))))
|
(etaf-performance-operation-stages operation))))
|
||||||
|
|
||||||
(defun etaf-performance-records ()
|
(defun etaf-performance-records (&optional runtime-id)
|
||||||
"Return newest-first immutable snapshots of completed records."
|
"Return newest-first immutable snapshots of completed records.
|
||||||
(if etaf-performance--record-ring
|
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
|
(mapcar #'etaf-performance--copy-operation
|
||||||
(ring-elements etaf-performance--record-ring))
|
(if runtime-id
|
||||||
nil))
|
(seq-filter
|
||||||
|
(lambda (operation)
|
||||||
|
(equal runtime-id
|
||||||
|
(etaf-performance-operation-runtime-id operation)))
|
||||||
|
records)
|
||||||
|
records))))
|
||||||
|
|
||||||
(defun etaf-performance--percentile (samples percentile)
|
(defun etaf-performance--percentile (samples percentile)
|
||||||
"Return nearest-rank PERCENTILE from numeric SAMPLES."
|
"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 left :duration-ms)
|
||||||
(plist-get right :duration-ms))))))
|
(plist-get right :duration-ms))))))
|
||||||
|
|
||||||
(defun etaf-performance-summary (&optional records)
|
(cl-defun etaf-performance-summary
|
||||||
"Summarize completed RECORDS by operation kind and label."
|
(&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)
|
(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)
|
(let ((key (cons (etaf-performance-operation-kind operation)
|
||||||
(etaf-performance-operation-label operation))))
|
(etaf-performance-operation-label operation))))
|
||||||
(puthash key
|
(puthash key
|
||||||
@ -469,20 +483,23 @@ BATTERY-OUTPUT identifies the active source; CUSTOM-OUTPUT contains settings."
|
|||||||
:power-state (etaf-performance--power-state)))
|
:power-state (etaf-performance--power-state)))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun etaf-performance-report-data (&optional records)
|
(cl-defun etaf-performance-report-data
|
||||||
"Return a portable report for completed performance RECORDS."
|
(&optional (records (etaf-performance-records)))
|
||||||
(let ((records (or 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
|
(list :format-version etaf-performance-report-format-version
|
||||||
:generated-at (format-time-string "%Y-%m-%dT%H:%M:%S%z")
|
:generated-at (format-time-string "%Y-%m-%dT%H:%M:%S%z")
|
||||||
:environment (etaf-performance-environment-data)
|
:environment (etaf-performance-environment-data)
|
||||||
:summary (etaf-performance-summary records)
|
:summary (etaf-performance-summary records)
|
||||||
:operations
|
:operations
|
||||||
(mapcar #'etaf-performance--operation-report-data
|
(mapcar #'etaf-performance--operation-report-data
|
||||||
(reverse (copy-sequence records))))))
|
(reverse (copy-sequence records)))))
|
||||||
|
|
||||||
;;;###autoload
|
;;;###autoload
|
||||||
(defun etaf-performance-report-string (&optional records)
|
(cl-defun etaf-performance-report-string
|
||||||
"Return completed performance RECORDS as a readable 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"
|
(concat ";; ETAF performance report\n"
|
||||||
(pp-to-string (etaf-performance-report-data records))))
|
(pp-to-string (etaf-performance-report-data records))))
|
||||||
|
|
||||||
|
|||||||
@ -13,7 +13,8 @@ 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. 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
|
- `benchmark-ebox-resize.el` drives continuous pixel-width sweeps of any
|
||||||
existing mounted Ebox buffer, including ETAF apps, without taking over its
|
existing mounted Ebox buffer, including ETAF apps, without taking over its
|
||||||
observer. See the existing-server entry below.
|
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
|
them as background measurements, separately from foreground input-to-display
|
||||||
latency. Use Emacs-local operations while another app is active, not global input.
|
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
|
## Continuous resize on the existing server
|
||||||
|
|
||||||
Use this entry for resize performance investigations instead of copying the
|
Use this entry for resize performance investigations instead of copying the
|
||||||
|
|||||||
@ -34,7 +34,8 @@
|
|||||||
(cl-defstruct (etaf-gui-verifier-context
|
(cl-defstruct (etaf-gui-verifier-context
|
||||||
(:constructor etaf-gui-verifier--context-create))
|
(:constructor etaf-gui-verifier--context-create))
|
||||||
"Mutable execution state owned only by one verifier run."
|
"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)
|
(defun etaf-gui-verifier-context-put (context key value)
|
||||||
"Store adapter VALUE for KEY in CONTEXT and return VALUE."
|
"Store adapter VALUE for KEY in CONTEXT and return VALUE."
|
||||||
@ -45,6 +46,138 @@
|
|||||||
"Return CONTEXT adapter value KEY, or DEFAULT when absent."
|
"Return CONTEXT adapter value KEY, or DEFAULT when absent."
|
||||||
(alist-get key (etaf-gui-verifier-context-data context) default))
|
(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)
|
(defun etaf-gui-verifier-context-select-buffer (context buffer)
|
||||||
"Select live BUFFER as CONTEXT's single-window target."
|
"Select live BUFFER as CONTEXT's single-window target."
|
||||||
(unless (buffer-live-p buffer)
|
(unless (buffer-live-p buffer)
|
||||||
@ -86,7 +219,9 @@
|
|||||||
(cons 'action_count
|
(cons 'action_count
|
||||||
(etaf-gui-verifier-context-action-count context))
|
(etaf-gui-verifier-context-action-count context))
|
||||||
(cons 'duration_ms
|
(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)))))
|
(and function (funcall function context)))))
|
||||||
|
|
||||||
(defun etaf-gui-verifier--checkpoint
|
(defun etaf-gui-verifier--checkpoint
|
||||||
@ -140,10 +275,7 @@
|
|||||||
(assertions (etaf-gui-verifier-action-assertions action)))
|
(assertions (etaf-gui-verifier-action-assertions action)))
|
||||||
(etaf-gui-verifier--checkpoint
|
(etaf-gui-verifier--checkpoint
|
||||||
context action-id "before-action" nil)
|
context action-id "before-action" nil)
|
||||||
(let ((started (float-time)))
|
(etaf-gui-verifier-measure-action context action)
|
||||||
(funcall (etaf-gui-verifier-action-execute action) context)
|
|
||||||
(setf (etaf-gui-verifier-context-last-duration-ms context)
|
|
||||||
(* 1000.0 (- (float-time) started))))
|
|
||||||
(cl-incf (etaf-gui-verifier-context-action-count context))
|
(cl-incf (etaf-gui-verifier-context-action-count context))
|
||||||
(etaf-gui-verifier--checkpoint
|
(etaf-gui-verifier--checkpoint
|
||||||
context action-id "after-action" nil)
|
context action-id "after-action" nil)
|
||||||
|
|||||||
@ -4,8 +4,416 @@
|
|||||||
|
|
||||||
(require 'ert)
|
(require 'ert)
|
||||||
(require 'cl-lib)
|
(require 'cl-lib)
|
||||||
|
(require 'json)
|
||||||
(require 'emacs-gui-verifier)
|
(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 ()
|
(ert-deftest etaf-gui-verifier-runs-and-settles-without-raising-frame ()
|
||||||
"Actions and settled checkpoints must complete without raising Emacs."
|
"Actions and settled checkpoints must complete without raising Emacs."
|
||||||
(let ((context (etaf-gui-verifier--context-create))
|
(let ((context (etaf-gui-verifier--context-create))
|
||||||
|
|||||||
@ -236,6 +236,89 @@
|
|||||||
(plist-get (etaf-performance-stage-metadata stage)
|
(plist-get (etaf-performance-stage-metadata stage)
|
||||||
:detail)))))))
|
: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 ()
|
(ert-deftest etaf-performance-summary-uses-flat-duration ()
|
||||||
"Summaries expose percentiles and overlapping provider durations honestly."
|
"Summaries expose percentiles and overlapping provider durations honestly."
|
||||||
(etaf-performance-test--isolated
|
(etaf-performance-test--isolated
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user