refactor: consume public performance reports without advice
This commit is contained in:
Kinneyzhang
parent
bcb7254350
commit
d63cf1a813
45
README.md
45
README.md
@ -42,12 +42,15 @@ Define a Component:
|
|||||||
|
|
||||||
## Performance records
|
## Performance records
|
||||||
|
|
||||||
ETAF includes an opt-in, application-neutral timing recorder. It recognizes
|
ETAF provides an independent, opt-in, application-neutral timing recorder. It
|
||||||
public Event, Action, mount, flush, focus, Data, Resource, and viewport
|
consumes public Runtime observer reports without advice or private cross-package
|
||||||
operations, then correlates coarse ETAF, Ebox, TP, and SQLite stages when those
|
probes. Runtime operations such as Event, Action, mount, flush, and unmount are
|
||||||
packages are loaded.
|
recorded automatically; Ebox, TP, Data, Resource, and SQLite provider stages
|
||||||
|
inside the same operation are correlated by sequence.
|
||||||
|
|
||||||
```elisp
|
```elisp
|
||||||
|
(require 'etaf-performance)
|
||||||
|
;; In a buffer with a mounted ETAF Runtime:
|
||||||
(etaf-performance-mode 1)
|
(etaf-performance-mode 1)
|
||||||
;; Use any mounted ETAF application normally.
|
;; Use any mounted ETAF application normally.
|
||||||
(etaf-performance-show)
|
(etaf-performance-show)
|
||||||
@ -58,30 +61,24 @@ reproducing the operations, press `c` in the panel (or run
|
|||||||
`M-x etaf-performance-copy-report`) to copy a complete report. Press `w` (or
|
`M-x etaf-performance-copy-report`) to copy a complete report. Press `w` (or
|
||||||
run `M-x etaf-performance-export`) to save the same report as an `.eld` file.
|
run `M-x etaf-performance-export`) to save the same report as an `.eld` file.
|
||||||
The portable report includes the Emacs/display environment, power source,
|
The portable report includes the Emacs/display environment, power source,
|
||||||
low-power mode, system load, grouped p50/p95/max, individual operations, GC
|
low-power mode, native-JIT state, system load, grouped p50/p95/max, individual
|
||||||
deltas, and nested stages. The panel header exposes the same environment
|
operations, GC deltas, and ordered provider stages. The panel header exposes
|
||||||
context so a machine-wide slowdown is not mistaken for one package hotspot.
|
the same environment context so a machine-wide slowdown is not mistaken for
|
||||||
|
one package hotspot.
|
||||||
|
|
||||||
The `*ETAF Performance*` panel shows operation IDs and parent operations,
|
The `*ETAF Performance*` panel shows operation IDs, generation changes, total
|
||||||
generation changes, total latency, GC deltas, and nested stage inclusive/self
|
latency, GC deltas, and each flat provider stage in sequence. Provider stages
|
||||||
time. Records are bounded by `etaf-performance-max-records`; disabling the
|
may overlap, so they are not presented as exclusive/self time. Records are
|
||||||
mode removes all recorder advice. `etaf-performance-summary` computes
|
bounded by `etaf-performance-max-records`; disabling the mode only detaches the
|
||||||
operation p50/p95/max statistics on demand, while
|
Runtime observer and never rewrites functions. `etaf-performance-summary`
|
||||||
`etaf-performance-operation-stage-summary` ranks one operation's package
|
computes operation p50/p95/max statistics on demand, while
|
||||||
categories by exclusive time.
|
`etaf-performance-operation-stage-summary` groups one operation's flat stages
|
||||||
|
by provider category.
|
||||||
The default registry deliberately uses coarse package boundaries to keep the
|
|
||||||
measured application representative. A package or application can add a
|
|
||||||
temporary detail probe without coupling itself to an example:
|
|
||||||
|
|
||||||
```elisp
|
|
||||||
(etaf-performance-register-stage
|
|
||||||
'my-package-expensive-step 'application 'expensive-step)
|
|
||||||
```
|
|
||||||
|
|
||||||
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
|
||||||
built-in public boundary.
|
built-in public boundary. Both delegate to the same Runtime operation boundary;
|
||||||
|
they do not create a second timer.
|
||||||
|
|
||||||
## Executable examples
|
## Executable examples
|
||||||
|
|
||||||
|
|||||||
@ -42,12 +42,14 @@ Component(props, Scope) → View → Renderer → Ebox Node → Emacs buffer
|
|||||||
|
|
||||||
## 性能记录面板
|
## 性能记录面板
|
||||||
|
|
||||||
ETAF 内置了一个按需启用、与具体应用无关的性能记录器。它自动识别公共
|
ETAF 提供一个独立、按需加载、与具体应用无关的性能记录器。它消费 Runtime
|
||||||
Event、Action、mount、flush、focus、Data、Resource 和 viewport 操作；当
|
公共 observer 报告，不使用 advice 或私有跨包探针。Event、Action、mount、flush
|
||||||
Ebox、TP、SQLite 等包已加载时，还会把这些包的粗粒度阶段关联到同一个
|
和 unmount 等 Runtime operation 会自动记录；同一 operation 内的 Ebox、TP、Data、
|
||||||
operation。
|
Resource 和 SQLite 等 provider 阶段按 sequence 关联到同一条记录。
|
||||||
|
|
||||||
```elisp
|
```elisp
|
||||||
|
(require 'etaf-performance)
|
||||||
|
;; 在已挂载 ETAF Runtime 的 buffer 中：
|
||||||
(etaf-performance-mode 1)
|
(etaf-performance-mode 1)
|
||||||
;; 正常操作任意已挂载的 ETAF 应用。
|
;; 正常操作任意已挂载的 ETAF 应用。
|
||||||
(etaf-performance-show)
|
(etaf-performance-show)
|
||||||
@ -56,28 +58,21 @@ operation。
|
|||||||
交互采集时先执行 `M-x etaf-performance-clear`，复现一组操作后，在面板按
|
交互采集时先执行 `M-x etaf-performance-clear`，复现一组操作后，在面板按
|
||||||
`c`（或执行 `M-x etaf-performance-copy-report`）即可把完整报告复制到剪贴板；
|
`c`（或执行 `M-x etaf-performance-copy-report`）即可把完整报告复制到剪贴板；
|
||||||
按 `w`（或执行 `M-x etaf-performance-export`）可保存为 `.eld` 文件。报告包含
|
按 `w`（或执行 `M-x etaf-performance-export`）可保存为 `.eld` 文件。报告包含
|
||||||
Emacs/显示环境、电源来源、低功耗模式、系统负载、分组 p50/p95/max、每次
|
Emacs/显示环境、电源来源、低功耗模式、native JIT 状态、系统负载、分组
|
||||||
operation、GC 增量和嵌套阶段；面板 header 也显示同一环境信息，避免把整机降频
|
p50/p95/max、每次 operation、GC 增量和有序 provider 阶段；面板 header 也显示
|
||||||
误判成某个包的热点。
|
同一环境信息，避免把整机降频误判成某个包的热点。
|
||||||
|
|
||||||
`*ETAF Performance*` 面板会显示 operation ID 与父 operation、generation
|
`*ETAF Performance*` 面板会显示 operation ID、generation 变化、总耗时、GC
|
||||||
变化、总耗时、GC 增量，以及嵌套阶段的 inclusive/self 耗时。记录数量由
|
增量，以及 flat provider 阶段的顺序和各自耗时。provider 阶段可能重叠，因此
|
||||||
`etaf-performance-max-records` 限制；关闭 mode 会移除全部记录 advice。
|
不会伪装成 exclusive/self 时间。记录数量由 `etaf-performance-max-records`
|
||||||
|
限制；关闭 mode 只会解除当前 Runtime 的 observer，不修改任何函数。
|
||||||
`etaf-performance-summary` 会按需计算 operation 的 p50/p95/max，
|
`etaf-performance-summary` 会按需计算 operation 的 p50/p95/max，
|
||||||
`etaf-performance-operation-stage-summary` 则按 exclusive 耗时排列单次
|
`etaf-performance-operation-stage-summary` 则按 provider category 汇总单次
|
||||||
operation 的包级阶段。
|
operation 的 flat 阶段。
|
||||||
|
|
||||||
默认注册表刻意只记录包级粗边界，避免分析工具明显改变被测应用。任意包或
|
|
||||||
应用可以临时增加更细的探针，不需要绑定某个示例：
|
|
||||||
|
|
||||||
```elisp
|
|
||||||
(etaf-performance-register-stage
|
|
||||||
'my-package-expensive-step 'application 'expensive-step)
|
|
||||||
```
|
|
||||||
|
|
||||||
没有内置公共边界的任意操作，可以使用
|
没有内置公共边界的任意操作，可以使用
|
||||||
`etaf-performance-call-operation` 或 `etaf-performance-with-operation`
|
`etaf-performance-call-operation` 或 `etaf-performance-with-operation`
|
||||||
包裹。
|
包裹；它们直接委托同一个 Runtime operation 边界，不建立第二套计时器。
|
||||||
|
|
||||||
## 可执行示例
|
## 可执行示例
|
||||||
|
|
||||||
|
|||||||
@ -612,6 +612,8 @@ Enable the generic recorder around any application workload, then open its
|
|||||||
ordinary `tabulated-list-mode` panel:
|
ordinary `tabulated-list-mode` panel:
|
||||||
|
|
||||||
```elisp
|
```elisp
|
||||||
|
(require 'etaf-performance)
|
||||||
|
;; In a buffer with a mounted ETAF Runtime:
|
||||||
(etaf-performance-mode 1)
|
(etaf-performance-mode 1)
|
||||||
(etaf-performance-show)
|
(etaf-performance-show)
|
||||||
```
|
```
|
||||||
@ -620,23 +622,26 @@ Run `M-x etaf-performance-clear` before the measured reproduction. Afterwards,
|
|||||||
press `c` in the panel, or run `M-x etaf-performance-copy-report`, to copy the
|
press `c` in the panel, or run `M-x etaf-performance-copy-report`, to copy the
|
||||||
environment, summary, operation, GC, and stage data. Press `w`, or run
|
environment, summary, operation, GC, and stage data. Press `w`, or run
|
||||||
`M-x etaf-performance-export`, to save the same portable report as an `.eld`
|
`M-x etaf-performance-export`, to save the same portable report as an `.eld`
|
||||||
file. The report and panel header include power source, low-power mode, and
|
file. The report and panel header include power source, low-power mode,
|
||||||
system load alongside the ordinary Emacs/display environment.
|
native-JIT state, and system load alongside the ordinary Emacs/display
|
||||||
|
environment.
|
||||||
|
|
||||||
The recorder creates bounded operation records for public interaction,
|
The recorder only consumes public Runtime observer reports and installs no
|
||||||
lifecycle, Data, Resource, and viewport boundaries. Loaded Ebox, TP, and
|
advice. Runtime Event, Action, mount, flush, and unmount boundaries create
|
||||||
SQLite functions contribute nested coarse stages without depending on ETAF.
|
bounded operation records. Ebox, TP, Data, Resource, and SQLite may contribute
|
||||||
Each stage reports inclusive and exclusive milliseconds; failures and quits
|
flat provider stages, ordered by sequence, inside the same operation. Stages
|
||||||
are recorded and then re-signaled unchanged.
|
may overlap and are therefore not reported as exclusive/self time; failures and
|
||||||
|
quits are recorded and then re-signaled unchanged.
|
||||||
|
|
||||||
`etaf-performance-summary` calculates grouped p50/p95/max statistics only when
|
`etaf-performance-summary` calculates grouped p50/p95/max statistics only when
|
||||||
requested. `etaf-performance-operation-stage-summary` ranks the package
|
requested. `etaf-performance-operation-stage-summary` groups the flat stages
|
||||||
categories of one recorded operation by exclusive time.
|
of one recorded operation by provider category.
|
||||||
|
|
||||||
Use `etaf-performance-register-stage` for a temporary package-specific detail
|
Use `etaf-performance-call-operation` or `etaf-performance-with-operation` for
|
||||||
probe. Use `etaf-performance-with-operation` for application work that does
|
application work that does not enter through a built-in public boundary. Both
|
||||||
not enter through a built-in public boundary. Disable the mode when the
|
delegate to the same Runtime operation boundary. Disable the mode when the
|
||||||
capture is complete; all installed advice is removed.
|
capture is complete; this only detaches the Runtime observer and does not
|
||||||
|
rewrite any function.
|
||||||
|
|
||||||
## 14. Public API map
|
## 14. Public API map
|
||||||
|
|
||||||
@ -655,7 +660,7 @@ capture is complete; all installed advice is removed.
|
|||||||
| Resource | `etaf-resource`, `etaf-resource-result`, `etaf-error-boundary-run` | Own loader state and cleanup |
|
| Resource | `etaf-resource`, `etaf-resource-result`, `etaf-error-boundary-run` | Own loader state and cleanup |
|
||||||
| Official UI | `require 'etaf-ui`, `etaf-button`, `etaf-checkbox`, `etaf-number-input`, `etaf-label`, `etaf-panel`, `etaf-data-grid` | Use ready-made Components |
|
| Official UI | `require 'etaf-ui`, `etaf-button`, `etaf-checkbox`, `etaf-number-input`, `etaf-label`, `etaf-panel`, `etaf-data-grid` | Use ready-made Components |
|
||||||
| Playground | `etaf-playground-open`, `etaf-playground-open-ui`, `etaf-playground-close`, `ebox-playground-open`, `ebox-playground-close` | Explore the corresponding layer interactively |
|
| Playground | `etaf-playground-open`, `etaf-playground-open-ui`, `etaf-playground-close`, `ebox-playground-open`, `ebox-playground-close` | Explore the corresponding layer interactively |
|
||||||
| Performance | `etaf-performance-mode`, `etaf-performance-show`, `etaf-performance-copy-report`, `etaf-performance-export`, `etaf-performance-environment-data`, `etaf-performance-records`, `etaf-performance-summary`, `etaf-performance-operation-stage-summary`, `etaf-performance-with-operation`, `etaf-performance-register-stage` | Attribute generic operation latency across loaded packages and share reports |
|
| Performance | `etaf-performance-start`, `etaf-performance-stop`, `etaf-performance-mode`, `etaf-performance-show`, `etaf-performance-copy-report`, `etaf-performance-export`, `etaf-performance-environment-data`, `etaf-performance-records`, `etaf-performance-summary`, `etaf-performance-operation-stage-summary`, `etaf-performance-call-operation`, `etaf-performance-with-operation` | Attribute generic operation latency through public observers and share reports |
|
||||||
|
|
||||||
Most applications need only `etaf-view`, `etaf-mount`, `etaf-define-component`, `etaf-ref`, and event callbacks at first. The remaining APIs are additive capabilities, not prerequisites for understanding the core grammar.
|
Most applications need only `etaf-view`, `etaf-mount`, `etaf-define-component`, `etaf-ref`, and event callbacks at first. The remaining APIs are additive capabilities, not prerequisites for understanding the core grammar.
|
||||||
|
|
||||||
|
|||||||
@ -605,6 +605,8 @@ Loader 错误会保存在 `etaf-resource-error`；cleanup/type 错误保持可
|
|||||||
对任意应用负载启用通用记录器，然后打开普通的 `tabulated-list-mode` 面板：
|
对任意应用负载启用通用记录器，然后打开普通的 `tabulated-list-mode` 面板：
|
||||||
|
|
||||||
```elisp
|
```elisp
|
||||||
|
(require 'etaf-performance)
|
||||||
|
;; 在已挂载 ETAF Runtime 的 buffer 中：
|
||||||
(etaf-performance-mode 1)
|
(etaf-performance-mode 1)
|
||||||
(etaf-performance-show)
|
(etaf-performance-show)
|
||||||
```
|
```
|
||||||
@ -612,21 +614,23 @@ Loader 错误会保存在 `etaf-resource-error`；cleanup/type 错误保持可
|
|||||||
正式复现前执行 `M-x etaf-performance-clear`。复现后在面板按 `c`，或者执行
|
正式复现前执行 `M-x etaf-performance-clear`。复现后在面板按 `c`，或者执行
|
||||||
`M-x etaf-performance-copy-report`，可把环境、汇总、operation、GC 和阶段数据
|
`M-x etaf-performance-copy-report`，可把环境、汇总、operation、GC 和阶段数据
|
||||||
完整复制到剪贴板；按 `w` 或执行 `M-x etaf-performance-export` 可导出 `.eld`
|
完整复制到剪贴板；按 `w` 或执行 `M-x etaf-performance-export` 可导出 `.eld`
|
||||||
文件。报告和面板 header 还会显示电源来源、低功耗模式与系统负载。这两种报告
|
文件。报告和面板 header 还会显示电源来源、低功耗模式、native JIT 状态与系统
|
||||||
都可以直接发送给分析者。
|
负载。这两种报告都可以直接发送给分析者。
|
||||||
|
|
||||||
记录器会为公共交互、lifecycle、Data、Resource 和 viewport 边界创建有界的
|
记录器只消费 Runtime 的公共 observer 报告，不安装 advice。Runtime 的 Event、
|
||||||
operation 记录。已加载的 Ebox、TP 与 SQLite 可以贡献嵌套的粗粒度阶段，
|
Action、mount、flush 和 unmount 会创建有界 operation 记录；同一 operation 内，
|
||||||
但不需要反向依赖 ETAF。每个阶段同时报告 inclusive 与 exclusive 毫秒；
|
Ebox、TP、Data、Resource 与 SQLite 可以贡献按 sequence 排列的 flat provider
|
||||||
error 和 quit 会先被记录，再保持原条件继续抛出。
|
阶段。阶段可能重叠，因此不声称 exclusive/self 时间；error 和 quit 会先被记录，
|
||||||
|
再保持原条件继续抛出。
|
||||||
|
|
||||||
`etaf-performance-summary` 只在请求时计算分组后的 p50/p95/max；
|
`etaf-performance-summary` 只在请求时计算分组后的 p50/p95/max；
|
||||||
`etaf-performance-operation-stage-summary` 会按 exclusive 时间排列某条记录
|
`etaf-performance-operation-stage-summary` 会按 provider category 汇总某条记录
|
||||||
中的包级阶段。
|
中的 flat 阶段。
|
||||||
|
|
||||||
使用 `etaf-performance-register-stage` 临时加入包级细节探针。没有经过内置
|
没有经过内置公共边界的应用操作可以使用
|
||||||
公共边界的应用操作可以使用 `etaf-performance-with-operation`。采集结束后
|
`etaf-performance-call-operation`/`etaf-performance-with-operation`；它们直接委托
|
||||||
关闭 mode，所有已安装 advice 都会被移除。
|
同一个 Runtime operation 边界。采集结束后关闭 mode，只解除当前 Runtime 的
|
||||||
|
observer，不修改任何函数。
|
||||||
|
|
||||||
## 14. 公共 API 速查
|
## 14. 公共 API 速查
|
||||||
|
|
||||||
@ -645,7 +649,7 @@ error 和 quit 会先被记录，再保持原条件继续抛出。
|
|||||||
| Resource | `etaf-resource`、`etaf-resource-result`、`etaf-error-boundary-run` | 管理 loader 状态和 cleanup |
|
| Resource | `etaf-resource`、`etaf-resource-result`、`etaf-error-boundary-run` | 管理 loader 状态和 cleanup |
|
||||||
| 官方 UI | `require 'etaf-ui`、`etaf-button`、`etaf-checkbox`、`etaf-number-input`、`etaf-label`、`etaf-panel`、`etaf-data-grid` | 使用现成 Component |
|
| 官方 UI | `require 'etaf-ui`、`etaf-button`、`etaf-checkbox`、`etaf-number-input`、`etaf-label`、`etaf-panel`、`etaf-data-grid` | 使用现成 Component |
|
||||||
| Playground | `etaf-playground-open`、`etaf-playground-open-ui`、`etaf-playground-close`、`ebox-playground-open`、`ebox-playground-close` | 探索对应层 |
|
| Playground | `etaf-playground-open`、`etaf-playground-open-ui`、`etaf-playground-close`、`ebox-playground-open`、`ebox-playground-close` | 探索对应层 |
|
||||||
| 性能分析 | `etaf-performance-mode`、`etaf-performance-show`、`etaf-performance-copy-report`、`etaf-performance-export`、`etaf-performance-environment-data`、`etaf-performance-records`、`etaf-performance-summary`、`etaf-performance-operation-stage-summary`、`etaf-performance-with-operation`、`etaf-performance-register-stage` | 跨已加载包定位通用 operation 的耗时并分享报告 |
|
| 性能分析 | `etaf-performance-start`、`etaf-performance-stop`、`etaf-performance-mode`、`etaf-performance-show`、`etaf-performance-copy-report`、`etaf-performance-export`、`etaf-performance-environment-data`、`etaf-performance-records`、`etaf-performance-summary`、`etaf-performance-operation-stage-summary`、`etaf-performance-call-operation`、`etaf-performance-with-operation` | 通过公共 observer 定位通用 operation 的耗时并分享报告 |
|
||||||
|
|
||||||
大多数应用一开始只需要 `etaf-view`、`etaf-mount`、`etaf-define-component`、`etaf-ref` 和事件 callback。其余 API 都是可选能力，不是理解核心语法的前置条件。
|
大多数应用一开始只需要 `etaf-view`、`etaf-mount`、`etaf-define-component`、`etaf-ref` 和事件 callback。其余 API 都是可选能力，不是理解核心语法的前置条件。
|
||||||
|
|
||||||
|
|||||||
File diff suppressed because it is too large
Load Diff
@ -6,445 +6,299 @@
|
|||||||
|
|
||||||
(require 'ert)
|
(require 'ert)
|
||||||
(require 'etaf)
|
(require 'etaf)
|
||||||
|
(defconst etaf-performance-test--facade-loaded-recorder-p
|
||||||
|
(featurep 'etaf-performance)
|
||||||
|
"Whether loading the ETAF facade eagerly loaded the optional recorder.")
|
||||||
|
(require 'etaf-performance)
|
||||||
|
|
||||||
|
(ert-deftest etaf-performance-is-not-an-etaf-facade-dependency ()
|
||||||
|
"The optional recorder must be loaded explicitly."
|
||||||
|
(should-not etaf-performance-test--facade-loaded-recorder-p))
|
||||||
|
|
||||||
(defmacro etaf-performance-test--isolated (&rest body)
|
(defmacro etaf-performance-test--isolated (&rest body)
|
||||||
"Run BODY with isolated performance recorder state."
|
"Run BODY with isolated recorder state."
|
||||||
(declare (indent 0) (debug t))
|
(declare (indent 0) (debug t))
|
||||||
`(unwind-protect
|
`(let ((etaf-performance--record-ring nil)
|
||||||
(progn
|
(etaf-performance--pending (make-hash-table :test #'equal))
|
||||||
(etaf-performance-mode -1)
|
(etaf-performance--attachments (make-hash-table :test #'eq)))
|
||||||
(etaf-performance-clear)
|
,@body))
|
||||||
,@body)
|
|
||||||
(etaf-performance-mode -1)
|
|
||||||
(etaf-performance-clear)))
|
|
||||||
|
|
||||||
(ert-deftest etaf-performance-records-success-result-and-error ()
|
(cl-defmacro etaf-performance-test--with-runtime
|
||||||
"Recording preserves successful results and original error data."
|
((runtime buffer-name) &rest body)
|
||||||
(etaf-performance-test--isolated
|
"Mount RUNTIME in BUFFER-NAME, evaluate BODY, then clean up."
|
||||||
(etaf-performance-mode 1)
|
(declare (indent 1) (debug ((symbolp symbolp) body)))
|
||||||
(should (equal 42
|
`(let ((,buffer-name (generate-new-buffer-name " *etaf-performance-test*"))
|
||||||
(etaf-performance--call-operation
|
,runtime)
|
||||||
(lambda () 42) 'test-success 'test nil)))
|
(unwind-protect
|
||||||
(let ((condition
|
(progn
|
||||||
(condition-case error-data
|
(etaf-mount ,buffer-name (etaf-view (box "Performance")))
|
||||||
(etaf-performance--call-operation
|
(setq ,runtime (etaf-runtime-for-buffer ,buffer-name))
|
||||||
(lambda ()
|
,@body)
|
||||||
(etaf-performance--call-stage
|
(when ,runtime
|
||||||
(lambda ()
|
(etaf-performance-stop ,runtime)
|
||||||
(signal 'args-out-of-range '(source 1 2)))
|
(when (etaf-runtime-mounted-p ,runtime)
|
||||||
'failing-stage 'test 'failure nil))
|
(etaf-unmount ,runtime)))
|
||||||
'test-error 'test nil)
|
(when-let* ((buffer (get-buffer ,buffer-name)))
|
||||||
(args-out-of-range error-data))))
|
(kill-buffer buffer)))))
|
||||||
(should (equal condition '(args-out-of-range source 1 2))))
|
|
||||||
(let ((records (etaf-performance-records)))
|
|
||||||
(should (= 2 (length records)))
|
|
||||||
(should (eq 'error
|
|
||||||
(etaf-performance-operation-status (car records))))
|
|
||||||
(should (eq 'error
|
|
||||||
(etaf-performance-stage-status
|
|
||||||
(car (etaf-performance-operation-stages
|
|
||||||
(car records))))))
|
|
||||||
(should (eq 'success
|
|
||||||
(etaf-performance-operation-status (cadr records)))))))
|
|
||||||
|
|
||||||
(ert-deftest etaf-performance-records-preserve-quit ()
|
(ert-deftest etaf-performance-start-stop-own-exact-runtime-sink ()
|
||||||
"Recording marks and re-signals a quit without changing its data."
|
"Attach idempotently and remove only this recorder's exact sink."
|
||||||
(etaf-performance-test--isolated
|
(etaf-performance-test--isolated
|
||||||
(etaf-performance-mode 1)
|
(etaf-performance-test--with-runtime (runtime buffer-name)
|
||||||
(let ((condition
|
(should (eq runtime (etaf-performance-start runtime)))
|
||||||
(condition-case quit-data
|
(let* ((attachment
|
||||||
(etaf-performance--call-operation
|
(gethash runtime etaf-performance--attachments))
|
||||||
(lambda () (signal 'quit '(performance-test)))
|
(sink (etaf-performance--attachment-sink attachment)))
|
||||||
'test-quit 'test nil)
|
(should (functionp sink))
|
||||||
(quit quit-data))))
|
(should (etaf-runtime-compare-and-set-observer runtime sink sink))
|
||||||
(should (equal condition '(quit performance-test)))
|
(should (eq runtime (etaf-performance-start runtime)))
|
||||||
(should (eq 'quit
|
(should (eq runtime (etaf-performance-stop runtime)))
|
||||||
(etaf-performance-operation-status
|
(should (etaf-runtime-compare-and-set-observer runtime nil nil))))))
|
||||||
(car (etaf-performance-records))))))))
|
|
||||||
|
|
||||||
(ert-deftest etaf-performance-public-operation-wrapper-is-generic ()
|
(ert-deftest etaf-performance-start-rejects-foreign-observer ()
|
||||||
"The public operation API records arbitrary code and preserves its result."
|
"Never replace an observer owned by another consumer."
|
||||||
(etaf-performance-test--isolated
|
(etaf-performance-test--isolated
|
||||||
(etaf-performance-mode 1)
|
(etaf-performance-test--with-runtime (runtime buffer-name)
|
||||||
(should
|
(let ((foreign #'ignore))
|
||||||
(equal '(generic result)
|
(etaf-runtime-set-observer runtime foreign)
|
||||||
(etaf-performance-with-operation ('command "generic fixture")
|
(should-error (etaf-performance-start runtime))
|
||||||
'(generic result))))
|
(should (etaf-runtime-compare-and-set-observer
|
||||||
(let ((operation (car (etaf-performance-records))))
|
runtime foreign foreign))
|
||||||
(should (eq 'command
|
(etaf-runtime-set-observer runtime nil)))))
|
||||||
(etaf-performance-operation-kind operation)))
|
|
||||||
(should (equal "generic fixture"
|
|
||||||
(etaf-performance-operation-label operation))))))
|
|
||||||
|
|
||||||
(ert-deftest etaf-performance-stage-registration-is-load-order-safe ()
|
(ert-deftest etaf-performance-stop-preserves-replacement-observer ()
|
||||||
"Third-party stages may register before their function is defined."
|
"A later foreign replacement is not detached by recorder stop."
|
||||||
(etaf-performance-test--isolated
|
(etaf-performance-test--isolated
|
||||||
(let ((function (make-symbol "etaf-performance-generic-stage")))
|
(etaf-performance-test--with-runtime (runtime buffer-name)
|
||||||
|
(etaf-performance-start runtime)
|
||||||
|
(let ((foreign #'ignore))
|
||||||
|
(etaf-runtime-set-observer runtime foreign)
|
||||||
|
(etaf-performance-stop runtime)
|
||||||
|
(should (etaf-runtime-compare-and-set-observer
|
||||||
|
runtime foreign foreign))
|
||||||
|
(etaf-runtime-set-observer runtime nil)))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-performance-mode-is-current-buffer-convenience ()
|
||||||
|
"The local mode attaches only the Runtime in its current buffer."
|
||||||
|
(etaf-performance-test--isolated
|
||||||
|
(etaf-performance-test--with-runtime (runtime buffer-name)
|
||||||
|
(with-current-buffer buffer-name
|
||||||
|
(etaf-performance-mode 1)
|
||||||
|
(should etaf-performance-mode)
|
||||||
|
(should (eq runtime etaf-performance--mode-runtime))
|
||||||
|
(let* ((attachment
|
||||||
|
(gethash runtime etaf-performance--attachments))
|
||||||
|
(sink (etaf-performance--attachment-sink attachment)))
|
||||||
|
(should (functionp sink))
|
||||||
|
(should (etaf-runtime-compare-and-set-observer
|
||||||
|
runtime sink sink)))
|
||||||
|
(etaf-performance-mode -1)
|
||||||
|
(should-not etaf-performance-mode)
|
||||||
|
(should (etaf-runtime-compare-and-set-observer runtime nil nil))))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-performance-mode-rejects-non-runtime-buffer ()
|
||||||
|
"The buffer-local convenience requires a mounted Runtime."
|
||||||
|
(with-temp-buffer
|
||||||
|
(should-error (etaf-performance-mode 1))
|
||||||
|
(should-not etaf-performance-mode)))
|
||||||
|
|
||||||
|
(ert-deftest etaf-performance-unmount-records-and-releases-attachment ()
|
||||||
|
"Record unmount before the Runtime detaches this recorder."
|
||||||
|
(etaf-performance-test--isolated
|
||||||
|
(let ((buffer-name (generate-new-buffer-name " *etaf-performance-unmount*"))
|
||||||
|
runtime)
|
||||||
(unwind-protect
|
(unwind-protect
|
||||||
(progn
|
(progn
|
||||||
(etaf-performance-register-stage function 'extension 'prepare)
|
(etaf-mount buffer-name (etaf-view (box "Unmount")))
|
||||||
(etaf-performance-mode 1)
|
(setq runtime (etaf-runtime-for-buffer buffer-name))
|
||||||
(should-not (assq function etaf-performance--installed-advices))
|
(etaf-performance-start runtime)
|
||||||
(fset function (lambda () 'extension-result))
|
(etaf-unmount runtime)
|
||||||
(etaf-performance--install-loaded-advices)
|
(should-not (gethash runtime etaf-performance--attachments))
|
||||||
(should (assq function etaf-performance--installed-advices))
|
(let ((operation (car (etaf-performance-records))))
|
||||||
(should (eq 'extension-result
|
(should (eq 'unmount
|
||||||
(etaf-performance-call-operation
|
(etaf-performance-operation-kind operation)))
|
||||||
'extension "registered stage"
|
(should (eq 'success
|
||||||
(lambda () (funcall function)))))
|
(etaf-performance-operation-status operation))))
|
||||||
(let ((stage
|
(should (eq runtime (etaf-performance-stop runtime))))
|
||||||
(car (etaf-performance-operation-stages
|
|
||||||
(car (etaf-performance-records))))))
|
|
||||||
(should (eq function
|
|
||||||
(etaf-performance-stage-function stage)))
|
|
||||||
(should (eq 'extension
|
|
||||||
(etaf-performance-stage-category stage)))))
|
|
||||||
(etaf-performance-unregister-stage function)
|
|
||||||
(when (fboundp function)
|
|
||||||
(fmakunbound function))))))
|
|
||||||
|
|
||||||
(ert-deftest etaf-performance-default-registry-keeps-per-node-probes-opt-in ()
|
|
||||||
"High-frequency per-node probes must not distort default operation timing."
|
|
||||||
(dolist (function '(ebox-incremental--candidate-local-changed-keys
|
|
||||||
ebox-tree-node-local-source-signature))
|
|
||||||
(should-not (assq function etaf-performance--stage-functions))))
|
|
||||||
|
|
||||||
(ert-deftest etaf-performance-stage-advice-survives-package-reload ()
|
|
||||||
"Reattach the tracked stage closure after its function is redefined."
|
|
||||||
(etaf-performance-test--isolated
|
|
||||||
(let ((function (make-symbol "etaf-performance-reloaded-stage")))
|
|
||||||
(unwind-protect
|
|
||||||
(progn
|
|
||||||
(fset function (lambda () 'first))
|
|
||||||
(etaf-performance-register-stage function 'extension 'reload)
|
|
||||||
(etaf-performance-mode 1)
|
|
||||||
(let ((entry (assq function
|
|
||||||
etaf-performance--installed-advices)))
|
|
||||||
(should (advice-member-p (cdr entry) function))
|
|
||||||
(fset function (lambda () 'second))
|
|
||||||
(should-not (advice-member-p (cdr entry) function))
|
|
||||||
(etaf-performance--install-loaded-advices)
|
|
||||||
(should (advice-member-p (cdr entry) function)))
|
|
||||||
(etaf-performance-clear)
|
|
||||||
(should (eq 'second
|
|
||||||
(etaf-performance-call-operation
|
|
||||||
'reload "package reload"
|
|
||||||
(lambda () (funcall function)))))
|
|
||||||
(should (= 1
|
|
||||||
(length
|
|
||||||
(etaf-performance-operation-stages
|
|
||||||
(car (etaf-performance-records)))))))
|
|
||||||
(etaf-performance-unregister-stage function)
|
|
||||||
(when (fboundp function) (fmakunbound function))))))
|
|
||||||
|
|
||||||
(ert-deftest etaf-performance-stage-registration-rejects-operation-collision ()
|
|
||||||
"A detail stage must not replace a public operation boundary advice."
|
|
||||||
(etaf-performance-test--isolated
|
|
||||||
(etaf-performance-mode 1)
|
|
||||||
(let* ((function 'etaf-data-load)
|
|
||||||
(entry (assq function etaf-performance--installed-advices)))
|
|
||||||
(should entry)
|
|
||||||
(should-error
|
|
||||||
(etaf-performance-register-stage function 'data 'nested-load))
|
|
||||||
(should-error (etaf-performance-unregister-stage function))
|
|
||||||
(should (eq entry (assq function etaf-performance--installed-advices)))
|
|
||||||
(should (advice-member-p (cdr entry) function)))))
|
|
||||||
|
|
||||||
(ert-deftest etaf-performance-public-data-resource-and-viewport-boundaries ()
|
|
||||||
"Public cross-package operations are boundaries, never duplicate stages."
|
|
||||||
(etaf-performance-test--isolated
|
|
||||||
(let ((functions '(etaf-data-load etaf-data-source-load-page
|
|
||||||
etaf-data-mutate etaf-resource-load
|
|
||||||
ebox-surface-update-buffer-viewport
|
|
||||||
ebox-rerender-buffer-with-context)))
|
|
||||||
(dolist (function functions)
|
|
||||||
(should (assq function etaf-performance--operation-functions))
|
|
||||||
(should-not (assq function etaf-performance--stage-functions)))
|
|
||||||
(etaf-performance-mode 1)
|
|
||||||
(dolist (function functions)
|
|
||||||
(when (fboundp function)
|
|
||||||
(should (assq function etaf-performance--installed-advices))))
|
|
||||||
(let* ((source (etaf-data-memory-source
|
|
||||||
'((:id 1 :name "one")) :id-key :id))
|
|
||||||
(controller (etaf-data-controller source))
|
|
||||||
(resource (etaf-resource (lambda () 'loaded) :immediate nil)))
|
|
||||||
(unwind-protect
|
|
||||||
(progn
|
|
||||||
(etaf-data-load controller)
|
|
||||||
(etaf-data-source-load-page source nil 1 20)
|
|
||||||
(etaf-data-mutate controller 'insert '(:id 2 :name "two"))
|
|
||||||
(etaf-resource-load resource)
|
|
||||||
(let ((kinds
|
|
||||||
(mapcar #'etaf-performance-operation-kind
|
|
||||||
(etaf-performance-records))))
|
|
||||||
(should (memq 'data-load kinds))
|
|
||||||
(should (memq 'data-prepare kinds))
|
|
||||||
(should (memq 'data-mutate kinds))
|
|
||||||
(should (memq 'resource-load kinds))))
|
|
||||||
(etaf-data-stop controller)
|
|
||||||
(etaf-resource-dispose resource))))))
|
|
||||||
|
|
||||||
(ert-deftest etaf-performance-records-nested-stage-exclusive-time ()
|
|
||||||
"Nested stages retain depth and subtract child inclusive time."
|
|
||||||
(etaf-performance-test--isolated
|
|
||||||
(etaf-performance-mode 1)
|
|
||||||
(etaf-performance--call-operation
|
|
||||||
(lambda ()
|
|
||||||
(etaf-performance--call-stage
|
|
||||||
(lambda ()
|
|
||||||
(sleep-for 0.002)
|
|
||||||
(etaf-performance--call-stage
|
|
||||||
(lambda () (sleep-for 0.002) 'inner-result)
|
|
||||||
'inner-stage 'inner 'work nil)
|
|
||||||
(sleep-for 0.002))
|
|
||||||
'outer-stage 'outer 'work nil))
|
|
||||||
'nested-operation 'test nil)
|
|
||||||
(let* ((operation (car (etaf-performance-records)))
|
|
||||||
(stages (etaf-performance-operation-stages operation))
|
|
||||||
(outer (car stages))
|
|
||||||
(inner (cadr stages)))
|
|
||||||
(should (= 2 (length stages)))
|
|
||||||
(should (= 0 (etaf-performance-stage-depth outer)))
|
|
||||||
(should (= 1 (etaf-performance-stage-depth inner)))
|
|
||||||
(should (>= (etaf-performance-stage-inclusive outer)
|
|
||||||
(etaf-performance-stage-inclusive inner)))
|
|
||||||
(should (< (abs (- (etaf-performance-stage-exclusive outer)
|
|
||||||
(- (etaf-performance-stage-inclusive outer)
|
|
||||||
(etaf-performance-stage-inclusive inner))))
|
|
||||||
0.001)))))
|
|
||||||
|
|
||||||
(ert-deftest etaf-performance-records-are-bounded ()
|
|
||||||
"Only the configured number of newest operations is retained."
|
|
||||||
(etaf-performance-test--isolated
|
|
||||||
(let ((etaf-performance-max-records 2))
|
|
||||||
(etaf-performance-mode 1)
|
|
||||||
(dotimes (index 4)
|
|
||||||
(etaf-performance--call-operation
|
|
||||||
(lambda () index) 'bounded 'test nil))
|
|
||||||
(let* ((records (etaf-performance-records))
|
|
||||||
(ids (mapcar #'etaf-performance-operation-id records)))
|
|
||||||
(should (= 2 (length records)))
|
|
||||||
(should (= 1 (- (car ids) (cadr ids))))))))
|
|
||||||
|
|
||||||
(ert-deftest etaf-performance-clear-keeps-correlation-ids-monotonic ()
|
|
||||||
"Clearing history inside an operation must not reuse its ID."
|
|
||||||
(etaf-performance-test--isolated
|
|
||||||
(etaf-performance-mode 1)
|
|
||||||
(etaf-performance-call-operation
|
|
||||||
'outer "clear inside" (lambda () (etaf-performance-clear)))
|
|
||||||
(etaf-performance-call-operation 'next "after clear" #'ignore)
|
|
||||||
(let ((ids (mapcar #'etaf-performance-operation-id
|
|
||||||
(etaf-performance-records))))
|
|
||||||
(should (= 2 (length (delete-dups (copy-sequence ids)))))
|
|
||||||
(should (= 1 (- (car ids) (cadr ids)))))))
|
|
||||||
|
|
||||||
(ert-deftest etaf-performance-summaries-aggregate-off-the-hot-path ()
|
|
||||||
"Summarize operation percentiles and non-overlapping category self time."
|
|
||||||
(etaf-performance-test--isolated
|
|
||||||
(etaf-performance-mode 1)
|
|
||||||
(dolist (delay '(0.001 0.002 0.003))
|
|
||||||
(etaf-performance-call-operation
|
|
||||||
'summary "generic"
|
|
||||||
(lambda ()
|
|
||||||
(etaf-performance--call-stage
|
|
||||||
(lambda () (sleep-for delay)) 'summary-stage 'application 'work nil))))
|
|
||||||
(let* ((records (etaf-performance-records))
|
|
||||||
(summary (car (etaf-performance-summary records)))
|
|
||||||
(stage-summary
|
|
||||||
(car (etaf-performance-operation-stage-summary (car records)))))
|
|
||||||
(should (= 3 (plist-get summary :count)))
|
|
||||||
(should (<= (plist-get summary :min-ms)
|
|
||||||
(plist-get summary :p50-ms)
|
|
||||||
(plist-get summary :p95-ms)
|
|
||||||
(plist-get summary :max-ms)))
|
|
||||||
(should (eq 'application (plist-get stage-summary :category)))
|
|
||||||
(should (= 1 (plist-get stage-summary :count)))
|
|
||||||
(should (<= (plist-get stage-summary :exclusive-ms)
|
|
||||||
(plist-get stage-summary :inclusive-ms))))))
|
|
||||||
|
|
||||||
(ert-deftest etaf-performance-records-real-event-and-runtime-stages ()
|
|
||||||
"A real mounted event creates an event operation and runtime stages."
|
|
||||||
(etaf-performance-test--isolated
|
|
||||||
(let ((buffer-name " *etaf-performance-event-test*")
|
|
||||||
(calls 0)
|
|
||||||
runtime-holder)
|
|
||||||
(unwind-protect
|
|
||||||
(progn
|
|
||||||
(etaf-performance-mode 1)
|
|
||||||
(etaf-mount
|
|
||||||
buffer-name
|
|
||||||
(etaf-view
|
|
||||||
(text :ref 'button
|
|
||||||
:on-press (lambda ()
|
|
||||||
(cl-incf calls)
|
|
||||||
(etaf-runtime-flush runtime-holder))
|
|
||||||
"Press")))
|
|
||||||
(etaf-performance-clear)
|
|
||||||
(let ((runtime (etaf-runtime-for-buffer buffer-name)))
|
|
||||||
(setq runtime-holder runtime)
|
|
||||||
(etaf-dispatch-event runtime 'button 'press)
|
|
||||||
(should (= calls 1))
|
|
||||||
(let ((operation
|
|
||||||
(cl-find 'event (etaf-performance-records)
|
|
||||||
:key #'etaf-performance-operation-kind)))
|
|
||||||
(should (eq 'event
|
|
||||||
(etaf-performance-operation-kind operation)))
|
|
||||||
(should (= (etaf-runtime-mount-epoch runtime)
|
|
||||||
(etaf-performance-operation-runtime-id operation)))
|
|
||||||
(should (equal buffer-name
|
|
||||||
(etaf-performance-operation-buffer-name
|
|
||||||
operation)))
|
|
||||||
(should (numberp
|
|
||||||
(etaf-performance-operation-generation-before
|
|
||||||
operation)))
|
|
||||||
(should
|
|
||||||
(cl-some
|
|
||||||
(lambda (record)
|
|
||||||
(cl-some
|
|
||||||
(lambda (stage)
|
|
||||||
(memq (etaf-performance-stage-category stage)
|
|
||||||
'(runtime reactive ebox tp)))
|
|
||||||
(etaf-performance-operation-stages record)))
|
|
||||||
(etaf-performance-records))))))
|
|
||||||
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
|
|
||||||
(etaf-unmount runtime))
|
|
||||||
(when-let* ((buffer (get-buffer buffer-name)))
|
(when-let* ((buffer (get-buffer buffer-name)))
|
||||||
(kill-buffer buffer))))))
|
(kill-buffer buffer))))))
|
||||||
|
|
||||||
(ert-deftest etaf-performance-panel-has-operation-and-stage-entries ()
|
(ert-deftest etaf-performance-groups-flat-reports-in-sequence-order ()
|
||||||
"The tabulated panel expands one operation into its stage rows."
|
"One ETAF final report retains one ordered, categorized operation."
|
||||||
(etaf-performance-test--isolated
|
(etaf-performance-test--isolated
|
||||||
(etaf-performance-mode 1)
|
(etaf-performance-test--with-runtime (runtime buffer-name)
|
||||||
(etaf-performance--call-operation
|
(etaf-performance-start runtime)
|
||||||
(lambda ()
|
(should
|
||||||
(etaf-performance--call-stage
|
(equal
|
||||||
(lambda () 'ok) 'panel-stage 'panel 'detail nil))
|
'result
|
||||||
'panel-operation 'test nil)
|
(etaf-performance-call-operation
|
||||||
(let ((entries (etaf-performance--tabulated-entries)))
|
runtime 'command "flat fixture"
|
||||||
(should (= 2 (length entries)))
|
(lambda ()
|
||||||
(should (equal "operation" (aref (cadr (car entries)) 4)))
|
(etaf-observer-emit
|
||||||
(should (equal "stage" (aref (cadr (cadr entries)) 2))))
|
'(:provider data :stage load :duration-ms 2.0 :rows 4))
|
||||||
(with-temp-buffer
|
(etaf-observer-emit
|
||||||
(etaf-performance-panel-mode)
|
'(:provider ebox :stage commit :duration-ms 3.0 :patches 2))
|
||||||
(tabulated-list-print t)
|
'result))))
|
||||||
(should (string-match-p "panel-operation" (buffer-string)))
|
(let* ((records (etaf-performance-records))
|
||||||
(should (string-match-p "panel-stage" (buffer-string))))))
|
(operation (car records))
|
||||||
|
(stages (etaf-performance-operation-stages operation)))
|
||||||
|
(should (= 1 (length records)))
|
||||||
|
(should (eq 'command (etaf-performance-operation-kind operation)))
|
||||||
|
(should (equal "flat fixture"
|
||||||
|
(etaf-performance-operation-label operation)))
|
||||||
|
(should (equal '(1 2 3)
|
||||||
|
(mapcar #'etaf-performance-stage-sequence stages)))
|
||||||
|
(should (equal '(data ebox etaf)
|
||||||
|
(mapcar #'etaf-performance-stage-provider stages)))
|
||||||
|
(should (equal '(data ebox runtime)
|
||||||
|
(mapcar #'etaf-performance-stage-category stages)))
|
||||||
|
(should (eq 'runtime-operation
|
||||||
|
(etaf-performance-stage-name (car (last stages)))))
|
||||||
|
(should (= 4 (plist-get
|
||||||
|
(etaf-performance-stage-metadata (car stages))
|
||||||
|
:rows)))))))
|
||||||
|
|
||||||
(ert-deftest etaf-performance-report-is-portable-and-copyable ()
|
(ert-deftest etaf-performance-operation-wrapper-preserves-errors ()
|
||||||
"The shareable report contains environment, operation, and stage data."
|
"The public wrapper delegates result, timing, and failure to Runtime."
|
||||||
(etaf-performance-test--isolated
|
(etaf-performance-test--isolated
|
||||||
(etaf-performance-mode 1)
|
(etaf-performance-test--with-runtime (runtime buffer-name)
|
||||||
(etaf-performance-call-operation
|
(etaf-performance-start runtime)
|
||||||
'report "copy fixture"
|
(let ((condition
|
||||||
(lambda ()
|
(condition-case data
|
||||||
(etaf-performance--call-stage
|
(etaf-performance-with-operation
|
||||||
(lambda () 'ok) 'report-stage 'fixture 'work nil)))
|
(runtime 'command "failure")
|
||||||
(let* ((data (etaf-performance-report-data))
|
(signal 'args-out-of-range '(source 1 2)))
|
||||||
(operations (plist-get data :operations))
|
(args-out-of-range data))))
|
||||||
(operation (car operations))
|
(should (equal condition '(args-out-of-range source 1 2))))
|
||||||
(stage (car (plist-get operation :stages)))
|
(let ((operation (car (etaf-performance-records))))
|
||||||
(kill-ring nil)
|
(should (eq 'error (etaf-performance-operation-status operation)))
|
||||||
(kill-ring-yank-pointer nil)
|
(should (eq 'error
|
||||||
(report (etaf-performance-copy-report)))
|
(etaf-performance-stage-status
|
||||||
(should (= etaf-performance-report-format-version
|
(car (last
|
||||||
(plist-get data :format-version)))
|
(etaf-performance-operation-stages operation))))))))))
|
||||||
(should (equal emacs-version
|
|
||||||
(plist-get (plist-get data :environment)
|
(ert-deftest etaf-performance-record-ring-is-bounded ()
|
||||||
:emacs-version)))
|
"Retain only the configured number of newest operations."
|
||||||
(should (equal "copy fixture" (plist-get operation :label)))
|
(etaf-performance-test--isolated
|
||||||
(should (eq 'report-stage (plist-get stage :function)))
|
(let ((etaf-performance-max-records 2))
|
||||||
(should (equal report (current-kill 0 t)))
|
(etaf-performance-test--with-runtime (runtime buffer-name)
|
||||||
(should (string-match-p "ETAF performance report" report)))))
|
(etaf-performance-start runtime)
|
||||||
|
(dotimes (index 4)
|
||||||
|
(etaf-performance-call-operation
|
||||||
|
runtime 'bounded (format "operation %d" index) #'ignore))
|
||||||
|
(let ((records (etaf-performance-records)))
|
||||||
|
(should (= 2 (length records)))
|
||||||
|
(should (> (etaf-performance-operation-id (car records))
|
||||||
|
(etaf-performance-operation-id (cadr records)))))))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-performance-summary-uses-flat-duration ()
|
||||||
|
"Summaries expose percentiles and overlapping provider durations honestly."
|
||||||
|
(etaf-performance-test--isolated
|
||||||
|
(etaf-performance-test--with-runtime (runtime buffer-name)
|
||||||
|
(etaf-performance-start runtime)
|
||||||
|
(dotimes (_ 3)
|
||||||
|
(etaf-performance-call-operation
|
||||||
|
runtime 'summary "fixture"
|
||||||
|
(lambda ()
|
||||||
|
(etaf-observer-emit
|
||||||
|
'(:provider tp :stage publish :duration-ms 2.5)))))
|
||||||
|
(let* ((operation (car (etaf-performance-records)))
|
||||||
|
(summary (car (etaf-performance-summary)))
|
||||||
|
(stage-summary
|
||||||
|
(etaf-performance-operation-stage-summary operation))
|
||||||
|
(tp-summary
|
||||||
|
(cl-find 'tp stage-summary :key
|
||||||
|
(lambda (entry) (plist-get entry :category)))))
|
||||||
|
(should (= 3 (plist-get summary :count)))
|
||||||
|
(should (<= (plist-get summary :min-ms)
|
||||||
|
(plist-get summary :p50-ms)
|
||||||
|
(plist-get summary :p95-ms)
|
||||||
|
(plist-get summary :max-ms)))
|
||||||
|
(should (= 1 (plist-get tp-summary :count)))
|
||||||
|
(should (= 2.5 (plist-get tp-summary :duration-ms)))
|
||||||
|
(should-not (plist-member tp-summary :exclusive-ms))))))
|
||||||
|
|
||||||
|
(ert-deftest etaf-performance-report-panel-copy-and-export-remain-usable ()
|
||||||
|
"Portable reports, the panel, copy, and export consume flat records."
|
||||||
|
(etaf-performance-test--isolated
|
||||||
|
(etaf-performance-test--with-runtime (runtime buffer-name)
|
||||||
|
(etaf-performance-start runtime)
|
||||||
|
(etaf-performance-call-operation
|
||||||
|
runtime 'report "portable fixture"
|
||||||
|
(lambda ()
|
||||||
|
(etaf-observer-emit
|
||||||
|
'(:provider tp :stage publish :duration-ms 1.25))))
|
||||||
|
(let* ((data (etaf-performance-report-data))
|
||||||
|
(operation (car (plist-get data :operations)))
|
||||||
|
(stage (car (plist-get operation :stages)))
|
||||||
|
(kill-ring nil)
|
||||||
|
(kill-ring-yank-pointer nil)
|
||||||
|
(copied (etaf-performance-copy-report))
|
||||||
|
(file (make-temp-file "etaf-performance-" nil ".eld")))
|
||||||
|
(unwind-protect
|
||||||
|
(progn
|
||||||
|
(delete-file file)
|
||||||
|
(should (= 2 (plist-get data :format-version)))
|
||||||
|
(should (equal "portable fixture"
|
||||||
|
(plist-get operation :label)))
|
||||||
|
(should (eq 'tp (plist-get stage :provider)))
|
||||||
|
(should (equal copied (current-kill 0 t)))
|
||||||
|
(should (equal file (etaf-performance-export file)))
|
||||||
|
(with-temp-buffer
|
||||||
|
(insert-file-contents file)
|
||||||
|
(should (string-match-p "portable fixture"
|
||||||
|
(buffer-string)))))
|
||||||
|
(when (file-exists-p file)
|
||||||
|
(delete-file file))))
|
||||||
|
(let ((entries (etaf-performance--tabulated-entries)))
|
||||||
|
(should (= 3 (length entries))))
|
||||||
|
(with-temp-buffer
|
||||||
|
(etaf-performance-panel-mode)
|
||||||
|
(tabulated-list-print t)
|
||||||
|
(should (string-match-p "portable fixture" (buffer-string)))
|
||||||
|
(should (string-match-p "publish" (buffer-string)))))))
|
||||||
|
|
||||||
(ert-deftest etaf-performance-environment-normalizes-darwin-power-state ()
|
(ert-deftest etaf-performance-environment-normalizes-darwin-power-state ()
|
||||||
"Reports distinguish AC, battery low-power, and unknown power states."
|
"Reports distinguish AC, battery low-power, and unknown power states."
|
||||||
(should
|
(should
|
||||||
(equal
|
(equal '(:source battery :low-power-mode on)
|
||||||
'(:source battery :low-power-mode on)
|
(etaf-performance--parse-darwin-power-state
|
||||||
(etaf-performance--parse-darwin-power-state
|
"Now drawing from 'Battery Power'\n"
|
||||||
"Now drawing from 'Battery Power'\n"
|
"Battery Power:\n lowpowermode 1\nAC Power:\n lowpowermode 0\n")))
|
||||||
"Battery Power:\n lowpowermode 1\nAC Power:\n lowpowermode 0\n")))
|
|
||||||
(should
|
(should
|
||||||
(equal
|
(equal '(:source ac :low-power-mode off)
|
||||||
'(:source ac :low-power-mode off)
|
(etaf-performance--parse-darwin-power-state
|
||||||
(etaf-performance--parse-darwin-power-state
|
"Now drawing from 'AC Power'\n"
|
||||||
"Now drawing from 'AC Power'\n"
|
"Battery Power:\n lowpowermode 1\nAC Power:\n lowpowermode 0\n")))
|
||||||
"Battery Power:\n lowpowermode 1\nAC Power:\n lowpowermode 0\n")))
|
|
||||||
(should
|
(should
|
||||||
(equal
|
(equal '(:source unknown :low-power-mode unknown)
|
||||||
'(:source unknown :low-power-mode unknown)
|
(etaf-performance--parse-darwin-power-state "" ""))))
|
||||||
(etaf-performance--parse-darwin-power-state "" ""))))
|
|
||||||
|
|
||||||
(ert-deftest etaf-performance-panel-exposes-power-and-load-context ()
|
(ert-deftest etaf-performance-environment-reports-native-jit-state ()
|
||||||
"The visible panel explains system-wide latency shifts."
|
"Expose background JIT state beside absolute latency records."
|
||||||
(let ((line
|
(let ((native-comp-jit-compilation t))
|
||||||
(etaf-performance--panel-environment-line
|
(should (eq t (plist-get (etaf-performance-environment-data)
|
||||||
'(:emacs-version "31.1"
|
:native-comp-jit-compilation))))
|
||||||
:power-state (:source battery :low-power-mode on)
|
(let ((native-comp-jit-compilation nil))
|
||||||
:load-average (2.5 2.0 1.5)))))
|
(should-not (plist-get (etaf-performance-environment-data)
|
||||||
(should (string-match-p "Emacs 31.1" line))
|
:native-comp-jit-compilation))))
|
||||||
(should (string-match-p "power battery/low:on" line))
|
|
||||||
(should (string-match-p "load 2.50" line))))
|
|
||||||
|
|
||||||
(ert-deftest etaf-performance-export-writes-readable-report ()
|
(ert-deftest etaf-performance-source-has-no-advice-or-private-provider-registry ()
|
||||||
"The interactive export payload is a readable plain-data report."
|
"Recorder source depends only on the public Runtime observation boundary."
|
||||||
(etaf-performance-test--isolated
|
(let ((source
|
||||||
(etaf-performance-mode 1)
|
(with-temp-buffer
|
||||||
(etaf-performance-call-operation 'export "file fixture" #'ignore)
|
(insert-file-contents
|
||||||
(let ((file (concat (make-temp-name
|
(expand-file-name
|
||||||
(expand-file-name "etaf-performance-test-"
|
"etaf-performance.el"
|
||||||
temporary-file-directory))
|
(file-name-directory (locate-library "etaf-performance"))))
|
||||||
".eld")))
|
(buffer-string))))
|
||||||
(unwind-protect
|
(dolist (pattern '("advice-add" "advice-remove" "after-load-functions"
|
||||||
(progn
|
"operation-functions" "stage-functions"
|
||||||
(should (equal file (etaf-performance-export file)))
|
"etaf-runtime-mount-epoch"
|
||||||
(with-temp-buffer
|
"etaf-runtime-observer runtime"
|
||||||
(insert-file-contents file)
|
"etaf-runtime-mounted-p"
|
||||||
(should (string-match-p "ETAF performance report"
|
"ebox--" "tp--" "etaf-sqlite--"))
|
||||||
(buffer-string)))
|
(should-not (string-match-p (regexp-quote pattern) source)))))
|
||||||
(should (string-match-p "file fixture" (buffer-string)))))
|
|
||||||
(when (file-exists-p file)
|
|
||||||
(delete-file file))))))
|
|
||||||
|
|
||||||
(ert-deftest etaf-performance-captures-public-ebox-report-metadata ()
|
|
||||||
"Attach compact public Ebox report facts to the active operation."
|
|
||||||
(etaf-performance-test--isolated
|
|
||||||
(etaf-performance-mode 1)
|
|
||||||
(etaf-performance--call-operation
|
|
||||||
(lambda ()
|
|
||||||
(etaf-performance--call-stage
|
|
||||||
(lambda ()
|
|
||||||
'(:strategy mixed-owner-reflow
|
|
||||||
:projection-kind mixed-owner-reflow
|
|
||||||
:dirty-count 8 :owner-ids (1 2 3) :patch-count 3
|
|
||||||
:tp-scope-count 3 :tp-text-operations 12
|
|
||||||
:tp-property-operations 111 :tp-full-root nil
|
|
||||||
:tp-scope-fallback nil))
|
|
||||||
'ebox-commit 'ebox 'commit nil))
|
|
||||||
'report-operation 'test nil)
|
|
||||||
(let* ((operation (car (etaf-performance-records)))
|
|
||||||
(report (plist-get
|
|
||||||
(etaf-performance-operation-metadata operation) :ebox)))
|
|
||||||
(should (eq 'mixed-owner-reflow (plist-get report :strategy)))
|
|
||||||
(should (= 3 (plist-get report :owner-count)))
|
|
||||||
(should (= 111 (plist-get report :tp-property-operations)))
|
|
||||||
(should (string-match-p "mixed-owner-reflow"
|
|
||||||
(etaf-performance--format-report operation))))))
|
|
||||||
|
|
||||||
(ert-deftest etaf-performance-mode-uninstalls-all-advices ()
|
|
||||||
"Disabling recording removes operation, stage, and after-load hooks."
|
|
||||||
(etaf-performance-test--isolated
|
|
||||||
(etaf-performance-mode 1)
|
|
||||||
(let ((installed (copy-sequence etaf-performance--installed-advices)))
|
|
||||||
(should installed)
|
|
||||||
(dolist (entry installed)
|
|
||||||
(should (advice-member-p (cdr entry) (car entry))))
|
|
||||||
(etaf-performance-mode -1)
|
|
||||||
(should-not etaf-performance--installed-advices)
|
|
||||||
(should-not (memq #'etaf-performance--install-loaded-advices
|
|
||||||
after-load-functions))
|
|
||||||
(dolist (entry installed)
|
|
||||||
(should-not (advice-member-p (cdr entry) (car entry)))))))
|
|
||||||
|
|
||||||
(provide 'etaf-performance-tests)
|
(provide 'etaf-performance-tests)
|
||||||
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user