fix(runtime): preserve rollback custody and scheduler tails

etaf-reactive.el

@@ -127,9 +127,12 @@ Runtime, watchers run synchronously.")
        (etaf-runtime-route-active-p route)
        (let ((predicate (etaf-runtime-route-accepts-p route)))
          (or (null predicate)
-             (condition-case nil
+             (condition-case condition
                  (funcall predicate route)
-               ((error quit) nil))))))
+               ((error quit)
+                (etaf-scheduler-record-route-authority-fault
+                 (etaf--subscriber-scheduler-context route) condition)
+                nil))))))
 
 (defun etaf-reactive-enqueue-runtime-flush
     (runtime function &optional scheduler-context)
@@ -142,20 +145,27 @@ The default context preserves the legacy two-argument facade."
 (defun etaf--dispatch-subscriber-group
     (context source _projection-epoch subscribers)
   "Notify SOURCE SUBSCRIBERS already grouped for scheduler CONTEXT."
-  (dolist (subscriber subscribers)
+  (let (first-condition)
-    (etaf-scheduler-record-subscriber-visit context)
+    (dolist (subscriber subscribers)
-    (cond
+      (etaf-scheduler-record-subscriber-visit context)
-     ((etaf-runtime-route-p subscriber)
+      (condition-case condition
-      (if (etaf-runtime-route-live-p subscriber)
+          (cond
-          (funcall (etaf-runtime-route-scheduler subscriber)
+           ((etaf-runtime-route-p subscriber)
-                   subscriber source)
+            (if (etaf-runtime-route-live-p subscriber)
-        (etaf-scheduler-record-stale-route-drop context)))
+                (funcall (etaf-runtime-route-scheduler subscriber)
-     ((and (etaf-effect-p subscriber)
+                         subscriber source)
-           (etaf-effect-active-p subscriber)
+              (etaf-scheduler-record-stale-route-drop context)))
-           (etaf-scheduler-claim-effect context subscriber))
+           ((and (etaf-effect-p subscriber)
-      (if-let* ((scheduler (etaf-effect-scheduler subscriber)))
+                 (etaf-effect-active-p subscriber)
-          (funcall scheduler subscriber)
+                 (etaf-scheduler-claim-effect context subscriber))
-        (etaf-reactive-effect-run subscriber))))))
+            (if-let* ((scheduler (etaf-effect-scheduler subscriber)))
+                (funcall scheduler subscriber)
+              (etaf-reactive-effect-run subscriber))))
+        ((error quit)
+         (unless first-condition
+           (setq first-condition condition)))))
+    (when first-condition
+      (signal (car first-condition) (cdr first-condition)))))
 
 (defun etaf--reactive-same-p (left right)
   "Return whether LEFT and RIGHT are equal under ETAF's shallow rule."

etaf-render-port.el

@@ -286,39 +286,153 @@
         (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))))))
+              :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)
+(defun etaf-render-port--v1-restore-buffer
-  "Restore BUFFER exactly from a pre-render v1 SNAPSHOT."
+    (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)
-      (erase-buffer)
+      (when restore-contents-p
-      (insert (plist-get snapshot :contents))
+        (let ((buffer-undo-list t))
-      (goto-char (min (point-max)
+          (erase-buffer)
-                      (max (point-min) (plist-get snapshot :point))))
+          (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))))
+      (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-step (phase function)
+(defun etaf-render-port--v1-cleanup-failed-initial
-  "Run v1 cleanup FUNCTION and return a diagnostic for failure at PHASE."
+    (buffer snapshot change-group change-group-active-p stage-entered
-  (let ((inhibit-quit t) (quit-flag nil))
+            observer framework-rollback)
-    (condition-case condition
+  "Clean one failed legacy initial operation and return diagnostics.
-        (progn (funcall function) nil)
+BUFFER and SNAPSHOT identify editor custody.  CHANGE-GROUP-ACTIVE-P says
-      ((error quit)
+whether CHANGE-GROUP still needs cancellation.  STAGE-ENTERED controls the
-       (list :phase phase :condition (copy-tree condition))))))
+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."
@@ -350,60 +464,53 @@ through Ebox's legacy initial option."
    framework-stage framework-rollback)
   (let* ((buffer (get-buffer-create buffer))
          (snapshot (etaf-render-port--v1-buffer-snapshot buffer))
-         (result
+         (change-group (with-current-buffer buffer (prepare-change-group)))
-          (progn
+         result stage-entered operation-started-p change-group-active-p
-            (when (ebox-surface-buffer-mounted-p buffer)
+         cleanup-ran-p)
-              (error "Legacy Ebox initial operation requires an unmounted buffer"))
+    (cl-labels
-            (with-current-buffer buffer
+        ((cleanup
-              (setq-local etaf-render-port--v1-cleanup-diagnostics nil
+          ()
-                          etaf-render-port--v1-committed-revision nil))
+          (unless cleanup-ran-p
-            (ebox-render-to-buffer
+            (setq cleanup-ran-p t)
-             buffer input (and observer (list :observer observer)))))
+            (when operation-started-p
-        stage-entered)
+              (let ((active-p change-group-active-p))
-    (condition-case primary
+                (setq change-group-active-p nil)
-        (progn
+                (etaf-render-port--v1-cleanup-failed-initial
-          (setq stage-entered t)
+                 buffer snapshot change-group active-p stage-entered
-          (funcall framework-stage nil)
+                 observer framework-rollback))))))
-          ;; TP surfaces start at committed revision one.  Legacy Ebox does
+      (unwind-protect
-          ;; not expose its surface handle, so ETAF owns this compatibility
+          (condition-case primary
-          ;; evidence and advances it from later update reports.
+              (progn
-          (etaf-render-port--v1-record-revision buffer 1)
+                (when (ebox-surface-buffer-mounted-p buffer)
-          result)
+                  (error
-      ((error quit)
+                   "Legacy Ebox initial operation requires an unmounted buffer"))
-       (when stage-entered
+                (with-current-buffer buffer
-         (let (diagnostics)
+                  (setq-local etaf-render-port--v1-cleanup-diagnostics nil
-           (dolist
+                              etaf-render-port--v1-committed-revision nil)
-               (entry
+                  (activate-change-group change-group)
-                `((framework-rollback
+                  (setq operation-started-p t
-                   ,(lambda () (funcall framework-rollback nil)))
+                        change-group-active-p t)
-                  (observer-detach
+                  (save-restriction
-                   ,(lambda ()
+                    (widen)
-                      (when (and observer (buffer-live-p buffer)
+                    (setq result
-                                 (ebox-surface-buffer-mounted-p buffer))
+                          (ebox-render-to-buffer
-                        (ebox-buffer-set-observer buffer nil))))
+                           buffer input
-                  (ebox-unmount
+                           (and observer (list :observer observer))))))
-                   ,(lambda ()
+                (setq stage-entered t)
-                      (when (and (buffer-live-p buffer)
+                (funcall framework-stage nil)
-                                 (ebox-surface-buffer-mounted-p buffer))
+                (with-current-buffer buffer
-                        (ebox-unmount-buffer buffer))))
+                  (accept-change-group change-group))
-                  (revision-reset
+                (setq change-group-active-p nil)
-                   ,(lambda ()
+                ;; TP surfaces start at committed revision one.  Legacy Ebox
-                      (when (buffer-live-p buffer)
+                ;; does not expose its surface handle, so ETAF owns this
-                        (with-current-buffer buffer
+                ;; compatibility evidence and advances it from update reports.
-                          (setq-local
+                (etaf-render-port--v1-record-revision buffer 1)
-                           etaf-render-port--v1-committed-revision nil)))))
+                result)
-                  (buffer-restore
+            ((error quit)
-                   ,(lambda ()
+             (cleanup)
-                      (etaf-render-port--v1-restore-buffer buffer snapshot)))))
+             (signal (car primary) (cdr primary))))
-             (when-let* ((diagnostic
+        (when change-group-active-p
-                          (etaf-render-port--v1-cleanup-step
+          (cleanup))))))
-                           (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
     (buffer input framework-stage framework-rollback)
@@ -535,7 +642,7 @@ FRAMEWORK-STAGE and FRAMEWORK-ROLLBACK are one required callback pair."
               (etaf-render-port-revision-function
                etaf-render-port--selected-port)
               buffer)))
-        (unless (and (integerp revision) (>= revision 0))
+        (unless (and (integerp revision) (> revision 0))
           (error "Mounted Ebox surface has no committed revision: %S"
                  revision))
         revision))))

etaf-scheduler.el

@@ -367,8 +367,9 @@ DELIVERY receives CONTEXT, SOURCE, and the projection epoch."
           (max 0 (1- (etaf-scheduler-context-busy-depth context))))))
 
 (defun etaf-scheduler--drain-context-sources (context projection-id)
-  "Drain one snapshotted CONTEXT source turn for PROJECTION-ID."
+  "Drain one CONTEXT source turn and return its first condition.
-  (let ((turn (etaf-scheduler-context-source-queue context)))
+PROJECTION-ID identifies the bounded projection owning the detached turn."
+  (let ((turn (etaf-scheduler-context-source-queue context)) first-condition)
     ;; New sources discovered by TURN belong to the next bounded scheduler
     ;; turn.  Detaching the current FIFO prevents a chain of distinct source
     ;; identities from monopolizing one unbudgeted drain.
@@ -387,7 +388,12 @@ DELIVERY receives CONTEXT, SOURCE, and the projection epoch."
                     (etaf-scheduler-context-delivered-source-set context))
            (cl-incf (etaf-scheduler-context-source-delivery-count context))
            (when delivery
-             (funcall delivery context source projection-id))))))))
+             (condition-case condition
+                 (funcall delivery context source projection-id)
+               ((error quit)
+                (unless first-condition
+                  (setq first-condition condition)))))))))
+    first-condition))
 
 (defun etaf-scheduler--detach-runtime-turns (projection)
   "Detach and return PROJECTION's Runtime queues in context order."
@@ -420,18 +426,35 @@ DELIVERY receives CONTEXT, SOURCE, and the projection epoch."
                   (setq first-condition condition)))))))))
     first-condition))
 
-(defun etaf-scheduler--record-fault (context projection-id condition)
+(defun etaf-scheduler--record-fault
-  "Record CONTEXT failure CONDITION for PROJECTION-ID."
+    (context projection-id condition &optional phase)
+  "Record CONTEXT failure CONDITION for PROJECTION-ID and optional PHASE."
   (setf (etaf-scheduler-context-fault-state context) (copy-tree condition))
   (cl-incf (etaf-scheduler-context-projection-fault-count context))
-  (push (list :projection-epoch projection-id
+  (push (append (list :projection-epoch projection-id
-              :turn-id (etaf-scheduler-context-active-turn-id context)
+                      :turn-id
-              :condition (copy-tree condition))
+                      (etaf-scheduler-context-active-turn-id context))
+                (and phase (list :phase phase))
+                (list :condition (copy-tree condition)))
         (etaf-scheduler-context-diagnostics context))
   (when (> (length (etaf-scheduler-context-diagnostics context)) 64)
     (setcdr (nthcdr 63 (etaf-scheduler-context-diagnostics context)) nil))
   condition)
 
+(defun etaf-scheduler-record-route-authority-fault (context condition)
+  "Record contained Host route authority CONDITION in scheduler CONTEXT."
+  (setq context (etaf-scheduler-context-resolve context))
+  (unless (consp condition)
+    (signal 'wrong-type-argument (list 'consp condition)))
+  (when etaf-scheduler--active-projection
+    (etaf-scheduler--append-context etaf-scheduler--active-projection context))
+  (etaf-scheduler--record-fault
+   context
+   (if etaf-scheduler--active-projection
+       (etaf-scheduler--projection-id etaf-scheduler--active-projection)
+     (etaf-scheduler-context-projection-epoch context))
+   condition 'route-authority))
+
 (defun etaf-scheduler--drain-projection (projection)
   "Drain PROJECTION source-first and re-signal its first context fault."
   (let ((projection-id (etaf-scheduler--projection-id projection))
@@ -456,8 +479,11 @@ DELIVERY receives CONTEXT, SOURCE, and the projection epoch."
                   (progn
                     (etaf-scheduler--mark-turn
                      context projection-id marked-contexts context-steps)
-                    (etaf-scheduler--drain-context-sources
+                    (when-let* ((source-condition
-                     context projection-id))
+                                 (etaf-scheduler--drain-context-sources
+                                  context projection-id)))
+                      (signal (car source-condition)
+                              (cdr source-condition))))
                 ((error quit)
                  (puthash context t failed-contexts)
                  (unless first-condition (setq first-condition condition))

tests/etaf-render-port-tests.el

@@ -166,6 +166,186 @@
         (ebox-unmount-buffer buffer))
       (when (buffer-live-p buffer) (kill-buffer buffer)))))
 
+(ert-deftest etaf-render-port-v1-failure-restores-exact-editor-custody ()
+  "Legacy stage rollback preserves Emacs-owned editor identities and undo."
+  (let ((buffer (generate-new-buffer " *etaf-v1-editor-custody*"))
+        (input (ebox-build '(box "committed")))
+        overlay left-marker right-marker snapshot captured)
+    (unwind-protect
+        (progn
+          (with-current-buffer buffer
+            (buffer-enable-undo)
+            (insert (propertize "sentinel" 'face 'bold))
+            (undo-boundary)
+            (goto-char 4)
+            (set-mark 2)
+            (setq mark-active t)
+            (setq overlay (make-overlay 2 6 buffer t t)
+                  left-marker (copy-marker 3 nil)
+                  right-marker (copy-marker 5 t))
+            (overlay-put overlay 'etaf-test-property '(owned value))
+            (narrow-to-region 2 7)
+            (set-buffer-modified-p nil)
+            (setq snapshot
+                  (list
+                   :contents
+                   (save-restriction
+                     (widen)
+                     (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
+                   :narrow-start (point-min)
+                   :narrow-end (point-max)
+                   :overlay-start (overlay-start overlay)
+                   :overlay-end (overlay-end overlay)
+                   :overlay-properties (overlay-properties overlay)
+                   :left-position (marker-position left-marker)
+                   :left-insertion-type (marker-insertion-type left-marker)
+                   :right-position (marker-position right-marker)
+                   :right-insertion-type (marker-insertion-type right-marker)
+                   :undo-list (copy-tree buffer-undo-list)
+                   :modified-p (buffer-modified-p))))
+          (condition-case condition
+              (etaf-render-port--v1-initial
+               buffer input
+               (lambda (_report) (error "editor custody primary"))
+               #'ignore)
+            (error (setq captured condition)))
+          (should (equal captured '(error "editor custody primary")))
+          (should-not (ebox-surface-buffer-mounted-p buffer))
+          (should-not (ebox-surface-buffer-observer buffer))
+          (with-current-buffer buffer
+            (should
+             (equal (save-restriction
+                      (widen)
+                      (buffer-substring (point-min) (point-max)))
+                    (plist-get snapshot :contents)))
+            (should (= (point) (plist-get snapshot :point)))
+            (should (eq (mark-marker) (plist-get snapshot :mark-marker)))
+            (should (= (mark t) (plist-get snapshot :mark-position)))
+            (should
+             (eq (marker-insertion-type (mark-marker))
+                 (plist-get snapshot :mark-insertion-type)))
+            (should (eq mark-active (plist-get snapshot :mark-active)))
+            (should (= (point-min) (plist-get snapshot :narrow-start)))
+            (should (= (point-max) (plist-get snapshot :narrow-end)))
+            (should (overlayp overlay))
+            (should (eq (overlay-buffer overlay) buffer))
+            (should (= (overlay-start overlay)
+                       (plist-get snapshot :overlay-start)))
+            (should (= (overlay-end overlay)
+                       (plist-get snapshot :overlay-end)))
+            (should (equal (overlay-properties overlay)
+                           (plist-get snapshot :overlay-properties)))
+            (should (eq (marker-buffer left-marker) buffer))
+            (should (= (marker-position left-marker)
+                       (plist-get snapshot :left-position)))
+            (should
+             (eq (marker-insertion-type left-marker)
+                 (plist-get snapshot :left-insertion-type)))
+            (should (eq (marker-buffer right-marker) buffer))
+            (should (= (marker-position right-marker)
+                       (plist-get snapshot :right-position)))
+            (should
+             (eq (marker-insertion-type right-marker)
+                 (plist-get snapshot :right-insertion-type)))
+            (should (equal buffer-undo-list (plist-get snapshot :undo-list)))
+            (should (eq (buffer-modified-p)
+                        (plist-get snapshot :modified-p)))))
+      (when (overlayp overlay) (delete-overlay overlay))
+      (when (markerp left-marker) (set-marker left-marker nil))
+      (when (markerp right-marker) (set-marker right-marker nil))
+      (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-nonlocal-exit-runs-exact-cleanup ()
+  "A legacy stage throw cannot escape with mounted or editor state retained."
+  (let ((buffer (generate-new-buffer " *etaf-v1-nonlocal-cleanup*"))
+        (input (ebox-build '(box "committed")))
+        (rollback-count 0))
+    (unwind-protect
+        (progn
+          (with-current-buffer buffer (insert "before"))
+          (should
+           (eq
+            (catch 'etaf-v1-test-escape
+              (etaf-render-port--v1-initial
+               buffer input
+               (lambda (_report)
+                 (throw 'etaf-v1-test-escape 'escaped))
+               (lambda (_report) (cl-incf rollback-count)))
+              'not-escaped)
+            'escaped))
+          (should (= rollback-count 1))
+          (should-not (ebox-surface-buffer-mounted-p buffer))
+          (should-not (ebox-surface-buffer-observer buffer))
+          (should (equal "before"
+                         (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-precondition-keeps-existing-mount ()
+  "Rejecting an already mounted target must not clean up foreign authority."
+  (let ((buffer (generate-new-buffer " *etaf-v1-existing-mount*")))
+    (unwind-protect
+        (progn
+          (ebox-render-to-buffer buffer (ebox-build '(box "existing")))
+          (let ((revision (ebox-surface-buffer-revision buffer)))
+            (should-error
+             (etaf-render-port--v1-initial
+              buffer (ebox-build '(box "replacement")) #'ignore #'ignore)
+             :type 'error)
+            (should (ebox-surface-buffer-mounted-p buffer))
+            (should (= revision (ebox-surface-buffer-revision buffer)))
+            (should (equal "existing"
+                           (with-current-buffer buffer (buffer-string))))))
+      (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-rollback-throw-cannot-stop-cleanup-tail ()
+  "A framework rollback throw still unmounts and restores legacy editor state."
+  (let ((buffer (generate-new-buffer " *etaf-v1-rollback-throw*"))
+        (input (ebox-build '(box "committed"))))
+    (unwind-protect
+        (progn
+          (with-current-buffer buffer (insert "before"))
+          (should
+           (eq
+            (catch 'etaf-v1-rollback-escape
+              (etaf-render-port--v1-initial
+               buffer input
+               (lambda (_report) (error "primary before rollback throw"))
+               (lambda (_report)
+                 (throw 'etaf-v1-rollback-escape 'rollback-escaped)))
+              'not-escaped)
+            'rollback-escaped))
+          (should-not (ebox-surface-buffer-mounted-p buffer))
+          (should-not (ebox-surface-buffer-observer buffer))
+          (should (equal "before"
+                         (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)
+                 (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*"))
@@ -206,6 +386,9 @@
           (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))
+          (cl-letf (((symbol-function 'ebox-surface-buffer-revision)
+                     (lambda (_buffer) 0)))
             (should-error (etaf-render-port-revision buffer) :type 'error)))
       (when (and (buffer-live-p buffer)
                  (ebox-surface-buffer-mounted-p buffer))

tests/etaf-scheduler-tests.el

@@ -266,6 +266,92 @@
                             :runtime-executions)))
     (should (etaf-scheduler-context-idle-p context))))
 
+(ert-deftest etaf-scheduler-source-fault-does-not-suppress-context-tail ()
+  "A failing source delivery cannot discard later sources in the same turn."
+  (let ((context (etaf-scheduler-context-create :name 'source-fault-tail))
+        second-ran captured)
+    (condition-case condition
+        (etaf-scheduler-call-with-projection
+         (lambda ()
+           (etaf-scheduler-enqueue-source
+            context 'first
+            (lambda (_context _source _projection-id)
+              (signal 'etaf-scheduler-test-source-condition '("first"))))
+           (etaf-scheduler-enqueue-source
+            context 'second
+            (lambda (_context _source _projection-id)
+              (setq second-ran t)))))
+      (etaf-scheduler-test-source-condition (setq captured condition)))
+    (should (equal captured
+                   '(etaf-scheduler-test-source-condition "first")))
+    (should second-ran)
+    (should (= 2 (etaf-scheduler-test--metric context :source-deliveries)))
+    (should (etaf-scheduler-context-idle-p context))))
+
+(ert-deftest etaf-scheduler-subscriber-fault-does-not-suppress-group-tail ()
+  "A failing subscriber cannot discard later subscribers in the same source."
+  (let* ((context
+          (etaf-scheduler-context-create :name 'subscriber-fault-tail))
+         second-ran
+         (first
+          (etaf-runtime-route-create
+           :runtime-id 1 :mount-epoch 1 :authority-token 'first
+           :scheduler-context context
+           :scheduler
+           (lambda (_route _source)
+             (signal 'etaf-scheduler-test-source-condition
+                     '("subscriber")))))
+         (second
+          (etaf-runtime-route-create
+           :runtime-id 2 :mount-epoch 1 :authority-token 'second
+           :scheduler-context context
+           :scheduler (lambda (_route _source) (setq second-ran t))))
+         captured)
+    (condition-case condition
+        (etaf-scheduler-call-with-projection
+         (lambda ()
+           (etaf-scheduler-enqueue-source
+            context 'source
+            (lambda (delivery-context source projection-id)
+              (etaf--dispatch-subscriber-group
+               delivery-context source projection-id (list first second))))))
+      (etaf-scheduler-test-source-condition (setq captured condition)))
+    (should (equal captured
+                   '(etaf-scheduler-test-source-condition "subscriber")))
+    (should second-ran)
+    (should (= 2 (etaf-scheduler-test--metric context :subscriber-visits)))
+    (should (etaf-scheduler-context-idle-p context))))
+
+(ert-deftest etaf-scheduler-authority-predicate-fault-is-diagnostic ()
+  "A broken Host authority predicate stays fail-closed and diagnostically visible."
+  (let* ((context
+          (etaf-scheduler-context-create :name 'authority-predicate-fault))
+         (source (etaf-ref 0))
+         scheduled
+         (route
+          (etaf-runtime-route-create
+           :runtime-id 1 :mount-epoch 1 :authority-token 'authority
+           :scheduler-context context
+           :scheduler (lambda (_route _source) (setq scheduled t))
+           :accepts-p
+           (lambda (_route)
+             (signal 'etaf-scheduler-test-condition '("authority"))))))
+    (puthash route t (etaf-ref-subscribers source))
+    (unwind-protect
+        (progn
+          (setf (etaf-value source) 1)
+          (should-not scheduled)
+          (should (= 1 (etaf-scheduler-test--metric
+                        context :stale-route-drops)))
+          (let ((diagnostic
+                 (cl-find 'route-authority
+                          (etaf-scheduler-context-diagnostics context)
+                          :key (lambda (entry) (plist-get entry :phase)))))
+            (should diagnostic)
+            (should (equal (plist-get diagnostic :condition)
+                           '(etaf-scheduler-test-condition "authority")))))
+      (remhash route (etaf-ref-subscribers source)))))
+
 (ert-deftest etaf-scheduler-body-error-precedes-drain-error-and-quit-drains ()
   "Body failure wins over drain failure; quit still drains queued effects."
   (let* ((context (etaf-scheduler-context-create :name 'precedence))

tests/fixtures/etaf-m0a-condition-consumers.sexp

@@ -9,6 +9,7 @@
  (: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)
@@ -32,4 +33,5 @@
  (:file "etaf-scheduler.el" :form condition-case :conditions (error quit) :owner etaf-scheduler :policy generic-containment)
  (:file "etaf-scheduler.el" :form condition-case :conditions (error quit) :owner etaf-scheduler :policy generic-containment)
  (:file "etaf-scheduler.el" :form condition-case :conditions (error quit) :owner etaf-scheduler :policy generic-containment)
+ (:file "etaf-scheduler.el" :form condition-case :conditions (error quit) :owner etaf-scheduler :policy generic-containment)
  (:file "etaf-scheduler.el" :form condition-case :conditions (error quit) :owner etaf-scheduler :policy generic-containment))