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

fix(render-port): close compatibility rollback gaps

Browse Source
This commit is contained in:
Kinneyzhang 2026-09-01 05:00:10 +08:00
parent b631ffa9f1
commit 35b309a1a9
5 changed files with 257 additions and 27 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

112
etaf-render-port.el
View File

@ -259,6 +259,59 @@
(signal 'wrong-type-argument (list 'functionp framework-rollback))) (signal 'wrong-type-argument (list 'functionp framework-rollback)))
t) t)
(defvar-local etaf-render-port--v1-cleanup-diagnostics nil
"Contained cleanup failures from the latest failed v1 initial operation.")
(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)
:narrowed-p narrowed-p
:narrow-start start
:narrow-end end
:read-only buffer-read-only
:modified-p (buffer-modified-p))))))
(defun etaf-render-port--v1-restore-buffer (buffer snapshot)
"Restore BUFFER exactly from a pre-render v1 SNAPSHOT."
(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)
(erase-buffer)
(insert (plist-get snapshot :contents))
(goto-char (min (point-max)
(max (point-min) (plist-get snapshot :point))))
(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))))
(setq buffer-read-only (plist-get snapshot :read-only))
(set-buffer-modified-p (plist-get snapshot :modified-p))))
buffer)
(defun etaf-render-port--v1-cleanup-step (phase function)
"Run v1 cleanup FUNCTION and return a diagnostic for failure at PHASE."
(let ((inhibit-quit t) (quit-flag nil))
(condition-case condition
(progn (funcall function) nil)
((error quit)
(list :phase phase :condition (copy-tree condition))))))
(defun etaf-render-port--v1-initial (defun etaf-render-port--v1-initial
(buffer input framework-stage framework-rollback &optional observer) (buffer input framework-stage framework-rollback &optional observer)
"Publish INPUT initially to BUFFER through legacy Ebox. "Publish INPUT initially to BUFFER through legacy Ebox.
@ -267,8 +320,16 @@ manual framework cleanup if staging fails. OBSERVER, when non-nil, is passed
through Ebox's legacy initial option." through Ebox's legacy initial option."
(etaf-render-port--validate-framework-pair (etaf-render-port--validate-framework-pair
framework-stage framework-rollback) framework-stage framework-rollback)
(let ((result (ebox-render-to-buffer (let* ((buffer (get-buffer-create buffer))
buffer input (and observer (list :observer observer)))) (snapshot (etaf-render-port--v1-buffer-snapshot buffer))
(result
(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))
(ebox-render-to-buffer
buffer input (and observer (list :observer observer)))))
stage-entered) stage-entered)
(condition-case primary (condition-case primary
(progn (progn
@ -277,13 +338,32 @@ through Ebox's legacy initial option."
result) result)
((error quit) ((error quit)
(when stage-entered (when stage-entered
(when (and observer (buffer-live-p (get-buffer buffer)) (let (diagnostics)
(ebox-surface-buffer-mounted-p (get-buffer buffer))) (dolist
(ebox-buffer-set-observer buffer nil)) (entry
(let ((inhibit-quit t) (quit-flag nil)) `((framework-rollback
(condition-case nil ,(lambda () (funcall framework-rollback nil)))
(funcall framework-rollback nil) (observer-detach
((error quit) nil)))) ,(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))))
(buffer-restore
,(lambda ()
(etaf-render-port--v1-restore-buffer buffer snapshot)))))
(when-let* ((diagnostic
(etaf-render-port--v1-cleanup-step
(car entry) (cadr entry))))
(push diagnostic diagnostics)))
(when (buffer-live-p buffer)
(with-current-buffer buffer
(setq-local etaf-render-port--v1-cleanup-diagnostics
(nreverse diagnostics))))))
(signal (car primary) (cdr primary)))))) (signal (car primary) (cdr primary))))))
(defun etaf-render-port--v1-update (defun etaf-render-port--v1-update
@ -394,10 +474,16 @@ FRAMEWORK-STAGE and FRAMEWORK-ROLLBACK are one required callback pair."
(ebox-surface-buffer-mounted-p buffer)) (ebox-surface-buffer-mounted-p buffer))
(defun etaf-render-port-revision (buffer) (defun etaf-render-port-revision (buffer)
"Return BUFFER's latest committed Ebox surface revision, or zero." "Return BUFFER's committed Ebox revision, or zero when it is unmounted."
(condition-case nil (let ((buffer (get-buffer buffer)))
(or (plist-get (ebox-buffer-update-report buffer) :surface-revision) 0) (if (not (and (buffer-live-p buffer)
(error 0))) (ebox-surface-buffer-mounted-p buffer)))
0
(let ((revision (ebox-surface-buffer-revision buffer)))
(unless (and (integerp revision) (>= revision 0))
(error "Mounted Ebox surface has no committed revision: %S"
revision))
revision))))
(provide 'etaf-render-port) (provide 'etaf-render-port)

35
tests/etaf-generation-tests.el
View File

@ -324,6 +324,41 @@
(when-let* ((buffer (get-buffer buffer-name))) (when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer))))) (kill-buffer buffer)))))
(ert-deftest etaf-semantic-ebox-report-finalization-fault-does-not-rollback ()
"A postaccept Ebox report fault still commits ETAF generation and buffer."
(let ((buffer-name " *etaf-ebox-report-postaccept-test*")
(source (etaf-ref 0))
(rollback-count 0))
(unwind-protect
(progn
(etaf-mount
buffer-name
(etaf--view-call 'etaf-generation-test-visible
(list :source source) nil))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(generation (etaf-runtime-generation runtime))
(original-rollback
(symbol-function 'etaf-semantic-candidate-rollback)))
(cl-letf
(((symbol-function 'ebox-surface--participant-complete)
(lambda (&rest _arguments)
(error "injected Ebox report finalization fault")))
((symbol-function 'etaf-semantic-candidate-rollback)
(lambda (candidate)
(cl-incf rollback-count)
(funcall original-rollback candidate))))
(setf (etaf-value source) 1))
(should (zerop rollback-count))
(should (= (1+ generation)
(etaf-runtime-generation runtime)))
(should (equal "value=1"
(with-current-buffer buffer-name
(buffer-string))))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-semantic-render-rollback-restores-all-authority-in-callback () (ert-deftest etaf-semantic-render-rollback-restores-all-authority-in-callback ()
"Framework rollback restores token, stores, and journals before TP returns." "Framework rollback restores token, stores, and journals before TP returns."
(let ((buffer-name " *etaf-semantic-render-rollback-test*") (let ((buffer-name " *etaf-semantic-render-rollback-test*")

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

@ -101,6 +101,39 @@
(when-let* ((buffer (get-buffer buffer-name))) (when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))) (kill-buffer buffer))))))
(ert-deftest etaf-host-postaccept-report-fault-still-finishes-attach ()
"Ebox report-finalization failure cannot roll back an accepted Host."
(let ((buffer-name " *etaf-host-report-postaccept-test*")
(source (etaf-ref 0))
(rollback-count 0)
(original-rollback
(symbol-function 'etaf-semantic-candidate-rollback)))
(unwind-protect
(progn
(cl-letf
(((symbol-function 'ebox-surface--participant-complete)
(lambda (&rest _arguments)
(error "injected initial report finalization fault")))
((symbol-function 'etaf-semantic-candidate-rollback)
(lambda (candidate)
(cl-incf rollback-count)
(funcall original-rollback candidate))))
(etaf-mount
buffer-name
(etaf--view-call 'etaf-host-test-component
(list :source source) nil)))
(let* ((runtime (etaf-runtime-for-buffer buffer-name))
(authority (etaf-runtime-host-authority runtime)))
(should runtime)
(should (etaf-host-authority-attached-p authority))
(should (zerop rollback-count))
(should (ebox-surface-buffer-mounted-p
(get-buffer buffer-name)))))
(when-let* ((runtime (etaf-runtime-for-buffer buffer-name)))
(etaf-unmount runtime))
(when-let* ((buffer (get-buffer buffer-name)))
(kill-buffer buffer)))))
(ert-deftest etaf-host-unmount-invalidates-before-component-cleanup () (ert-deftest etaf-host-unmount-invalidates-before-component-cleanup ()
"Explicit unmount invalidates Host token before any Component hook runs." "Explicit unmount invalidates Host token before any Component hook runs."
(let ((buffer-name " *etaf-host-unmount-boundary-test*") (let ((buffer-name " *etaf-host-unmount-boundary-test*")

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

@ -117,19 +117,96 @@
(ert-deftest etaf-render-port-v1-initial-runs-manual-framework-cleanup () (ert-deftest etaf-render-port-v1-initial-runs-manual-framework-cleanup ()
"A failed legacy initial stage invokes its paired cleanup exactly once." "A failed legacy initial stage invokes its paired cleanup exactly once."
(let (trace) (let ((buffer (generate-new-buffer " *etaf-v1-manual-cleanup*")) trace)
(cl-letf (((symbol-function 'ebox-render-to-buffer) (unwind-protect
(lambda (&rest _arguments) (cl-letf (((symbol-function 'ebox-render-to-buffer)
(push 'render trace) (lambda (&rest _arguments)
'rendered-buffer))) (push 'render trace)
(should-error buffer)))
(etaf-render-port--v1-initial (should-error
'buffer 'input (etaf-render-port--v1-initial
(lambda (_report) buffer 'input
(push 'stage trace) (lambda (_report)
(error "injected v1 initial failure")) (push 'stage trace)
(lambda (_report) (push 'rollback trace)))) (error "injected v1 initial failure"))
(should (equal (nreverse trace) '(render stage rollback)))))) (lambda (_report) (push 'rollback trace))))
(should (equal (nreverse trace) '(render stage rollback))))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest etaf-render-port-v1-initial-restores-real-ebox-surface ()
"A failed legacy stage removes Ebox authority and restores buffer content."
(let ((buffer (generate-new-buffer " *etaf-v1-real-cleanup*"))
(input (ebox-build '(box "committed")))
(rollback-count 0)
captured)
(unwind-protect
(progn
(with-current-buffer buffer (insert "sentinel"))
(condition-case condition
(etaf-render-port--v1-initial
buffer input
(lambda (_report)
(error "injected real v1 stage failure"))
(lambda (_report) (cl-incf rollback-count)))
(error (setq captured condition)))
(should (equal captured '(error "injected real v1 stage failure")))
(should (= rollback-count 1))
(should-not (ebox-surface-buffer-mounted-p buffer))
(should-not (ebox-surface-buffer-observer buffer))
(should (equal "sentinel"
(with-current-buffer buffer (buffer-string))))
(should-not
(etaf-render-port-v1-cleanup-diagnostics buffer)))
(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-cleanup-fault-keeps-primary-and-continues ()
"A secondary v1 cleanup fault is diagnosed while Ebox cleanup continues."
(let ((buffer (generate-new-buffer " *etaf-v1-cleanup-fault*"))
(input (ebox-build '(box "committed")))
captured)
(unwind-protect
(progn
(with-current-buffer buffer (insert "before"))
(condition-case condition
(etaf-render-port--v1-initial
buffer input
(lambda (_report) (error "primary stage failure"))
(lambda (_report) (error "secondary rollback failure")))
(error (setq captured condition)))
(should (equal captured '(error "primary stage failure")))
(should-not (ebox-surface-buffer-mounted-p buffer))
(should (equal "before"
(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)
(ebox-surface-buffer-mounted-p buffer))
(ebox-unmount-buffer buffer))
(when (buffer-live-p buffer) (kill-buffer buffer)))))
(ert-deftest etaf-render-port-revision-fails-closed-for-mounted-surface ()
"Revision is zero only without a mount; mounted lookup errors stay visible."
(let ((buffer (generate-new-buffer " *etaf-revision-contract*")))
(unwind-protect
(progn
(should (zerop (etaf-render-port-revision buffer)))
(ebox-render-to-buffer buffer (ebox-build '(box "mounted")))
(should (> (etaf-render-port-revision buffer) 0))
(cl-letf (((symbol-function 'ebox-surface-buffer-revision)
(lambda (_buffer) (error "injected report failure"))))
(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-is-the-only-protocol-probe-owner () (ert-deftest etaf-render-port-is-the-only-protocol-probe-owner ()
"No downstream ETAF module probes Ebox framework SPI protocol state." "No downstream ETAF module probes Ebox framework SPI protocol state."

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

@ -13,7 +13,6 @@
(: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-render-port.el" :form condition-case :conditions (error) :owner etaf-render-port :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) (:file "etaf-resource.el" :form condition-case :conditions (error) :owner etaf-resource :policy generic-containment)
(:file "etaf-retirement.el" :form condition-case :conditions (error quit) :owner etaf-retirement :policy generic-containment) (:file "etaf-retirement.el" :form condition-case :conditions (error quit) :owner etaf-retirement :policy generic-containment)