geekinney/etaf
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

refactor: require SPI v2 for runtime mounts and Host attachment

Browse Source
This commit is contained in:
Kinneyzhang 2026-09-05 05:25:29 +08:00
parent 01b1deb178
commit b5f314edff
16 changed files with 291 additions and 643 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
Makefile
View File

@ -4,7 +4,7 @@ SOURCES = etaf-view.el etaf-compiler.el etaf-component.el etaf-scheduler.el etaf
EXAMPLES = examples/etaf-counter-example.el examples/etaf-data-example.el examples/etaf-resource-example.el EXAMPLES = examples/etaf-counter-example.el examples/etaf-data-example.el examples/etaf-resource-example.el
TESTS = tests/etaf-tests.el tests/etaf-compiler-tests.el tests/etaf-component-frontends-tests.el tests/etaf-resource-tests.el tests/etaf-data-tests.el tests/etaf-theme-tp-tests.el tests/etaf-examples-tests.el tests/etaf-observer-tests.el tests/etaf-performance-tests.el tests/etaf-gui-verifier-tests.el tests/etaf-m0a-current-characterization-tests.el tests/etaf-interaction-contract-tests.el tests/etaf-m0b-component-manifest-tests.el tests/etaf-render-port-tests.el tests/etaf-generation-tests.el tests/etaf-host-tests.el tests/etaf-retirement-tests.el tests/etaf-scheduler-tests.el tests/etaf-g1-cross-layer-tests.el TESTS = tests/etaf-tests.el tests/etaf-compiler-tests.el tests/etaf-component-frontends-tests.el tests/etaf-resource-tests.el tests/etaf-data-tests.el tests/etaf-theme-tp-tests.el tests/etaf-examples-tests.el tests/etaf-observer-tests.el tests/etaf-performance-tests.el tests/etaf-gui-verifier-tests.el tests/etaf-m0a-current-characterization-tests.el tests/etaf-interaction-contract-tests.el tests/etaf-m0b-component-manifest-tests.el tests/etaf-render-port-tests.el tests/etaf-generation-tests.el tests/etaf-host-tests.el tests/etaf-retirement-tests.el tests/etaf-scheduler-tests.el tests/etaf-g1-cross-layer-tests.el
.PHONY: test compile load checkdoc docs-check scheduler-benchmark check clean .PHONY: test compile load checkdoc docs-check metadata-check scheduler-benchmark check clean
test: compile test: compile
$(EMACS) -Q --batch $(LOAD_PATH) --eval "(setq load-prefer-newer t)" \ $(EMACS) -Q --batch $(LOAD_PATH) --eval "(setq load-prefer-newer t)" \
@ -24,6 +24,9 @@ docs-check:
$(EMACS) -Q --batch $(LOAD_PATH) --eval "(setq load-prefer-newer t)" -l tests/etaf-docs-tests.el \ $(EMACS) -Q --batch $(LOAD_PATH) --eval "(setq load-prefer-newer t)" -l tests/etaf-docs-tests.el \
-f ert-run-tests-batch-and-exit -f ert-run-tests-batch-and-exit
metadata-check:
$(EMACS) -Q --batch --eval "(progn (require 'package) (with-temp-buffer (insert-file-contents \"etaf.el\") (let ((desc (package-buffer-info))) (unless (and (equal (package-desc-version desc) '(0 2 1)) (equal (package-desc-reqs desc) '((emacs (29 1)) (ebox (3 0 0)) (tp (2 0 0))))) (error \"Unexpected ETAF package metadata: %S\" desc)))))"
scheduler-benchmark: scheduler-benchmark:
$(EMACS) -Q --batch $(LOAD_PATH) --eval "(setq load-prefer-newer t)" \ $(EMACS) -Q --batch $(LOAD_PATH) --eval "(setq load-prefer-newer t)" \
-l scripts/benchmark-scheduler-context.el \ -l scripts/benchmark-scheduler-context.el \
@ -32,7 +35,7 @@ scheduler-benchmark:
checkdoc: checkdoc:
$(EMACS) -Q --batch --eval '(progn (require (quote checkdoc)) (dolist (directory (list "." "examples" "scripts")) (dolist (file (directory-files directory t)) (when (string-suffix-p ".el" file) (checkdoc-file file)))))' $(EMACS) -Q --batch --eval '(progn (require (quote checkdoc)) (dolist (directory (list "." "examples" "scripts")) (dolist (file (directory-files directory t)) (when (string-suffix-p ".el" file) (checkdoc-file file)))))'
check: checkdoc compile test docs-check scheduler-benchmark check: checkdoc metadata-check compile test docs-check scheduler-benchmark
clean: clean:
rm -f *.elc examples/*.elc scripts/*.elc tests/*.elc rm -f *.elc examples/*.elc scripts/*.elc tests/*.elc

16
README.md
View File

@ -112,15 +112,15 @@ There is no separate `etaf-data` install: Data is a core ETAF capability. There
## Load and verify ## Load and verify
ECSS 0.1.0 and TP 1.0.1 are independent packages and may be installed in either order. Install both before Ebox 2.0.1, then install ETAF 0.1.1. ETAF declares TP directly because Host final-accept authority uses the TP transaction contract; rendering still consumes only the Ebox 2.0 public contract. Install ECSS 0.1.0 and TP 2.0.0 before Ebox 3.0.0, then install ETAF 0.2.1.
ETAF declares TP directly because Host final-accept authority uses the TP
transaction contract. Rendering requires Ebox framework SPI v2; a missing,
malformed, or incompatible provider fails during ETAF bootstrap.
ETAF selects the Ebox framework SPI v2 port by default. For an immediate ETAF snapshots one immutable v2 render port for the Emacs process. During an
process-wide rollback to the complete legacy render/Host port, set ordered upgrade it also accepts Ebox's transitional dual-capability TP manifest
`etaf-render-port-selection-policy` to `v1` before loading ETAF. The selection because that manifest contains the required v2 protocol. ETAF never dispatches
is immutable for that Emacs process; restart Emacs to change it. This rollback through the retired v1 capability.
does not create a second generation owner: semantic CAS, projected compatibility
stores, retirement, and scheduler authority stay unified, preserving the same
generation, token, and store-version outcomes on both render ports.
During development, load the sibling Ebox checkout before ETAF: During development, load the sibling Ebox checkout before ETAF:

14
README.zh-CN.md
View File

@ -106,14 +106,14 @@ operation 的 flat 阶段。`etaf-performance-records` 返回 operation/stage
## 加载与验证 ## 加载与验证
ECSS 0.1.0 与 TP 1.0.1 是互相独立的包，安装顺序任意；两者都安装后再安装 Ebox 2.0.1，最后安装 ETAF 0.1.1。ETAF 会直接声明 TP 依赖，因为 Host final-accept authority 使用 TP transaction contract；渲染仍只使用 Ebox 2.0 的公共契约。 先安装 ECSS 0.1.0 与 TP 2.0.0，再安装 Ebox 3.0.0，最后安装 ETAF 0.2.1。
ETAF 会直接声明 TP 依赖，因为 Host final-accept authority 使用 TP transaction
contract。渲染要求 Ebox framework SPI v2；provider 缺失、格式错误或不兼容时，
ETAF 会在 bootstrap 阶段 fail closed。
ETAF 默认选择 Ebox framework SPI v2 port。若要立即按进程完整回退旧 ETAF 为当前 Emacs 进程 snapshot 一个不可变的 v2 render port。按依赖顺序升级时，
render/Host port，必须在加载 ETAF 前把 也接受 Ebox 过渡期的 TP 双能力 manifest，因为其中包含所需的 v2 协议；ETAF
`etaf-render-port-selection-policy` 设为 `v1`。该选择在当前 Emacs 进程中不可 不会调用已经退役的 v1 capability。
变；切换时需要重启 Emacs。这个回退不会创建第二个 generation owner：semantic
CAS、单向投影的兼容 stores、retirement 和 scheduler authority 仍保持统一，因此
两个 render port 的 generation、token 与 store-version outcome 完全一致。
开发时先把同级 Ebox 检出目录加入 `load-path`： 开发时先把同级 Ebox 检出目录加入 `load-path`：

14
docs/architecture.en.md
View File

@ -458,14 +458,12 @@ back into it. The migration-only `legacy`, `project`, and `shadow` routes prove
projection equivalence and rollback safety without introducing a second projection equivalence and rollback safety without introducing a second
committed truth. committed truth.
At process bootstrap, `etaf-render-port-selection-policy` selects exactly one At process bootstrap, `etaf-render-port` requires Ebox framework SPI v2 and
immutable Ebox port. Its default `v2` value uses the compatible framework SPI; snapshots exactly one immutable port. A missing, malformed, or incompatible
`v1`, when set before ETAF is loaded, bypasses provider probing and selects the provider fails closed before any Runtime is mounted. The ordered dependency
complete legacy render/Host port. The rollback changes only that inter-package upgrade may expose either a transitional TP v1+v2 manifest or the final v2-only
publication route. Generation/store CAS, compatibility projection, retirement, manifest; both prove the required v2 capability, and ETAF never calls a v1
and scheduler authority remain single-owner so the old and new render ports operation. A mounted or in-flight Runtime never switches ports.
produce identical generation, token, and store-version outcomes. A mounted or
in-flight Runtime is never switched between ports.
Each semantic candidate captures the expected generation, semantic token, and Each semantic candidate captures the expected generation, semantic token, and
instance/resource/artifact/route store versions. The render path stages one CAS instance/resource/artifact/route store versions. The render path stages one CAS

11
docs/architecture.zh.md
View File

@ -447,12 +447,11 @@ generation；Runtime 中同名 hash table 只是由 generation 单向重建的
`legacy`/`project`/`shadow` 路由只用于证明投影等价与安全回退，不增加第二份 `legacy`/`project`/`shadow` 路由只用于证明投影等价与安全回退，不增加第二份
committed truth。 committed truth。
进程 bootstrap 时，`etaf-render-port-selection-policy` 只选择一个不可变的 Ebox 进程 bootstrap 时，`etaf-render-port` 要求 Ebox framework SPI v2，并 snapshot
port。默认值 `v2` 使用兼容的 framework SPI；若在 ETAF 加载前设为 `v1`，则跳过 唯一的不可变 port。provider 缺失、格式错误或不兼容都会在 Runtime mount 前 fail
provider 探测并选择完整的旧 render/Host port。这个回退只改变跨包 publication closed。按依赖顺序升级时，Ebox 可暂时报告 TP v1+v2 双能力 manifest，也可报告最终
route；generation/store CAS、兼容投影、retirement 与 scheduler authority 始终只有 的 v2-only manifest；两者都证明所需的 v2 capability，ETAF 不会调用 v1 operation。
一个 owner，因此新旧 render port 会产生完全一致的 generation、token 与 mounted 或 in-flight Runtime 绝不会切换 port。
store-version outcome。mounted 或 in-flight Runtime 绝不会在两个 port 之间切换。
每个 semantic candidate 同时捕获 expected generation、semantic token，以及 每个 semantic candidate 同时捕获 expected generation、semantic token，以及
instance/resource/artifact/route store versions。render 路径在 Ebox framework instance/resource/artifact/route store versions。render 路径在 Ebox framework

16
docs/migration-0.2.en.md Normal file
View File

@ -0,0 +1,16 @@
# Migrating to ETAF 0.2
ETAF 0.2.1 requires Ebox 3.0.0 and TP 2.0.0. Install TP, then Ebox, then ETAF.
The renderer bootstrap now requires Ebox framework SPI v2 and fails closed when
the provider is absent, malformed, or incompatible.
Remove any configuration of `etaf-render-port-selection-policy`. The v1 render
port and its manual initial-publication cleanup path have been retired. Runtime
mounts and updates always use the immutable SPI v2 port, including its paired
framework stage and rollback, same-object report, observation replay, revision,
and Host final-marker contracts.
During an ordered source upgrade, ETAF accepts Ebox providers that report either
`tp-transaction-protocol-v1+v2` or `tp-transaction-protocol-v2`. The former is a
temporary capability declaration that still contains the required v2 protocol;
ETAF never invokes a v1 transaction operation.

14
docs/migration-0.2.zh.md Normal file
View File

@ -0,0 +1,14 @@
# 迁移到 ETAF 0.2
ETAF 0.2.1 要求 Ebox 3.0.0 与 TP 2.0.0。安装顺序为 TP、Ebox、ETAF。
renderer bootstrap 现在强制要求 Ebox framework SPI v2；provider 缺失、格式错误
或不兼容时会 fail closed。
请删除所有 `etaf-render-port-selection-policy` 配置。v1 render port 及其 initial
publication 手工清理路径已经退役。Runtime mount 与 update 始终使用不可变的 SPI
v2 port，并保留配对 framework stage/rollback、同对象 report、observation replay、
revision 与 Host final marker 契约。
按依赖顺序从源码升级时，ETAF 接受 Ebox 报告
`tp-transaction-protocol-v1+v2` 或 `tp-transaction-protocol-v2`。前者只是包含所需
v2 协议的过渡期能力声明；ETAF 不会调用 v1 transaction operation。

56
etaf-host.el
View File

@ -5,7 +5,7 @@
;;; Commentary: ;;; Commentary:
;; Owns one mounted Runtime's fixed Host authority token and state machine. ;; Owns one mounted Runtime's fixed Host authority token and state machine.
;; Initial v2 attachment registers a bounded TP final marker so attached ;; Initial attachment registers a bounded TP final marker so attached
;; authority and buffer publication share one final-accept boundary. Detach ;; authority and buffer publication share one final-accept boundary. Detach
;; invalidates authority in O(1) before any unbounded retirement work. ;; invalidates authority in O(1) before any unbounded retirement work.
@ -83,10 +83,8 @@
:index index :index index
:value value)) :value value))
(defun etaf-host-authority-stage-attach (authority &optional legacy-p) (defun etaf-host-authority-stage-attach (authority)
"Stage AUTHORITY attachment and register its final marker. "Stage AUTHORITY attachment and register its final marker."
When LEGACY-P is non-nil, publish attached state directly after the legacy Ebox
initial operation and rely on manual framework rollback."
(unless (eq (etaf-host-authority-state authority) 'attaching) (unless (eq (etaf-host-authority-state authority) 'attaching)
(signal 'etaf-host-authority-error (signal 'etaf-host-authority-error
(list :stage-attach (etaf-host-authority-state authority)))) (list :stage-attach (etaf-host-authority-state authority))))
@ -94,32 +92,28 @@ initial operation and rely on manual framework rollback."
(token (etaf-host-authority-token authority)) (token (etaf-host-authority-token authority))
(version (etaf-host-authority-version authority))) (version (etaf-host-authority-version authority)))
(aset slots etaf-host--state-slot 'provisionally-attached) (aset slots etaf-host--state-slot 'provisionally-attached)
(if legacy-p (tp-transaction-register-final-marker
(let ((inhibit-quit t)) :owner-key
(aset slots etaf-host--state-slot 'attached) (list 'etaf-host
(aset slots etaf-host--version-slot (1+ version))) (etaf-host-authority-host-id authority)
(tp-transaction-register-final-marker (etaf-host-authority-mount-epoch authority))
:owner-key :expected-token
(list 'etaf-host (tp-final-marker-expectation-create
(etaf-host-authority-host-id authority) :target slots :index etaf-host--token-slot :value token)
(etaf-host-authority-mount-epoch authority)) :expected-version
:expected-token (tp-final-marker-expectation-create
(tp-final-marker-expectation-create :target slots :index etaf-host--version-slot :value version)
:target slots :index etaf-host--token-slot :value token) :next-values
:expected-version (vector
(tp-final-marker-expectation-create (etaf-host--slot-write authority etaf-host--state-slot 'attached)
:target slots :index etaf-host--version-slot :value version) (etaf-host--slot-write authority etaf-host--version-slot (1+ version)))
:next-values :inverse-values
(vector (vector
(etaf-host--slot-write authority etaf-host--state-slot 'attached) (etaf-host--slot-write
(etaf-host--slot-write authority etaf-host--version-slot (1+ version))) authority etaf-host--state-slot 'provisionally-attached)
:inverse-values (etaf-host--slot-write authority etaf-host--version-slot version))
(vector :slot-write-count 2
(etaf-host--slot-write :operation-key 'tp-vector-slots/v1)
authority etaf-host--state-slot 'provisionally-attached)
(etaf-host--slot-write authority etaf-host--version-slot version))
:slot-write-count 2
:operation-key 'tp-vector-slots/v1))
authority)) authority))
(defun etaf-host-authority-rollback-attach (authority) (defun etaf-host-authority-rollback-attach (authority)

392
etaf-render-port.el
View File

@ -4,11 +4,9 @@
;;; Commentary: ;;; Commentary:
;; This file is ETAF's only Ebox framework-SPI bootstrap owner. It probes the ;; This file is ETAF's only Ebox framework-SPI bootstrap owner. It requires
;; Ebox v2 provider once, selects one immutable port, and exposes that ;; one compatible Ebox v2 provider, snapshots it once, and exposes one immutable
;; selection to downstream ETAF code without repeated `featurep' or `fboundp' ;; port to downstream ETAF code without repeated protocol guesses.
;; protocol guesses. A completely absent v2 provider receives a complete v1
;; fallback; a present but broken or incompatible provider fails closed.
;;; Code: ;;; Code:
@ -22,17 +20,6 @@
"Incompatible Ebox framework SPI provider" "Incompatible Ebox framework SPI provider"
'etaf-spi-bootstrap-error) 'etaf-spi-bootstrap-error)
(defcustom etaf-render-port-selection-policy 'v2
"ETAF render authority selected during process bootstrap.
`v2' selects the compatible Ebox SPI v2 port. `v1' is the complete legacy
render/Host rollback switch and bypasses provider probing. Generation stores,
retirement, and scheduler keep their unified authority so v1 and v2 preserve
the same generation/token/store-version outcomes. Set this before loading
ETAF; the selected port is process-wide and immutable."
:type '(choice (const :tag "ETAF v2 authorities" v2)
(const :tag "Complete ETAF v1 route" v1))
:group 'etaf)
(defconst etaf-render-port--required-spi-version 2 (defconst etaf-render-port--required-spi-version 2
"Ebox framework SPI version consumed by this ETAF build.") "Ebox framework SPI version consumed by this ETAF build.")
@ -48,9 +35,11 @@ ETAF; the selected port is process-wide and immutable."
initial-observation-replay) initial-observation-replay)
"Capabilities required from an Ebox framework SPI v2 provider.") "Capabilities required from an Ebox framework SPI v2 provider.")
(defconst etaf-render-port--required-tp-protocol (defconst etaf-render-port--accepted-tp-protocols
'tp-transaction-protocol-v1+v2 '(tp-transaction-protocol-v1+v2 tp-transaction-protocol-v2)
"TP transaction protocol required by the Ebox framework SPI.") "TP protocols accepted from an Ebox SPI v2 provider.
The dual-capability manifest is accepted during dependency-order migration
because it contains v2; ETAF never dispatches through its v1 capability.")
(defconst etaf-render-port--required-stage-order (defconst etaf-render-port--required-stage-order
'(ebox-mirror/native framework-stage) '(ebox-mirror/native framework-stage)
@ -77,7 +66,7 @@ ETAF; the selected port is process-wide and immutable."
(provider nil :read-only t)) (provider nil :read-only t))
(defun etaf-render-port-route (port) (defun etaf-render-port-route (port)
"Return selected PORT route, either `v1' or `v2'." "Return selected PORT route, always `v2'."
(etaf-render-port--route port)) (etaf-render-port--route port))
(defun etaf-render-port-spi-version (port) (defun etaf-render-port-spi-version (port)
@ -232,8 +221,8 @@ ETAF; the selected port is process-wide and immutable."
(dolist (capability etaf-render-port--required-capabilities) (dolist (capability etaf-render-port--required-capabilities)
(unless (memq capability capabilities) (unless (memq capability capabilities)
(push (list :missing-capability capability) failures)))) (push (list :missing-capability capability) failures))))
(unless (eq (plist-get snapshot :tp-protocol) (unless (memq (plist-get snapshot :tp-protocol)
etaf-render-port--required-tp-protocol) etaf-render-port--accepted-tp-protocols)
(push (list :tp-protocol (plist-get snapshot :tp-protocol)) failures)) (push (list :tp-protocol (plist-get snapshot :tp-protocol)) failures))
(unless (equal (plist-get snapshot :stage-order) (unless (equal (plist-get snapshot :stage-order)
etaf-render-port--required-stage-order) etaf-render-port--required-stage-order)
@ -266,292 +255,6 @@ ETAF; the selected port is process-wide and immutable."
(push (list slot operation) failures)))) (push (list slot operation) failures))))
(nreverse failures))) (nreverse failures)))
(defun etaf-render-port--validate-framework-pair
(framework-stage framework-rollback)
"Validate FRAMEWORK-STAGE and FRAMEWORK-ROLLBACK as one required pair."
(unless (functionp framework-stage)
(signal 'wrong-type-argument (list 'functionp framework-stage)))
(unless (functionp framework-rollback)
(signal 'wrong-type-argument (list 'functionp framework-rollback)))
t)
(defvar-local etaf-render-port--v1-cleanup-diagnostics nil
"Contained cleanup failures from the latest failed v1 initial operation.")
(defvar-local etaf-render-port--v1-committed-revision nil
"ETAF-owned revision evidence for a mounted legacy Ebox v1 surface.")
(defun etaf-render-port-v1-cleanup-diagnostics (buffer)
"Return a defensive copy of BUFFER's latest v1 cleanup diagnostics."
(and (buffer-live-p (get-buffer buffer))
(with-current-buffer (get-buffer buffer)
(copy-tree etaf-render-port--v1-cleanup-diagnostics))))
(defun etaf-render-port--v1-buffer-snapshot (buffer)
"Return BUFFER content and editor state needed by v1 manual cleanup."
(with-current-buffer buffer
(let ((narrowed-p (buffer-narrowed-p))
(start (point-min))
(end (point-max)))
(save-restriction
(widen)
(list :contents (buffer-substring (point-min) (point-max))
:point (point)
:mark-marker (mark-marker)
:mark-position (mark t)
:mark-insertion-type
(marker-insertion-type (mark-marker))
:mark-active mark-active
:narrowed-p narrowed-p
:narrow-start start
:narrow-end end
:read-only buffer-read-only
:modified-p (buffer-modified-p)
:undo-list buffer-undo-list
:overlays
(mapcar
(lambda (overlay)
(list :overlay overlay
:start (overlay-start overlay)
:end (overlay-end overlay)))
(delete-dups
(append (car (overlay-lists)) (cdr (overlay-lists))))))))))
(defun etaf-render-port--v1-restore-buffer
(buffer snapshot &optional restore-contents-p)
"Restore BUFFER editor state from a pre-render v1 SNAPSHOT.
When RESTORE-CONTENTS-P is non-nil, also re-materialize text as a last-resort
fallback after change-group cancellation itself failed."
(unless (buffer-live-p buffer)
(error "Legacy Ebox target died during manual cleanup"))
(with-current-buffer buffer
(let ((inhibit-read-only t)
(inhibit-modification-hooks t))
(widen)
(when restore-contents-p
(let ((buffer-undo-list t))
(erase-buffer)
(insert (plist-get snapshot :contents))))
(let* ((saved-overlays (plist-get snapshot :overlays))
(saved-identities
(mapcar (lambda (entry) (plist-get entry :overlay))
saved-overlays)))
(dolist
(overlay
(delete-dups
(append (car (overlay-lists)) (cdr (overlay-lists)))))
(unless (memq overlay saved-identities)
(delete-overlay overlay)))
(dolist (entry saved-overlays)
(let ((overlay (plist-get entry :overlay)))
(move-overlay overlay
(plist-get entry :start)
(plist-get entry :end)
buffer))))
(when (plist-get snapshot :narrowed-p)
(narrow-to-region
(min (point-max) (plist-get snapshot :narrow-start))
(min (point-max) (plist-get snapshot :narrow-end))))
(goto-char (min (point-max)
(max (point-min) (plist-get snapshot :point))))
(let ((mark-marker (plist-get snapshot :mark-marker)))
(set-marker mark-marker (plist-get snapshot :mark-position) buffer)
(set-marker-insertion-type
mark-marker (plist-get snapshot :mark-insertion-type)))
(setq mark-active (plist-get snapshot :mark-active))
(setq buffer-read-only (plist-get snapshot :read-only))
(set-buffer-modified-p (plist-get snapshot :modified-p))
(setq buffer-undo-list (plist-get snapshot :undo-list))))
buffer)
(defun etaf-render-port--v1-cleanup-failed-initial
(buffer snapshot change-group change-group-active-p stage-entered
observer framework-rollback)
"Clean one failed legacy initial operation and return diagnostics.
BUFFER and SNAPSHOT identify editor custody. CHANGE-GROUP-ACTIVE-P says
whether CHANGE-GROUP still needs cancellation. STAGE-ENTERED controls the
paired FRAMEWORK-ROLLBACK. OBSERVER is detached before Ebox unmount."
(let (cancel-failed-p)
(when (buffer-live-p buffer)
(with-current-buffer buffer
(setq-local etaf-render-port--v1-cleanup-diagnostics nil)))
(cl-labels
((record
(diagnostic)
(when (buffer-live-p buffer)
(with-current-buffer buffer
(setq-local
etaf-render-port--v1-cleanup-diagnostics
(append etaf-render-port--v1-cleanup-diagnostics
(list diagnostic))))))
(run-phase
(entry)
(let ((phase (nth 0 entry))
(function (nth 1 entry))
(failure-function (nth 2 entry))
completed-p)
(unwind-protect
(let ((inhibit-quit t) (quit-flag nil))
(condition-case condition
(progn (funcall function) (setq completed-p t))
((error quit)
(setq completed-p t)
(when failure-function (funcall failure-function))
(record
(list :phase phase
:condition (copy-tree condition))))))
(unless completed-p
(when failure-function (funcall failure-function))
(record (list :phase phase :nonlocal-exit t))))))
(run-phases
(entries)
(when entries
;; A cleanup callback may perform an arbitrary nonlocal exit.
;; Nested unwind cleanup guarantees every later phase still runs.
(unwind-protect
(run-phase (car entries))
(run-phases (cdr entries))))))
(run-phases
`((framework-rollback
,(lambda ()
(when stage-entered
(funcall framework-rollback nil))))
(observer-detach
,(lambda ()
(when (and observer (buffer-live-p buffer)
(ebox-surface-buffer-mounted-p buffer))
(ebox-buffer-set-observer buffer nil))))
(ebox-unmount
,(lambda ()
(when (and (buffer-live-p buffer)
(ebox-surface-buffer-mounted-p buffer))
(ebox-unmount-buffer buffer))))
(revision-reset
,(lambda ()
(when (buffer-live-p buffer)
(with-current-buffer buffer
(setq-local
etaf-render-port--v1-committed-revision nil)))))
(change-group-cancel
,(lambda ()
(when change-group-active-p
(with-current-buffer buffer
(cancel-change-group change-group))))
,(lambda () (setq cancel-failed-p t)))
(buffer-restore
,(lambda ()
(etaf-render-port--v1-restore-buffer
buffer snapshot cancel-failed-p))))))
(and (buffer-live-p buffer)
(etaf-render-port-v1-cleanup-diagnostics buffer))))
(defun etaf-render-port--v1-record-revision (buffer revision)
"Record committed v1 REVISION for BUFFER without postaccept failure."
(when (buffer-live-p buffer)
(with-current-buffer buffer
(setq-local etaf-render-port--v1-committed-revision
(if (and (integerp revision) (> revision 0))
revision
'unavailable)))))
(defun etaf-render-port--v1-revision (buffer)
"Return ETAF's committed revision evidence for legacy v1 BUFFER."
(let ((revision
(and (buffer-live-p buffer)
(buffer-local-value
'etaf-render-port--v1-committed-revision buffer))))
(unless (and (integerp revision) (> revision 0))
(error "Mounted legacy Ebox surface has no committed revision: %S"
revision))
revision))
(defun etaf-render-port--v1-initial
(buffer input framework-stage framework-rollback &optional observer)
"Publish INPUT initially to BUFFER through legacy Ebox.
FRAMEWORK-STAGE runs after publication; FRAMEWORK-ROLLBACK performs contained
manual framework cleanup if staging fails. OBSERVER, when non-nil, is passed
through Ebox's legacy initial option."
(etaf-render-port--validate-framework-pair
framework-stage framework-rollback)
(let* ((buffer (get-buffer-create buffer))
(snapshot (etaf-render-port--v1-buffer-snapshot buffer))
(change-group (with-current-buffer buffer (prepare-change-group)))
result stage-entered operation-started-p change-group-active-p
cleanup-ran-p)
(cl-labels
((cleanup
()
(unless cleanup-ran-p
(setq cleanup-ran-p t)
(when operation-started-p
(let ((active-p change-group-active-p))
(setq change-group-active-p nil)
(etaf-render-port--v1-cleanup-failed-initial
buffer snapshot change-group active-p stage-entered
observer framework-rollback))))))
(unwind-protect
(condition-case primary
(progn
(when (ebox-surface-buffer-mounted-p buffer)
(error
"Legacy Ebox initial operation requires an unmounted buffer"))
(with-current-buffer buffer
(setq-local etaf-render-port--v1-cleanup-diagnostics nil
etaf-render-port--v1-committed-revision nil)
(activate-change-group change-group)
(setq operation-started-p t
change-group-active-p t)
(save-restriction
(widen)
(setq result
(ebox-render-to-buffer
buffer input
(and observer (list :observer observer))))))
(setq stage-entered t)
(funcall framework-stage nil)
(with-current-buffer buffer
(accept-change-group change-group))
(setq change-group-active-p nil)
;; TP surfaces start at committed revision one. Legacy Ebox
;; does not expose its surface handle, so ETAF owns this
;; compatibility evidence and advances it from update reports.
(etaf-render-port--v1-record-revision buffer 1)
result)
((error quit)
(cleanup)
(signal (car primary) (cdr primary))))
(when change-group-active-p
(cleanup))))))
(defun etaf-render-port--v1-update
(buffer input framework-stage framework-rollback)
"Update BUFFER from INPUT through the legacy Ebox callback pair.
FRAMEWORK-STAGE and FRAMEWORK-ROLLBACK retain their existing Ebox meanings."
(etaf-render-port--validate-framework-pair
framework-stage framework-rollback)
(let ((report
(ebox-commit buffer input framework-stage framework-rollback)))
;; Publication is accepted here. Missing compatibility metadata must not
;; become a rollback-capable error after commit; a later read fails closed.
(etaf-render-port--v1-record-revision
(get-buffer buffer) (plist-get report :surface-revision))
report))
(defun etaf-render-port--v1-fallback (&optional bootstrap-outcome)
"Return the complete immutable v1 port tagged with BOOTSTRAP-OUTCOME."
(etaf-render-port--create
:route 'v1
:spi-version 1
:schema-version 'etaf-ebox-v1-fallback/v1
:capabilities
'(initial-manual-cleanup update-paired-stage-rollback
same-object-update-report)
:tp-protocol 'tp-transaction-protocol-v1
:initial-function 'etaf-render-port--v1-initial
:update-function 'etaf-render-port--v1-update
:revision-function 'etaf-render-port--v1-revision
:bootstrap-outcome (or bootstrap-outcome 'v2-absent-v1-selected)))
(defun etaf-render-port--v2-port (snapshot) (defun etaf-render-port--v2-port (snapshot)
"Return an immutable selected v2 port from compatible SNAPSHOT." "Return an immutable selected v2 port from compatible SNAPSHOT."
(let ((failures (etaf-render-port--incompatibilities snapshot))) (let ((failures (etaf-render-port--incompatibilities snapshot)))
@ -574,32 +277,25 @@ FRAMEWORK-STAGE and FRAMEWORK-ROLLBACK retain their existing Ebox meanings."
(defun etaf-render-port--bootstrap () (defun etaf-render-port--bootstrap ()
"Probe Ebox exactly once and return one immutable selected render port." "Probe Ebox exactly once and return one immutable selected render port."
(pcase etaf-render-port-selection-policy (let ((feature-present-p (featurep 'ebox-framework-spi-v2))
('v1 (predicate-present-p (fboundp 'ebox-framework-spi-capabilities)))
(etaf-render-port--v1-fallback 'v1-kill-switch-selected)) (cond
('v2 ((and (not feature-present-p) (not predicate-present-p))
(let ((feature-present-p (featurep 'ebox-framework-spi-v2)) (etaf-render-port--bootstrap-error 'v2-provider-missing))
(predicate-present-p (fboundp 'ebox-framework-spi-capabilities))) ((not feature-present-p)
(cond (etaf-render-port--bootstrap-error 'predicate-without-v2-feature))
((and (not feature-present-p) (not predicate-present-p)) ((not predicate-present-p)
(etaf-render-port--v1-fallback)) (etaf-render-port--bootstrap-error 'v2-feature-without-predicate))
((not feature-present-p) (t
(etaf-render-port--bootstrap-error 'predicate-without-v2-feature)) (condition-case condition
((not predicate-present-p) (etaf-render-port--v2-port
(etaf-render-port--bootstrap-error 'v2-feature-without-predicate)) (etaf-render-port--provider-snapshot
(t (ebox-framework-spi-capabilities)))
(condition-case condition ((etaf-spi-incompatible-error etaf-spi-bootstrap-error)
(etaf-render-port--v2-port (signal (car condition) (cdr condition)))
(etaf-render-port--provider-snapshot ((error quit)
(ebox-framework-spi-capabilities))) (etaf-render-port--bootstrap-error
((etaf-spi-incompatible-error etaf-spi-bootstrap-error) 'provider-predicate-failure condition)))))))
(signal (car condition) (cdr condition)))
((error quit)
(etaf-render-port--bootstrap-error
'provider-predicate-failure condition)))))))
(_
(etaf-render-port--bootstrap-error
'invalid-render-port-selection etaf-render-port-selection-policy))))
(defconst etaf-render-port--selected-port (defconst etaf-render-port--selected-port
(etaf-render-port--bootstrap) (etaf-render-port--bootstrap)
@ -615,19 +311,15 @@ FRAMEWORK-STAGE and FRAMEWORK-ROLLBACK retain their existing Ebox meanings."
FRAMEWORK-STAGE and FRAMEWORK-ROLLBACK are one required callback pair. FRAMEWORK-STAGE and FRAMEWORK-ROLLBACK are one required callback pair.
OBSERVER, when non-nil, receives TP and Ebox snapshots measured during the OBSERVER, when non-nil, receives TP and Ebox snapshots measured during the
initial v2 publication and replayed only after successful final accept." initial v2 publication and replayed only after successful final accept."
(if (eq (etaf-render-port-route etaf-render-port--selected-port) 'v1) (let ((report
(funcall (etaf-render-port-initial-function (funcall
etaf-render-port--selected-port) (etaf-render-port-initial-function etaf-render-port--selected-port)
buffer input framework-stage framework-rollback observer) buffer input framework-stage framework-rollback)))
(let ((report (when observer
(funcall (dolist (provider-report
(etaf-render-port-initial-function etaf-render-port--selected-port) (ebox-framework-spi-initial-observation-reports report))
buffer input framework-stage framework-rollback))) (funcall observer buffer provider-report)))
(when observer report))
(dolist (provider-report
(ebox-framework-spi-initial-observation-reports report))
(funcall observer buffer provider-report)))
report)))
(defun etaf-render-port-update (defun etaf-render-port-update
(buffer input framework-stage framework-rollback) (buffer input framework-stage framework-rollback)
@ -639,11 +331,7 @@ FRAMEWORK-STAGE and FRAMEWORK-ROLLBACK are one required callback pair."
(defun etaf-render-port-unmount (buffer) (defun etaf-render-port-unmount (buffer)
"Release the retained Ebox surface owned by mounted BUFFER." "Release the retained Ebox surface owned by mounted BUFFER."
(let ((buffer (get-buffer buffer))) (ebox-unmount-buffer (get-buffer buffer)))
(prog1 (ebox-unmount-buffer buffer)
(when (buffer-live-p buffer)
(with-current-buffer buffer
(setq-local etaf-render-port--v1-committed-revision nil))))))
(defun etaf-render-port-mounted-p (buffer) (defun etaf-render-port-mounted-p (buffer)
"Return non-nil when BUFFER owns a live retained Ebox surface." "Return non-nil when BUFFER owns a live retained Ebox surface."

9
etaf-runtime.el
View File

@ -6176,17 +6176,12 @@ RENDERED-IDENTITIES names the Component render participants."
(etaf--runtime-participant-publish participant)) (etaf--runtime-participant-publish participant))
(lambda (_report) (lambda (_report)
(etaf--runtime-participant-rollback participant)))) (etaf--runtime-participant-rollback participant))))
(let* ((host-authority (etaf-runtime-host-authority runtime)) (let ((host-authority (etaf-runtime-host-authority runtime)))
(legacy-p
(eq (etaf-render-port-route
(etaf-render-port-selected))
'v1)))
(etaf-render-port-initial (etaf-render-port-initial
(etaf-runtime-buffer runtime) next-root (etaf-runtime-buffer runtime) next-root
(lambda (_report) (lambda (_report)
(etaf--runtime-participant-publish participant) (etaf--runtime-participant-publish participant)
(etaf-host-authority-stage-attach (etaf-host-authority-stage-attach host-authority))
host-authority legacy-p))
(lambda (_report) (lambda (_report)
(etaf-host-authority-rollback-attach host-authority) (etaf-host-authority-rollback-attach host-authority)
(etaf--runtime-participant-rollback participant)) (etaf--runtime-participant-rollback participant))

2
etaf.el
View File

@ -3,7 +3,7 @@
;; SPDX-License-Identifier: GPL-3.0-or-later ;; SPDX-License-Identifier: GPL-3.0-or-later
;; Author: ETAF contributors ;; Author: ETAF contributors
;; Version: 0.1.1 ;; Version: 0.2.0
;; Package-Requires: ((emacs "29.1") (ebox "2.0.1") (tp "1.0.1")) ;; Package-Requires: ((emacs "29.1") (ebox "2.0.1") (tp "1.0.1"))
;; Keywords: ui, tools, convenience ;; Keywords: ui, tools, convenience
;; URL: https://github.com/ginqi7/etaf ;; URL: https://github.com/ginqi7/etaf

2
tests/etaf-docs-tests.el
View File

@ -103,6 +103,8 @@
"docs/user-guide.zh.md" "docs/user-guide.zh.md"
"docs/implementation-plan.en.md" "docs/implementation-plan.en.md"
"docs/implementation-plan.zh.md" "docs/implementation-plan.zh.md"
"docs/migration-0.2.en.md"
"docs/migration-0.2.zh.md"
"postmortem/2026-08-05-executable-core-examples.en.md" "postmortem/2026-08-05-executable-core-examples.en.md"
"postmortem/2026-08-05-executable-core-examples.zh.md")) "postmortem/2026-08-05-executable-core-examples.zh.md"))
(should (file-exists-p (expand-file-name file etaf-docs-test--root))))) (should (file-exists-p (expand-file-name file etaf-docs-test--root)))))

132
tests/etaf-g1-cross-layer-tests.el
View File

@ -33,7 +33,7 @@
(combined-participant . etaf-g1-ebox-etaf-combined-participant-same-report) (combined-participant . etaf-g1-ebox-etaf-combined-participant-same-report)
(spi-branches . etaf-g1-spi-four-branches-and-selected-port-immutability) (spi-branches . etaf-g1-spi-four-branches-and-selected-port-immutability)
(generation-host-cas . etaf-g1-generation-cas-and-host-lifecycle-guards) (generation-host-cas . etaf-g1-generation-cas-and-host-lifecycle-guards)
(v1-v2-equivalence . etaf-g1-v1-v2-runtime-equivalence) (v2-runtime-contract . etaf-g1-v2-runtime-contract)
(runtime-fault-rollback . etaf-g1-runtime-fault-restores-authorities) (runtime-fault-rollback . etaf-g1-runtime-fault-restores-authorities)
(postcommit-diagnostics . etaf-g1-postcommit-report-fault-keeps-accepted-state) (postcommit-diagnostics . etaf-g1-postcommit-report-fault-keeps-accepted-state)
(host-unmount-kill . etaf-g1-host-unmount-and-kill-inflight-route) (host-unmount-kill . etaf-g1-host-unmount-and-kill-inflight-route)
@ -47,7 +47,7 @@
(defconst etaf-g1--required-fault-keys (defconst etaf-g1--required-fault-keys
'(tp-order multi-surface combined-participant spi-branches '(tp-order multi-surface combined-participant spi-branches
generation-host-cas v1-v2-equivalence runtime-fault-rollback generation-host-cas v2-runtime-contract runtime-fault-rollback
postcommit-diagnostics host-unmount-kill nested-runtime-event multi-context postcommit-diagnostics host-unmount-kill nested-runtime-event multi-context
native-fallback retirement load-path-harness gui-recovery-harness) native-fallback retirement load-path-harness gui-recovery-harness)
"Required unique behavior keys for the G1 cross-layer gate.") "Required unique behavior keys for the G1 cross-layer gate.")
@ -192,14 +192,15 @@
(tp--transaction-precommit-functions nil)) (tp--transaction-precommit-functions nil))
(should-error (should-error
(tp-with-transaction (tp-with-transaction
(tp-transaction-participate (tp-transaction-participate-v2
'tp-first (lambda () (push 'first-stage etaf-g1--tp-trace)) :key 'tp-first
(lambda () (push 'first-rollback etaf-g1--tp-trace))) :stage (lambda () (push 'first-stage etaf-g1--tp-trace))
(tp-transaction-participate :rollback (lambda () (push 'first-rollback etaf-g1--tp-trace)))
'tp-second (tp-transaction-participate-v2
(lambda () (push 'second-stage etaf-g1--tp-trace) :key 'tp-second
(error "G1 injected partial apply")) :stage (lambda () (push 'second-stage etaf-g1--tp-trace)
(lambda () (push 'second-rollback etaf-g1--tp-trace)))))) (error "G1 injected partial apply"))
:rollback (lambda () (push 'second-rollback etaf-g1--tp-trace))))))
(should (should
(equal (nreverse etaf-g1--tp-trace) (equal (nreverse etaf-g1--tp-trace)
'(first-stage second-stage second-rollback first-rollback)))) '(first-stage second-stage second-rollback first-rollback))))
@ -212,12 +213,14 @@
'(etaf-g1--tp-precommit-probe))) '(etaf-g1--tp-precommit-probe)))
(should-error (should-error
(tp-with-transaction (tp-with-transaction
(tp-transaction-participate (tp-transaction-participate-v2
'tp-first (lambda () (push 'first-stage etaf-g1--tp-trace)) :key 'tp-first
(lambda () (push 'first-rollback etaf-g1--tp-trace))) :stage (lambda () (push 'first-stage etaf-g1--tp-trace))
(tp-transaction-participate :rollback (lambda () (push 'first-rollback etaf-g1--tp-trace)))
'tp-second (lambda () (push 'second-stage etaf-g1--tp-trace)) (tp-transaction-participate-v2
(lambda () (push 'second-rollback etaf-g1--tp-trace))))) :key 'tp-second
:stage (lambda () (push 'second-stage etaf-g1--tp-trace))
:rollback (lambda () (push 'second-rollback etaf-g1--tp-trace)))))
(should (should
(equal (nreverse etaf-g1--tp-trace) (equal (nreverse etaf-g1--tp-trace)
'(first-stage second-stage precommit '(first-stage second-stage precommit
@ -632,7 +635,8 @@
(and (not (eq feature 'ebox-framework-spi-v2)) (and (not (eq feature 'ebox-framework-spi-v2))
(funcall original-featurep feature)))) (funcall original-featurep feature))))
((symbol-function 'ebox-framework-spi-capabilities) nil)) ((symbol-function 'ebox-framework-spi-capabilities) nil))
(should (eq (etaf-render-port-route (etaf-render-port--bootstrap)) 'v1))) (should-error (etaf-render-port--bootstrap)
:type 'etaf-spi-bootstrap-error))
(should (eq (etaf-render-port-route (etaf-render-port--bootstrap)) 'v2)) (should (eq (etaf-render-port-route (etaf-render-port--bootstrap)) 'v2))
(cl-letf (((symbol-function 'ebox-framework-spi-capabilities) (cl-letf (((symbol-function 'ebox-framework-spi-capabilities)
(lambda () (error "G1 malformed provider")))) (lambda () (error "G1 malformed provider"))))
@ -661,19 +665,20 @@
authority generation token versions authority generation token versions
(etaf--generation-create :generation-id 2) 2 versions) (etaf--generation-create :generation-id 2) 2 versions)
:type 'etaf-generation-error)) :type 'etaf-generation-error))
(let ((buffer (generate-new-buffer " *g1-host*"))) (let ((buffer (generate-new-buffer " *g1-host*"))
(source (etaf-ref 0)) runtime)
(unwind-protect (unwind-protect
(let ((host (etaf-host-authority-create 'g1-host 1 buffer))) (progn
(etaf-host-authority-begin-attach host) (etaf-mount buffer (etaf-g1--view source))
;; Legacy attach is the explicit non-transactional compatibility (setq runtime (etaf-runtime-for-buffer buffer))
;; path; v2 uses the same state transition behind a TP marker. (let* ((host (etaf-runtime-host-authority runtime))
(etaf-host-authority-stage-attach host t) (token (etaf-host-authority-token host)))
(let ((token (etaf-host-authority-token host)))
(should (etaf-host-authority-accepts-token-p host token)) (should (etaf-host-authority-accepts-token-p host token))
(etaf-host-authority-begin-detach host) (etaf-unmount runtime)
(etaf-host-authority-invalidate host) (setq runtime nil)
(should-not (etaf-host-authority-accepts-token-p host token)))) (should-not (etaf-host-authority-accepts-token-p host token))))
(kill-buffer buffer)))) (when runtime (etaf-unmount runtime))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(defun etaf-g1--run-selected-render-port-route () (defun etaf-g1--run-selected-render-port-route ()
"Run one lifecycle through the process-selected port and return evidence." "Run one lifecycle through the process-selected port and return evidence."
@ -750,7 +755,6 @@
(list (list
:selected-route (etaf-render-port-route selected) :selected-route (etaf-render-port-route selected)
:bootstrap-outcome (etaf-render-port-bootstrap-outcome selected) :bootstrap-outcome (etaf-render-port-bootstrap-outcome selected)
:render-port-selection-policy etaf-render-port-selection-policy
:generation-mirror-route etaf-generation-mirror-route :generation-mirror-route etaf-generation-mirror-route
:semantic-commit-route etaf-semantic-commit-route :semantic-commit-route etaf-semantic-commit-route
:v2-feature-present (featurep 'ebox-framework-spi-v2) :v2-feature-present (featurep 'ebox-framework-spi-v2)
@ -771,8 +775,8 @@
(executable-find invocation-name) (executable-find invocation-name)
(error "Cannot resolve current Emacs executable: %S" invocation-name))) (error "Cannot resolve current Emacs executable: %S" invocation-name)))
(defun etaf-g1--probe-route-in-fresh-emacs (route) (defun etaf-g1--probe-v2-in-fresh-emacs ()
"Bootstrap ROUTE in a fresh Emacs process and return its route evidence." "Bootstrap the required v2 port in a fresh Emacs and return its evidence."
(let* ((etaf-root (expand-file-name "etaf" etaf-g1--workspace-root)) (let* ((etaf-root (expand-file-name "etaf" etaf-g1--workspace-root))
(test-file (expand-file-name "tests/etaf-g1-cross-layer-tests.el" (test-file (expand-file-name "tests/etaf-g1-cross-layer-tests.el"
etaf-root)) etaf-root))
@ -781,15 +785,6 @@
(expand-file-name directory etaf-g1--workspace-root)) (expand-file-name directory etaf-g1--workspace-root))
'("etaf" "etaf/examples" "etaf/scripts" '("etaf" "etaf/examples" "etaf/scripts"
"ebox" "tp" "ecss"))) "ebox" "tp" "ecss")))
(route-setup
(pcase route
('v1
(list
"--eval"
"(setq etaf-render-port-selection-policy 'v1)"))
('v2
(list "--eval" "(setq etaf-render-port-selection-policy 'v2)"))
(_ (error "Unknown G1 render route: %S" route))))
(arguments (arguments
(append (append
'("-Q" "--batch") '("-Q" "--batch")
@ -797,7 +792,6 @@
(mapcar (lambda (directory) (list "-L" directory)) (mapcar (lambda (directory) (list "-L" directory))
load-directories)) load-directories))
'("--eval" "(setq load-prefer-newer t)") '("--eval" "(setq load-prefer-newer t)")
route-setup
(list (list
"-l" test-file "-l" test-file
"--eval" "--eval"
@ -813,60 +807,46 @@
(list (current-buffer) t) nil arguments) (list (current-buffer) t) nil arguments)
output (buffer-string)) output (buffer-string))
(unless (and (integerp status) (zerop status)) (unless (and (integerp status) (zerop status))
(ert-fail (format "Fresh %S route probe failed (%S):\n%s" (ert-fail (format "Fresh v2 route probe failed (%S):\n%s"
route status output))) status output)))
(goto-char (point-min)) (goto-char (point-min))
(unless (re-search-forward (unless (re-search-forward
"^ETAF_G1_ROUTE_EVIDENCE:\\([^[:space:]]+\\)$" nil t) "^ETAF_G1_ROUTE_EVIDENCE:\\([^[:space:]]+\\)$" nil t)
(ert-fail (format "Fresh %S route probe emitted no evidence:\n%s" (ert-fail (format "Fresh v2 route probe emitted no evidence:\n%s"
route output))) output)))
(setq encoded (match-string-no-properties 1))) (setq encoded (match-string-no-properties 1)))
(read (base64-decode-string encoded)))) (read (base64-decode-string encoded))))
(ert-deftest etaf-g1-v1-v2-runtime-equivalence () (ert-deftest etaf-g1-v2-runtime-contract ()
"Fresh v1 and v2 bootstraps preserve lifecycle and rollback equivalence." "A fresh v2 bootstrap preserves lifecycle, identity and failed-update state."
(let* ((v1 (etaf-g1--probe-route-in-fresh-emacs 'v1)) (let* ((v2 (etaf-g1--probe-v2-in-fresh-emacs))
(v2 (etaf-g1--probe-route-in-fresh-emacs 'v2)) (lifecycle (plist-get v2 :lifecycle-evidence))
(v1-lifecycle (plist-get v1 :lifecycle-evidence)) (initial (plist-get lifecycle :initial))
(v2-lifecycle (plist-get v2 :lifecycle-evidence))) (updated (plist-get lifecycle :updated))
(should (eq (plist-get v1 :selected-route) 'v1)) (rolled-back (plist-get lifecycle :rolled-back))
(host-lifecycle (plist-get lifecycle :lifecycle)))
(should (eq (plist-get v2 :selected-route) 'v2)) (should (eq (plist-get v2 :selected-route) 'v2))
(should (eq (plist-get v1 :bootstrap-outcome)
'v1-kill-switch-selected))
(should (eq (plist-get v2 :bootstrap-outcome) (should (eq (plist-get v2 :bootstrap-outcome)
'valid-v2-selected)) 'valid-v2-selected))
(should (plist-get v1 :v2-feature-present))
(should (plist-get v1 :v2-predicate-present))
(should (plist-get v2 :v2-feature-present)) (should (plist-get v2 :v2-feature-present))
(should (plist-get v2 :v2-predicate-present)) (should (plist-get v2 :v2-predicate-present))
(should (eq (plist-get v1 :render-port-selection-policy) 'v1))
(should (eq (plist-get v1 :generation-mirror-route) 'project))
(should (eq (plist-get v1 :semantic-commit-route) 'cas))
(should (eq (plist-get v2 :render-port-selection-policy) 'v2))
(should (eq (plist-get v2 :generation-mirror-route) 'project)) (should (eq (plist-get v2 :generation-mirror-route) 'project))
(should (eq (plist-get v2 :semantic-commit-route) 'cas)) (should (eq (plist-get v2 :semantic-commit-route) 'cas))
(should (plist-get v1 :selected-stable))
(should (plist-get v2 :selected-stable)) (should (plist-get v2 :selected-stable))
(should (eq (plist-get v1 :initial-dispatch)
'etaf-render-port--v1-initial))
(should (eq (plist-get v1 :update-dispatch)
'etaf-render-port--v1-update))
(should (eq (plist-get v2 :initial-dispatch) (should (eq (plist-get v2 :initial-dispatch)
'ebox-framework-spi-initial)) 'ebox-framework-spi-initial))
(should (eq (plist-get v2 :update-dispatch) (should (eq (plist-get v2 :update-dispatch)
'ebox-framework-spi-update)) 'ebox-framework-spi-update))
(dolist (evidence (list v1 v2)) (should (= 1 (plist-get v2 :initial-dispatch-count)))
(should (= 1 (plist-get evidence :initial-dispatch-count))) (should (= 2 (plist-get v2 :update-dispatch-count)))
(should (= 2 (plist-get evidence :update-dispatch-count)))) (should (equal (plist-get initial :semantic-text) "value=0"))
(dolist (key '(:initial :updated :rolled-back :update-report :lifecycle)) (should (equal (plist-get updated :semantic-text) "value=1"))
(should (equal-including-properties (should (equal-including-properties updated rolled-back))
(plist-get v1-lifecycle key) (plist-get v2-lifecycle key)))) (should (= 4 (length host-lifecycle)))
;; The v2 Host attaches with one generic final marker; legacy v1 performs (should (eq (plist-get (car host-lifecycle) :host-state) 'attached))
;; its compatible attach inside the reversible manual stage. (should (eq (plist-get (car (last host-lifecycle)) :host-state) 'terminal))
(should (= 0 (plist-get v1-lifecycle :initial-marker-count))) (should (= 1 (plist-get lifecycle :initial-marker-count)))
(should (= 1 (plist-get v2-lifecycle :initial-marker-count))) (should (= 0 (plist-get lifecycle :update-marker-count)))))
(should (= 0 (plist-get v1-lifecycle :update-marker-count)))
(should (= 0 (plist-get v2-lifecycle :update-marker-count)))))
(provide 'etaf-g1-cross-layer-tests) (provide 'etaf-g1-cross-layer-tests)
;;; etaf-g1-cross-layer-tests.el ends here ;;; etaf-g1-cross-layer-tests.el ends here

4
tests/etaf-host-tests.el
View File

@ -30,10 +30,10 @@
(unwind-protect (unwind-protect
(progn (progn
(cl-letf (((symbol-function 'etaf-host-authority-stage-attach) (cl-letf (((symbol-function 'etaf-host-authority-stage-attach)
(lambda (authority &optional legacy-p) (lambda (authority)
(setq lookup-during-stage (setq lookup-during-stage
(etaf-runtime-for-buffer buffer-name)) (etaf-runtime-for-buffer buffer-name))
(funcall original-stage authority legacy-p)))) (funcall original-stage authority))))
(etaf-mount (etaf-mount
buffer-name buffer-name
(etaf--view-call 'etaf-host-test-component (etaf--view-call 'etaf-host-test-component

243
tests/etaf-render-port-tests.el
View File

@ -12,11 +12,17 @@
(file-name-directory (or load-file-name buffer-file-name)))) (file-name-directory (or load-file-name buffer-file-name))))
"ETAF package root used by static bootstrap-owner checks.") "ETAF package root used by static bootstrap-owner checks.")
(ert-deftest etaf-render-port-selection-policy-defaults-to-v2 () (ert-deftest etaf-render-port-package-metadata-requires-final-v2-stack ()
"The package's declared bootstrap authority profile defaults to v2." "ETAF 0.2.1 declares the Ebox 3 and TP 2 runtime requirements."
(should (require 'package)
(eq (eval (car (get 'etaf-render-port-selection-policy 'standard-value)) t) (with-temp-buffer
'v2))) (insert-file-contents
(expand-file-name "etaf.el" etaf-render-port-test--root))
(let ((description (package-buffer-info)))
(should (equal (package-desc-version description) '(0 2 1)))
(should
(equal (package-desc-reqs description)
'((emacs (29 1)) (ebox (3 0 0)) (tp (2 0 0))))))))
(ert-deftest etaf-render-port-selects-valid-v2-immutably () (ert-deftest etaf-render-port-selects-valid-v2-immutably ()
"A valid provider produces one immutable v2 selected port." "A valid provider produces one immutable v2 selected port."
@ -27,8 +33,8 @@
(should (= (etaf-render-port-spi-version port) 2)) (should (= (etaf-render-port-spi-version port) 2))
(should (eq (etaf-render-port-schema-version port) (should (eq (etaf-render-port-schema-version port)
'ebox-framework-spi-schema/v2)) 'ebox-framework-spi-schema/v2))
(should (eq (etaf-render-port-tp-protocol port) (should (memq (etaf-render-port-tp-protocol port)
'tp-transaction-protocol-v1+v2)) etaf-render-port--accepted-tp-protocols))
(should (eq (etaf-render-port-initial-function port) (should (eq (etaf-render-port-initial-function port)
'ebox-framework-spi-initial)) 'ebox-framework-spi-initial))
(should (eq (etaf-render-port-update-function port) (should (eq (etaf-render-port-update-function port)
@ -43,47 +49,30 @@
(should-error (should-error
(eval `(setf (etaf-render-port--route ',port) 'broken))))) (eval `(setf (etaf-render-port--route ',port) 'broken)))))
(ert-deftest etaf-render-port-falls-back-only-when-v2-is-fully-absent () (ert-deftest etaf-render-port-requires-v2-provider ()
"Only complete feature/predicate absence selects the immutable v1 port." "Complete provider absence fails closed instead of selecting a legacy port."
(let ((original-featurep (symbol-function 'featurep))) (let ((original-featurep (symbol-function 'featurep)))
(cl-letf (((symbol-function 'featurep) (cl-letf (((symbol-function 'featurep)
(lambda (feature) (lambda (feature)
(and (not (eq feature 'ebox-framework-spi-v2)) (and (not (eq feature 'ebox-framework-spi-v2))
(funcall original-featurep feature)))) (funcall original-featurep feature))))
((symbol-function 'ebox-framework-spi-capabilities) nil)) ((symbol-function 'ebox-framework-spi-capabilities) nil))
(let ((port (etaf-render-port--bootstrap))) (should-error (etaf-render-port--bootstrap)
(should (eq (etaf-render-port-route port) 'v1)) :type 'etaf-spi-bootstrap-error))))
(should (= (etaf-render-port-spi-version port) 1))
(should (eq (etaf-render-port-initial-function port)
'etaf-render-port--v1-initial))
(should (eq (etaf-render-port-update-function port)
'etaf-render-port--v1-update))
(should (eq (etaf-render-port-revision-function port)
'etaf-render-port--v1-revision))
(should (eq (etaf-render-port-bootstrap-outcome port)
'v2-absent-v1-selected))))))
(ert-deftest etaf-render-port-v1-kill-switch-bypasses-present-provider () (ert-deftest etaf-render-port-accepts-each-v2-capable-tp-manifest ()
"The explicit v1 profile selects old authority without probing Ebox v2." "Both transitional dual-capability and final v2-only providers are valid."
(let ((etaf-render-port-selection-policy 'v1) (let ((provider (ebox-framework-spi-capabilities)))
(provider-calls 0)) (dolist (protocol '(tp-transaction-protocol-v1+v2
(cl-letf (((symbol-function 'ebox-framework-spi-capabilities) tp-transaction-protocol-v2))
(lambda () (cl-letf
(cl-incf provider-calls) (((symbol-function 'ebox-framework-spi-capabilities)
(error "kill switch must bypass provider")))) (lambda () provider))
(let ((port (etaf-render-port--bootstrap))) ((symbol-function 'ebox-framework-spi-provider-tp-protocol)
(should (featurep 'ebox-framework-spi-v2)) (lambda (_provider) protocol)))
(should (fboundp 'ebox-framework-spi-capabilities)) (should (eq (etaf-render-port-tp-protocol
(should (= provider-calls 0)) (etaf-render-port--bootstrap))
(should (eq (etaf-render-port-route port) 'v1)) protocol))))))
(should (eq (etaf-render-port-bootstrap-outcome port)
'v1-kill-switch-selected))))))
(ert-deftest etaf-render-port-rejects-invalid-selection-policy ()
"A malformed render-port selection policy fails before provider probing."
(let ((etaf-render-port-selection-policy 'invalid))
(should-error (etaf-render-port--bootstrap)
:type 'etaf-spi-bootstrap-error)))
(ert-deftest etaf-render-port-rejects-half-present-v2 () (ert-deftest etaf-render-port-rejects-half-present-v2 ()
"Feature-only and predicate-only providers fail instead of downgrading." "Feature-only and predicate-only providers fail instead of downgrading."
@ -147,27 +136,31 @@
(should-error (etaf-render-port--bootstrap) (should-error (etaf-render-port--bootstrap)
:type 'etaf-spi-incompatible-error)))) :type 'etaf-spi-incompatible-error))))
(ert-deftest etaf-render-port-v1-initial-runs-manual-framework-cleanup () (ert-deftest etaf-render-port-v2-initial-delegates-paired-rollback ()
"A failed legacy initial stage invokes its paired cleanup exactly once." "The selected SPI operation owns stage failure and paired rollback."
(let ((buffer (generate-new-buffer " *etaf-v1-manual-cleanup*")) trace) (let ((buffer (generate-new-buffer " *etaf-v2-paired-rollback*")) trace)
(unwind-protect (unwind-protect
(cl-letf (((symbol-function 'ebox-render-to-buffer) (cl-letf (((symbol-function 'ebox-framework-spi-initial)
(lambda (&rest _arguments) (lambda (_buffer _input stage rollback)
(push 'render trace) (push 'render trace)
buffer))) (condition-case condition
(funcall stage nil)
(error
(funcall rollback nil)
(signal (car condition) (cdr condition)))))))
(should-error (should-error
(etaf-render-port--v1-initial (etaf-render-port-initial
buffer 'input buffer 'input
(lambda (_report) (lambda (_report)
(push 'stage trace) (push 'stage trace)
(error "injected v1 initial failure")) (error "injected v2 initial failure"))
(lambda (_report) (push 'rollback trace)))) (lambda (_report) (push 'rollback trace))))
(should (equal (nreverse trace) '(render stage rollback)))) (should (equal (nreverse trace) '(render stage rollback))))
(when (buffer-live-p buffer) (kill-buffer buffer))))) (when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest etaf-render-port-v1-initial-restores-real-ebox-surface () (ert-deftest etaf-render-port-v2-initial-restores-real-ebox-surface ()
"A failed legacy stage removes Ebox authority and restores buffer content." "A failed SPI stage removes Ebox authority and restores buffer content."
(let ((buffer (generate-new-buffer " *etaf-v1-real-cleanup*")) (let ((buffer (generate-new-buffer " *etaf-v2-real-cleanup*"))
(input (ebox-build '(box "committed"))) (input (ebox-build '(box "committed")))
(rollback-count 0) (rollback-count 0)
captured) captured)
@ -175,28 +168,26 @@
(progn (progn
(with-current-buffer buffer (insert "sentinel")) (with-current-buffer buffer (insert "sentinel"))
(condition-case condition (condition-case condition
(etaf-render-port--v1-initial (etaf-render-port-initial
buffer input buffer input
(lambda (_report) (lambda (_report)
(error "injected real v1 stage failure")) (error "injected real v2 stage failure"))
(lambda (_report) (cl-incf rollback-count))) (lambda (_report) (cl-incf rollback-count)))
(error (setq captured condition))) (error (setq captured condition)))
(should (equal captured '(error "injected real v1 stage failure"))) (should (equal captured '(error "injected real v2 stage failure")))
(should (= rollback-count 1)) (should (= rollback-count 1))
(should-not (ebox-surface-buffer-mounted-p buffer)) (should-not (ebox-surface-buffer-mounted-p buffer))
(should-not (ebox-surface-buffer-observer buffer)) (should-not (ebox-surface-buffer-observer buffer))
(should (equal "sentinel" (should (equal "sentinel"
(with-current-buffer buffer (buffer-string)))) (with-current-buffer buffer (buffer-string)))))
(should-not
(etaf-render-port-v1-cleanup-diagnostics buffer)))
(when (and (buffer-live-p buffer) (when (and (buffer-live-p buffer)
(ebox-surface-buffer-mounted-p buffer)) (ebox-surface-buffer-mounted-p buffer))
(ebox-unmount-buffer buffer)) (ebox-unmount-buffer buffer))
(when (buffer-live-p buffer) (kill-buffer buffer))))) (when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest etaf-render-port-v1-failure-restores-exact-editor-custody () (ert-deftest etaf-render-port-v2-failure-restores-exact-editor-custody ()
"Legacy stage rollback preserves Emacs-owned editor identities and undo." "SPI stage rollback preserves Emacs-owned editor identities and undo."
(let ((buffer (generate-new-buffer " *etaf-v1-editor-custody*")) (let ((buffer (generate-new-buffer " *etaf-v2-editor-custody*"))
(input (ebox-build '(box "committed"))) (input (ebox-build '(box "committed")))
overlay left-marker right-marker snapshot captured) overlay left-marker right-marker snapshot captured)
(unwind-protect (unwind-protect
@ -238,7 +229,7 @@
:undo-list (copy-tree buffer-undo-list) :undo-list (copy-tree buffer-undo-list)
:modified-p (buffer-modified-p)))) :modified-p (buffer-modified-p))))
(condition-case condition (condition-case condition
(etaf-render-port--v1-initial (etaf-render-port-initial
buffer input buffer input
(lambda (_report) (error "editor custody primary")) (lambda (_report) (error "editor custody primary"))
#'ignore) #'ignore)
@ -292,9 +283,9 @@
(ebox-unmount-buffer buffer)) (ebox-unmount-buffer buffer))
(when (buffer-live-p buffer) (kill-buffer buffer))))) (when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest etaf-render-port-v1-nonlocal-exit-runs-exact-cleanup () (ert-deftest etaf-render-port-v2-nonlocal-exit-runs-exact-cleanup ()
"A legacy stage throw cannot escape with mounted or editor state retained." "A SPI stage throw cannot escape with mounted or editor state retained."
(let ((buffer (generate-new-buffer " *etaf-v1-nonlocal-cleanup*")) (let ((buffer (generate-new-buffer " *etaf-v2-nonlocal-cleanup*"))
(input (ebox-build '(box "committed"))) (input (ebox-build '(box "committed")))
(rollback-count 0)) (rollback-count 0))
(unwind-protect (unwind-protect
@ -302,11 +293,11 @@
(with-current-buffer buffer (insert "before")) (with-current-buffer buffer (insert "before"))
(should (should
(eq (eq
(catch 'etaf-v1-test-escape (catch 'etaf-v2-test-escape
(etaf-render-port--v1-initial (etaf-render-port-initial
buffer input buffer input
(lambda (_report) (lambda (_report)
(throw 'etaf-v1-test-escape 'escaped)) (throw 'etaf-v2-test-escape 'escaped))
(lambda (_report) (cl-incf rollback-count))) (lambda (_report) (cl-incf rollback-count)))
'not-escaped) 'not-escaped)
'escaped)) 'escaped))
@ -314,15 +305,13 @@
(should-not (ebox-surface-buffer-mounted-p buffer)) (should-not (ebox-surface-buffer-mounted-p buffer))
(should-not (ebox-surface-buffer-observer buffer)) (should-not (ebox-surface-buffer-observer buffer))
(should (equal "before" (should (equal "before"
(with-current-buffer buffer (buffer-string)))) (with-current-buffer buffer (buffer-string)))))
(should-not
(etaf-render-port-v1-cleanup-diagnostics buffer)))
(when (and (buffer-live-p buffer) (when (and (buffer-live-p buffer)
(ebox-surface-buffer-mounted-p buffer)) (ebox-surface-buffer-mounted-p buffer))
(ebox-unmount-buffer buffer)) (ebox-unmount-buffer buffer))
(when (buffer-live-p buffer) (kill-buffer buffer))))) (when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest etaf-render-port-v1-precondition-keeps-existing-mount () (ert-deftest etaf-render-port-v2-precondition-keeps-existing-mount ()
"Rejecting an already mounted target must not clean up foreign authority." "Rejecting an already mounted target must not clean up foreign authority."
(let ((buffer (generate-new-buffer " *etaf-v1-existing-mount*"))) (let ((buffer (generate-new-buffer " *etaf-v1-existing-mount*")))
(unwind-protect (unwind-protect
@ -330,7 +319,7 @@
(ebox-render-to-buffer buffer (ebox-build '(box "existing"))) (ebox-render-to-buffer buffer (ebox-build '(box "existing")))
(let ((revision (ebox-surface-buffer-revision buffer))) (let ((revision (ebox-surface-buffer-revision buffer)))
(should-error (should-error
(etaf-render-port--v1-initial (etaf-render-port-initial
buffer (ebox-build '(box "replacement")) #'ignore #'ignore) buffer (ebox-build '(box "replacement")) #'ignore #'ignore)
:type 'error) :type 'error)
(should (ebox-surface-buffer-mounted-p buffer)) (should (ebox-surface-buffer-mounted-p buffer))
@ -342,48 +331,42 @@
(ebox-unmount-buffer buffer)) (ebox-unmount-buffer buffer))
(when (buffer-live-p buffer) (kill-buffer buffer))))) (when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest etaf-render-port-v1-rollback-throw-cannot-stop-cleanup-tail () (ert-deftest etaf-render-port-v2-rollback-throw-cannot-stop-cleanup-tail ()
"A framework rollback throw still unmounts and restores legacy editor state." "A framework rollback throw propagates only after SPI cleanup completes."
(let ((buffer (generate-new-buffer " *etaf-v1-rollback-throw*")) (let ((buffer (generate-new-buffer " *etaf-v2-rollback-throw*"))
(input (ebox-build '(box "committed")))) (input (ebox-build '(box "committed"))))
(unwind-protect (unwind-protect
(progn (progn
(with-current-buffer buffer (insert "before")) (with-current-buffer buffer (insert "before"))
(should (should
(eq (eq
(catch 'etaf-v1-rollback-escape (catch 'etaf-v2-rollback-escape
(etaf-render-port--v1-initial (etaf-render-port-initial
buffer input buffer input
(lambda (_report) (error "primary before rollback throw")) (lambda (_report) (error "primary before rollback throw"))
(lambda (_report) (lambda (_report)
(throw 'etaf-v1-rollback-escape 'rollback-escaped))) (throw 'etaf-v2-rollback-escape 'rollback-escaped)))
'not-escaped) 'not-escaped)
'rollback-escaped)) 'rollback-escaped))
(should-not (ebox-surface-buffer-mounted-p buffer)) (should-not (ebox-surface-buffer-mounted-p buffer))
(should-not (ebox-surface-buffer-observer buffer)) (should-not (ebox-surface-buffer-observer buffer))
(should (equal "before" (should (equal "before"
(with-current-buffer buffer (buffer-string)))) (with-current-buffer buffer (buffer-string)))))
(let ((diagnostic
(cl-find 'framework-rollback
(etaf-render-port-v1-cleanup-diagnostics buffer)
:key (lambda (entry) (plist-get entry :phase)))))
(should diagnostic)
(should (plist-get diagnostic :nonlocal-exit))))
(when (and (buffer-live-p buffer) (when (and (buffer-live-p buffer)
(ebox-surface-buffer-mounted-p buffer)) (ebox-surface-buffer-mounted-p buffer))
(ebox-unmount-buffer buffer)) (ebox-unmount-buffer buffer))
(when (buffer-live-p buffer) (kill-buffer buffer))))) (when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest etaf-render-port-v1-cleanup-fault-keeps-primary-and-continues () (ert-deftest etaf-render-port-v2-cleanup-fault-keeps-primary-and-continues ()
"A secondary v1 cleanup fault is diagnosed while Ebox cleanup continues." "A secondary rollback fault is contained while Ebox cleanup continues."
(let ((buffer (generate-new-buffer " *etaf-v1-cleanup-fault*")) (let ((buffer (generate-new-buffer " *etaf-v2-cleanup-fault*"))
(input (ebox-build '(box "committed"))) (input (ebox-build '(box "committed")))
captured) captured)
(unwind-protect (unwind-protect
(progn (progn
(with-current-buffer buffer (insert "before")) (with-current-buffer buffer (insert "before"))
(condition-case condition (condition-case condition
(etaf-render-port--v1-initial (etaf-render-port-initial
buffer input buffer input
(lambda (_report) (error "primary stage failure")) (lambda (_report) (error "primary stage failure"))
(lambda (_report) (error "secondary rollback failure"))) (lambda (_report) (error "secondary rollback failure")))
@ -391,14 +374,7 @@
(should (equal captured '(error "primary stage failure"))) (should (equal captured '(error "primary stage failure")))
(should-not (ebox-surface-buffer-mounted-p buffer)) (should-not (ebox-surface-buffer-mounted-p buffer))
(should (equal "before" (should (equal "before"
(with-current-buffer buffer (buffer-string)))) (with-current-buffer buffer (buffer-string)))))
(let ((diagnostics
(etaf-render-port-v1-cleanup-diagnostics buffer)))
(should (= 1 (length diagnostics)))
(should (eq (plist-get (car diagnostics) :phase)
'framework-rollback))
(should (equal (plist-get (car diagnostics) :condition)
'(error "secondary rollback failure")))))
(when (and (buffer-live-p buffer) (when (and (buffer-live-p buffer)
(ebox-surface-buffer-mounted-p buffer)) (ebox-surface-buffer-mounted-p buffer))
(ebox-unmount-buffer buffer)) (ebox-unmount-buffer buffer))
@ -423,46 +399,25 @@
(ebox-unmount-buffer buffer)) (ebox-unmount-buffer buffer))
(when (buffer-live-p buffer) (kill-buffer buffer))))) (when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest etaf-render-port-v1-revision-needs-no-v2-ebox-accessor () (ert-deftest etaf-render-port-v2-preserves-provider-report-identity ()
"A v1-only Ebox retains revisions without a v2-only query symbol." "Initial and update return the exact report seen by framework staging."
(let ((buffer (generate-new-buffer " *etaf-v1-revision*")) (let ((buffer (generate-new-buffer " *etaf-v2-report-identity*"))
(etaf-render-port--selected-port (etaf-render-port--v1-fallback))) initial-stage-report update-stage-report)
(unwind-protect (unwind-protect
(cl-letf (((symbol-function 'ebox-surface-buffer-revision) nil)) (let ((initial-report
(etaf-render-port-initial (etaf-render-port-initial
buffer (ebox-build '(box "one")) #'ignore #'ignore) buffer (ebox-build '(box "one"))
(should (= (etaf-render-port-revision buffer) 1)) (lambda (report) (setq initial-stage-report report))
(let ((report #'ignore)))
(should (eq initial-report initial-stage-report))
(let ((update-report
(etaf-render-port-update (etaf-render-port-update
buffer (ebox-build '(box "two")) #'ignore #'ignore))) buffer (ebox-build '(box "two"))
(lambda (report) (setq update-stage-report report))
#'ignore)))
(should (eq update-report update-stage-report))
(should (= (etaf-render-port-revision buffer) (should (= (etaf-render-port-revision buffer)
(plist-get report :surface-revision)))) (plist-get update-report :surface-revision)))))
(with-current-buffer buffer
(setq-local etaf-render-port--v1-committed-revision nil))
(should-error (etaf-render-port-revision buffer) :type 'error))
(when (and (buffer-live-p buffer)
(ebox-surface-buffer-mounted-p buffer))
(ebox-unmount-buffer buffer))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest etaf-render-port-v1-missing-update-revision-fails-later ()
"A committed v1 update may finish, but missing revision evidence fails closed."
(let ((buffer (generate-new-buffer " *etaf-v1-missing-revision*"))
(etaf-render-port--selected-port (etaf-render-port--v1-fallback))
(report (list :strategy 'injected-without-revision)))
(unwind-protect
(progn
(etaf-render-port-initial
buffer (ebox-build '(box "one")) #'ignore #'ignore)
(cl-letf (((symbol-function 'ebox-commit)
(lambda (_buffer _input framework-stage _rollback)
(funcall framework-stage report)
report)))
(should
(eq (etaf-render-port-update
buffer (ebox-build '(box "two")) #'ignore #'ignore)
report)))
(should-error (etaf-render-port-revision buffer) :type 'error))
(when (and (buffer-live-p buffer) (when (and (buffer-live-p buffer)
(ebox-surface-buffer-mounted-p buffer)) (ebox-surface-buffer-mounted-p buffer))
(ebox-unmount-buffer buffer)) (ebox-unmount-buffer buffer))
@ -499,6 +454,15 @@
"(ebox-surface-")) "(ebox-surface-"))
(should-not (string-match-p (regexp-quote call) source)))))))) (should-not (string-match-p (regexp-quote call) source))))))))
(ert-deftest etaf-render-port-production-has-no-v1-render-route ()
"Production ETAF contains no retired render-port policy or v1 helper."
(dolist (file (directory-files etaf-render-port-test--root t "\\.el\\'"))
(with-temp-buffer
(insert-file-contents file)
(let ((source (buffer-string)))
(should-not (string-match-p "etaf-render-port-selection-policy" source))
(should-not (string-match-p "etaf-render-port--v1" source))))))
(ert-deftest etaf-render-port-routes-standalone-renderer-mount () (ert-deftest etaf-render-port-routes-standalone-renderer-mount ()
"The no-Runtime compatibility mount uses the immutable selected port." "The no-Runtime compatibility mount uses the immutable selected port."
(require 'etaf-renderer) (require 'etaf-renderer)
@ -539,12 +503,9 @@
(ert-deftest etaf-render-port-selected-port-is-process-stable () (ert-deftest etaf-render-port-selected-port-is-process-stable ()
"Every downstream read returns the one bootstrap-selected port identity." "Every downstream read returns the one bootstrap-selected port identity."
(let* ((selected (etaf-render-port-selected)) (let ((selected (etaf-render-port-selected)))
(route (etaf-render-port-route selected))) (should (eq selected (etaf-render-port-selected)))
(let ((etaf-render-port-selection-policy (if (eq route 'v1) 'v2 'v1))) (should (eq (etaf-render-port-route selected) 'v2))))
(should (eq selected (etaf-render-port-selected)))
(should (eq route
(etaf-render-port-route (etaf-render-port-selected)))))))
(provide 'etaf-render-port-tests) (provide 'etaf-render-port-tests)

2
tests/fixtures/etaf-m0a-condition-consumers.sexp vendored
View File

@ -11,8 +11,6 @@
(:file "etaf-reactive.el" :form condition-case :conditions (error quit) :owner etaf-reactive :policy generic-containment) (:file "etaf-reactive.el" :form condition-case :conditions (error quit) :owner etaf-reactive :policy generic-containment)
(:file "etaf-reactive.el" :form condition-case :conditions (error quit) :owner etaf-reactive :policy generic-containment) (:file "etaf-reactive.el" :form condition-case :conditions (error quit) :owner etaf-reactive :policy generic-containment)
(:file "etaf-render-port.el" :form condition-case :conditions (error quit) :owner etaf-render-port :policy generic-containment) (:file "etaf-render-port.el" :form condition-case :conditions (error quit) :owner etaf-render-port :policy generic-containment)
(:file "etaf-render-port.el" :form condition-case :conditions (error quit) :owner etaf-render-port :policy generic-containment)
(:file "etaf-render-port.el" :form condition-case :conditions (error quit) :owner etaf-render-port :policy generic-containment)
(:file "etaf-render-port.el" :form condition-case :conditions (etaf-spi-incompatible-error etaf-spi-bootstrap-error) :owner etaf-render-port :policy specific-compatibility) (:file "etaf-render-port.el" :form condition-case :conditions (etaf-spi-incompatible-error etaf-spi-bootstrap-error) :owner etaf-render-port :policy specific-compatibility)
(:file "etaf-resource.el" :form condition-case :conditions (error) :owner etaf-resource :policy generic-containment) (:file "etaf-resource.el" :form condition-case :conditions (error) :owner etaf-resource :policy generic-containment)
(:file "etaf-resource.el" :form condition-case :conditions (error) :owner etaf-resource :policy generic-containment) (:file "etaf-resource.el" :form condition-case :conditions (error) :owner etaf-resource :policy generic-containment)