fix(render-port): close compatibility rollback gaps
This commit is contained in:
parent
b631ffa9f1
commit
35b309a1a9
@ -259,6 +259,59 @@
|
||||
(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.")
|
||||
|
||||
(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
|
||||
(buffer input framework-stage framework-rollback &optional observer)
|
||||
"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."
|
||||
(etaf-render-port--validate-framework-pair
|
||||
framework-stage framework-rollback)
|
||||
(let ((result (ebox-render-to-buffer
|
||||
buffer input (and observer (list :observer observer))))
|
||||
(let* ((buffer (get-buffer-create buffer))
|
||||
(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)
|
||||
(condition-case primary
|
||||
(progn
|
||||
@ -277,13 +338,32 @@ through Ebox's legacy initial option."
|
||||
result)
|
||||
((error quit)
|
||||
(when stage-entered
|
||||
(when (and observer (buffer-live-p (get-buffer buffer))
|
||||
(ebox-surface-buffer-mounted-p (get-buffer buffer)))
|
||||
(ebox-buffer-set-observer buffer nil))
|
||||
(let ((inhibit-quit t) (quit-flag nil))
|
||||
(condition-case nil
|
||||
(funcall framework-rollback nil)
|
||||
((error quit) nil))))
|
||||
(let (diagnostics)
|
||||
(dolist
|
||||
(entry
|
||||
`((framework-rollback
|
||||
,(lambda () (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))))
|
||||
(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))))))
|
||||
|
||||
(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))
|
||||
|
||||
(defun etaf-render-port-revision (buffer)
|
||||
"Return BUFFER's latest committed Ebox surface revision, or zero."
|
||||
(condition-case nil
|
||||
(or (plist-get (ebox-buffer-update-report buffer) :surface-revision) 0)
|
||||
(error 0)))
|
||||
"Return BUFFER's committed Ebox revision, or zero when it is unmounted."
|
||||
(let ((buffer (get-buffer buffer)))
|
||||
(if (not (and (buffer-live-p buffer)
|
||||
(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)
|
||||
|
||||
|
||||
@ -324,6 +324,41 @@
|
||||
(when-let* ((buffer (get-buffer buffer-name)))
|
||||
(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 ()
|
||||
"Framework rollback restores token, stores, and journals before TP returns."
|
||||
(let ((buffer-name " *etaf-semantic-render-rollback-test*")
|
||||
|
||||
@ -101,6 +101,39 @@
|
||||
(when-let* ((buffer (get-buffer buffer-name)))
|
||||
(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 ()
|
||||
"Explicit unmount invalidates Host token before any Component hook runs."
|
||||
(let ((buffer-name " *etaf-host-unmount-boundary-test*")
|
||||
|
||||
@ -117,19 +117,96 @@
|
||||
|
||||
(ert-deftest etaf-render-port-v1-initial-runs-manual-framework-cleanup ()
|
||||
"A failed legacy initial stage invokes its paired cleanup exactly once."
|
||||
(let (trace)
|
||||
(cl-letf (((symbol-function 'ebox-render-to-buffer)
|
||||
(lambda (&rest _arguments)
|
||||
(push 'render trace)
|
||||
'rendered-buffer)))
|
||||
(should-error
|
||||
(etaf-render-port--v1-initial
|
||||
'buffer 'input
|
||||
(lambda (_report)
|
||||
(push 'stage trace)
|
||||
(error "injected v1 initial failure"))
|
||||
(lambda (_report) (push 'rollback trace))))
|
||||
(should (equal (nreverse trace) '(render stage rollback))))))
|
||||
(let ((buffer (generate-new-buffer " *etaf-v1-manual-cleanup*")) trace)
|
||||
(unwind-protect
|
||||
(cl-letf (((symbol-function 'ebox-render-to-buffer)
|
||||
(lambda (&rest _arguments)
|
||||
(push 'render trace)
|
||||
buffer)))
|
||||
(should-error
|
||||
(etaf-render-port--v1-initial
|
||||
buffer 'input
|
||||
(lambda (_report)
|
||||
(push 'stage trace)
|
||||
(error "injected v1 initial failure"))
|
||||
(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 ()
|
||||
"No downstream ETAF module probes Ebox framework SPI protocol state."
|
||||
|
||||
@ -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 (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-retirement.el" :form condition-case :conditions (error quit) :owner etaf-retirement :policy generic-containment)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user