diff --git a/docs/architecture.en.md b/docs/architecture.en.md index 2ced315..579d23e 100644 --- a/docs/architecture.en.md +++ b/docs/architecture.en.md @@ -458,6 +458,14 @@ back into it. The migration-only `legacy`, `project`, and `shadow` routes prove projection equivalence and rollback safety without introducing a second committed truth. +Each semantic candidate captures the expected generation, semantic token, and +instance/resource/artifact/route store versions. The render path stages one CAS +inside the Ebox framework callback and restores it through the same inverse +journal on failure. A semantic-only change runs that CAS under ETAF ownership +without creating an Ebox commit or TP revision. Mirror projection and obsolete +route cleanup after CAS are postcommit work and cannot reverse the committed +token if they fail. + Each Runtime flush records a candidate-aware effect tuple containing the generation id, effect-to-source edges and source versions, plus an immutable semantic-node stamp for candidate input/context/output facts. A repeated tuple diff --git a/docs/architecture.zh.md b/docs/architecture.zh.md index 4226055..3067d62 100644 --- a/docs/architecture.zh.md +++ b/docs/architecture.zh.md @@ -447,6 +447,13 @@ generation;Runtime 中同名 hash table 只是由 generation 单向重建的 `legacy`/`project`/`shadow` 路由只用于证明投影等价与安全回退,不增加第二份 committed truth。 +每个 semantic candidate 同时捕获 expected generation、semantic token,以及 +instance/resource/artifact/route store versions。render 路径在 Ebox framework +stage 中暂存一次 CAS,失败时由同一个 inverse journal 恢复;没有可见 Ebox +变化的 semantic-only 路径由 ETAF 自己执行同一 CAS,不创建 Ebox commit 或 TP +revision。CAS 后的 mirror 与旧 route 清理属于 postcommit,失败不能反向恢复已提交 +token。 + 每次 Runtime flush 都记录 candidate-aware effect tuple:其中包含 generation id、 effect→source 边和 source version,以及 candidate input/context/output facts 的 immutable semantic-node stamp。重复 tuple 会报告有序的 effect/edge path;step diff --git a/etaf-generation.el b/etaf-generation.el index c111e6d..5809bef 100644 --- a/etaf-generation.el +++ b/etaf-generation.el @@ -14,17 +14,48 @@ (require 'subr-x) (define-error 'etaf-generation-error "Invalid ETAF generation authority") +(define-error 'etaf-generation-conflict + "Stale ETAF semantic generation candidate" + 'etaf-generation-error) + +(cl-defstruct + (etaf-generation-store-versions + (:constructor etaf-generation-store-versions--create)) + "Committed versions for ETAF's independently journaled stores." + (instances 0 :read-only t) + (resources 0 :read-only t) + (artifacts 0 :read-only t) + (routes 0 :read-only t)) + +(defun etaf-generation-store-versions-create () + "Return an immutable zeroed ETAF store-version snapshot." + (etaf-generation-store-versions--create)) + +(defun etaf-generation-store-versions-next (versions) + "Return the immutable successor of store VERSIONS snapshot." + (unless (etaf-generation-store-versions-p versions) + (signal 'wrong-type-argument + (list 'etaf-generation-store-versions-p versions))) + (etaf-generation-store-versions--create + :instances (1+ (etaf-generation-store-versions-instances versions)) + :resources (1+ (etaf-generation-store-versions-resources versions)) + :artifacts (1+ (etaf-generation-store-versions-artifacts versions)) + :routes (1+ (etaf-generation-store-versions-routes versions)))) (cl-defstruct (etaf-generation-authority (:constructor etaf-generation-authority--create)) "Mutable authority for one Runtime's committed generation." generation - (token 0)) + (token 0) + (store-versions (etaf-generation-store-versions-create))) (defun etaf-generation-authority-create (&optional generation) "Return fresh authority initially pointing at GENERATION." - (etaf-generation-authority--create :generation generation :token 0)) + (etaf-generation-authority--create + :generation generation + :token 0 + :store-versions (etaf-generation-store-versions-create))) (defun etaf-generation-authority-current (authority) "Return AUTHORITY's current committed generation." @@ -43,6 +74,214 @@ versioned compare-and-swap boundary owns token changes." (setf (etaf-generation-authority-generation authority) generation) generation) +(defun etaf-generation-authority-snapshot (authority) + "Return AUTHORITY's immutable generation/token/version snapshot." + (unless (etaf-generation-authority-p authority) + (signal 'wrong-type-argument + (list 'etaf-generation-authority-p authority))) + (list :generation (etaf-generation-authority-generation authority) + :token (etaf-generation-authority-token authority) + :store-versions + (etaf-generation-authority-store-versions authority))) + +(defun etaf-generation-authority-validate + (authority expected-generation expected-token expected-store-versions) + "Validate AUTHORITY against EXPECTED-GENERATION and EXPECTED-TOKEN. +EXPECTED-STORE-VERSIONS must also equal the committed version snapshot." + (unless (and (eq (etaf-generation-authority-generation authority) + expected-generation) + (eql (etaf-generation-authority-token authority) + expected-token) + (equal (etaf-generation-authority-store-versions authority) + expected-store-versions)) + (signal 'etaf-generation-conflict + (list + :expected-generation expected-generation + :actual-generation + (etaf-generation-authority-generation authority) + :expected-token expected-token + :actual-token (etaf-generation-authority-token authority) + :expected-store-versions expected-store-versions + :actual-store-versions + (etaf-generation-authority-store-versions authority)))) + t) + +(defun etaf-generation-authority-compare-and-swap + (authority expected-generation expected-token expected-store-versions + next-generation next-token next-store-versions) + "Atomically swap AUTHORITY from EXPECTED-GENERATION to NEXT-GENERATION. +EXPECTED-TOKEN and EXPECTED-STORE-VERSIONS guard the old authority; +NEXT-TOKEN and NEXT-STORE-VERSIONS become committed together." + (etaf-generation-authority-validate + authority expected-generation expected-token expected-store-versions) + (unless (and (integerp next-token) (> next-token expected-token)) + (signal 'etaf-generation-error + (list :invalid-next-token next-token))) + (unless (etaf-generation-store-versions-p next-store-versions) + (signal 'wrong-type-argument + (list 'etaf-generation-store-versions-p next-store-versions))) + (let ((inhibit-quit t)) + (setf (etaf-generation-authority-generation authority) next-generation + (etaf-generation-authority-token authority) next-token + (etaf-generation-authority-store-versions authority) + next-store-versions)) + next-generation) + +(defun etaf-generation-authority-rollback-swap + (authority expected-generation expected-token expected-store-versions + candidate-generation candidate-token candidate-store-versions) + "Restore EXPECTED-GENERATION and EXPECTED-TOKEN in AUTHORITY. +EXPECTED-STORE-VERSIONS are restored only while CANDIDATE-GENERATION, +CANDIDATE-TOKEN, and CANDIDATE-STORE-VERSIONS still match exactly." + (when (and (eq (etaf-generation-authority-generation authority) + candidate-generation) + (eql (etaf-generation-authority-token authority) candidate-token) + (equal (etaf-generation-authority-store-versions authority) + candidate-store-versions)) + (let ((inhibit-quit t)) + (setf (etaf-generation-authority-generation authority) + expected-generation + (etaf-generation-authority-token authority) expected-token + (etaf-generation-authority-store-versions authority) + expected-store-versions)) + t)) + +(defcustom etaf-semantic-commit-route 'cas + "Semantic generation commit route. +`legacy' changes only the compatibility generation pointer, `cas' performs the +versioned token/store compare-and-swap, and `shadow' validates the same expected +facts before using the CAS route." + :type '(choice (const legacy) (const cas) (const shadow)) + :group 'etaf) + +(cl-defstruct + (etaf-semantic-candidate + (:constructor etaf-semantic-candidate--create)) + "One-shot ETAF semantic authority candidate." + operation-id + candidate-id + runtime-id + mount-epoch + authority + expected-generation + candidate-generation + expected-store-versions + candidate-store-versions + expected-token + candidate-token + inverse-journal + route + (state 'prepared)) + +(defun etaf-semantic-candidate-create + (authority candidate-generation operation-id candidate-id runtime-id + mount-epoch) + "Prepare a semantic candidate for AUTHORITY and CANDIDATE-GENERATION. +OPERATION-ID, CANDIDATE-ID, RUNTIME-ID, and MOUNT-EPOCH provide immutable +correlation and authority identity." + (unless (etaf-generation-authority-p authority) + (signal 'wrong-type-argument + (list 'etaf-generation-authority-p authority))) + (let* ((snapshot (etaf-generation-authority-snapshot authority)) + (expected-token (plist-get snapshot :token)) + (expected-versions (plist-get snapshot :store-versions))) + (etaf-semantic-candidate--create + :operation-id operation-id + :candidate-id candidate-id + :runtime-id runtime-id + :mount-epoch mount-epoch + :authority authority + :expected-generation (plist-get snapshot :generation) + :candidate-generation candidate-generation + :expected-store-versions expected-versions + :candidate-store-versions + (etaf-generation-store-versions-next expected-versions) + :expected-token expected-token + :candidate-token (1+ expected-token)))) + +(defun etaf-semantic-candidate-stage (candidate) + "Install CANDIDATE provisionally through its selected authority route." + (unless (eq (etaf-semantic-candidate-state candidate) 'prepared) + (signal 'etaf-generation-error + (list :candidate-not-prepared + (etaf-semantic-candidate-state candidate)))) + (let ((authority (etaf-semantic-candidate-authority candidate)) + (route etaf-semantic-commit-route)) + (pcase route + ('legacy + (etaf-generation-authority-validate + authority + (etaf-semantic-candidate-expected-generation candidate) + (etaf-semantic-candidate-expected-token candidate) + (etaf-semantic-candidate-expected-store-versions candidate)) + (etaf-generation-authority-set-current + authority (etaf-semantic-candidate-candidate-generation candidate))) + ((or 'cas 'shadow) + (etaf-generation-authority-compare-and-swap + authority + (etaf-semantic-candidate-expected-generation candidate) + (etaf-semantic-candidate-expected-token candidate) + (etaf-semantic-candidate-expected-store-versions candidate) + (etaf-semantic-candidate-candidate-generation candidate) + (etaf-semantic-candidate-candidate-token candidate) + (etaf-semantic-candidate-candidate-store-versions candidate))) + (_ + (signal 'etaf-generation-error + (list :unknown-semantic-commit-route route)))) + (setf (etaf-semantic-candidate-route candidate) route + (etaf-semantic-candidate-state candidate) 'staged) + candidate)) + +(defun etaf-semantic-candidate-commit (candidate) + "Mark provisionally installed CANDIDATE committed exactly once." + (unless (eq (etaf-semantic-candidate-state candidate) 'staged) + (signal 'etaf-generation-error + (list :candidate-not-staged + (etaf-semantic-candidate-state candidate)))) + (let ((authority (etaf-semantic-candidate-authority candidate))) + (unless (eq (etaf-generation-authority-generation authority) + (etaf-semantic-candidate-candidate-generation candidate)) + (signal 'etaf-generation-conflict + (list :candidate-generation-lost + (etaf-semantic-candidate-candidate-id candidate)))) + (unless (or (eq (etaf-semantic-candidate-route candidate) 'legacy) + (eql (etaf-generation-authority-token authority) + (etaf-semantic-candidate-candidate-token candidate))) + (signal 'etaf-generation-conflict + (list :candidate-token-lost + (etaf-semantic-candidate-candidate-id candidate)))) + (setf (etaf-semantic-candidate-state candidate) 'committed) + candidate)) + +(defun etaf-semantic-candidate-rollback (candidate) + "Rollback staged CANDIDATE exactly once and return CANDIDATE." + (pcase (etaf-semantic-candidate-state candidate) + ('prepared + (setf (etaf-semantic-candidate-state candidate) 'rolled-back)) + ('staged + (let ((authority (etaf-semantic-candidate-authority candidate))) + (if (eq (etaf-semantic-candidate-route candidate) 'legacy) + (when (eq (etaf-generation-authority-generation authority) + (etaf-semantic-candidate-candidate-generation candidate)) + (etaf-generation-authority-set-current + authority + (etaf-semantic-candidate-expected-generation candidate))) + (etaf-generation-authority-rollback-swap + authority + (etaf-semantic-candidate-expected-generation candidate) + (etaf-semantic-candidate-expected-token candidate) + (etaf-semantic-candidate-expected-store-versions candidate) + (etaf-semantic-candidate-candidate-generation candidate) + (etaf-semantic-candidate-candidate-token candidate) + (etaf-semantic-candidate-candidate-store-versions candidate))) + (setf (etaf-semantic-candidate-state candidate) 'rolled-back))) + ('rolled-back nil) + (_ + (signal 'etaf-generation-error + (list :candidate-not-rollback-capable + (etaf-semantic-candidate-state candidate))))) + candidate) + (defun etaf-generation-project-mirror (entries &optional test) "Project immutable contribution ENTRIES into a fresh hash table. TEST defaults to `equal'. Duplicate keys are rejected so a compatibility diff --git a/etaf-runtime.el b/etaf-runtime.el index af5e0b8..c12108a 100644 --- a/etaf-runtime.el +++ b/etaf-runtime.el @@ -136,7 +136,7 @@ the operation preserves committed values and removal semantics." (cl-defstruct (etaf--generation-participant (:constructor etaf--generation-participant-create)) - runtime old candidate paint-journal (state 'unpublished)) + runtime semantic-candidate paint-journal (state 'unpublished)) (cl-defstruct (etaf-generation (:constructor etaf--generation-create)) @@ -332,6 +332,7 @@ the sequential `etaf--pvec-put' contract." diagnostics observer (next-operation-id 0) + (next-semantic-candidate-id 0) (event-depth 0) dirty-effect-queue-tail) @@ -351,7 +352,23 @@ checking them against a fresh generation projection." (defun etaf-runtime-current-generation (runtime) "Return RUNTIME's uniquely authoritative committed generation." - (etaf-generation-authority-current + (let ((authority (etaf--runtime-generation-authority runtime))) + (unless (and (integerp (etaf-generation-authority-token authority)) + (>= (etaf-generation-authority-token authority) 0) + (etaf-generation-store-versions-p + (etaf-generation-authority-store-versions authority))) + (signal 'etaf-generation-error + (list :invalid-committed-authority authority))) + (etaf-generation-authority-current authority))) + +(defun etaf-runtime-generation-token (runtime) + "Return RUNTIME's committed semantic generation token." + (etaf-generation-authority-token + (etaf--runtime-generation-authority runtime))) + +(defun etaf-runtime-store-versions (runtime) + "Return RUNTIME's immutable committed store-version snapshot." + (etaf-generation-authority-store-versions (etaf--runtime-generation-authority runtime))) (defun etaf-runtime--set-current-generation (runtime generation) @@ -4064,17 +4081,6 @@ Generation, including its effects and Host contributions." (>= (plist-get props :tab-index) 0) (not (plist-get props :disabled))) (setf (etaf-runtime-focus-ref runtime) nil)))) - (maphash - (lambda (_identity semantic) - (when-let* ((instance - (gethash (etaf--semantic-component-resource-key semantic) - (etaf-runtime-resource-registry runtime)))) - (setf (etaf--component-instance-context instance) - (etaf--semantic-component-context-frame semantic)))) - (etaf-runtime-candidate-semantic-nodes runtime)) - (dolist (instance (etaf-runtime-candidate-created runtime)) - (puthash (etaf--component-instance-identity instance) instance - (etaf-runtime-instances runtime))) (dolist (delta (etaf-runtime-candidate-source-deltas runtime)) (let ((source (car delta)) (effects (nth 2 delta))) (when (null effects) @@ -4082,16 +4088,47 @@ Generation, including its effects and Host contributions." (etaf--source-subscribers source)) (remhash source (etaf-runtime-route-sources runtime)))))) -(defun etaf--runtime-swap-generation (runtime old candidate) - "Swap RUNTIME from OLD to CANDIDATE with an exact authority guard." - (unless (eq (etaf-runtime-current-generation runtime) old) - (error "ETAF generation authority changed during publication")) - (setf (etaf-runtime-current-generation runtime) candidate)) +(defun etaf--runtime-new-semantic-candidate (runtime generation) + "Return RUNTIME's next versioned semantic candidate for GENERATION." + (let ((candidate-id + (cl-incf (etaf-runtime-next-semantic-candidate-id runtime))) + (operation-id + (if etaf--observer-context + (etaf--observer-context-operation-id etaf--observer-context) + 0))) + (etaf-semantic-candidate-create + (etaf--runtime-generation-authority runtime) + generation operation-id candidate-id + (etaf-runtime-mount-epoch runtime) + (etaf-runtime-mount-epoch runtime)))) -(defun etaf--runtime-rollback-generation (runtime old candidate) +(defun etaf--runtime-swap-generation + (runtime old candidate &optional semantic-candidate) + "Swap RUNTIME from OLD to CANDIDATE with an exact authority guard. +SEMANTIC-CANDIDATE selects the versioned token/store CAS path." + (if semantic-candidate + (progn + (unless (and + (eq old + (etaf-semantic-candidate-expected-generation + semantic-candidate)) + (eq candidate + (etaf-semantic-candidate-candidate-generation + semantic-candidate))) + (signal 'etaf-generation-error + (list :participant-candidate-mismatch))) + (etaf-semantic-candidate-stage semantic-candidate)) + (unless (eq (etaf-runtime-current-generation runtime) old) + (error "ETAF generation authority changed during publication")) + (setf (etaf-runtime-current-generation runtime) candidate))) + +(defun etaf--runtime-rollback-generation + (runtime old candidate &optional semantic-candidate) "Idempotently restore OLD when RUNTIME still points at CANDIDATE." - (when (eq (etaf-runtime-current-generation runtime) candidate) - (setf (etaf-runtime-current-generation runtime) old))) + (if semantic-candidate + (etaf-semantic-candidate-rollback semantic-candidate) + (when (eq (etaf-runtime-current-generation runtime) candidate) + (setf (etaf-runtime-current-generation runtime) old)))) (defun etaf--runtime-preinstall-resources (runtime old generation) "Install RUNTIME resources/artifacts for GENERATION and return journal. @@ -4113,9 +4150,35 @@ removed inside the same rollback journal." (unwind-protect (progn (dolist (instance (etaf-runtime-candidate-created runtime)) - (let ((key (etaf--component-instance-resource-key instance))) + (let* ((key (etaf--component-instance-resource-key instance)) + (identity (etaf--component-instance-identity instance)) + (missing (make-symbol "etaf-instance-missing")) + (old-instance + (gethash identity (etaf-runtime-instances runtime) + missing))) (push (list 'resource key instance) journal) - (puthash key instance (etaf-runtime-resource-registry runtime)))) + (puthash key instance (etaf-runtime-resource-registry runtime)) + (push (list 'instance identity + (not (eq old-instance missing)) old-instance instance) + journal) + (puthash identity instance (etaf-runtime-instances runtime)))) + (maphash + (lambda (_identity semantic) + (when-let* ((instance + (gethash + (etaf--semantic-component-resource-key semantic) + (etaf-runtime-resource-registry runtime)))) + (let ((old-context + (etaf--component-instance-context instance)) + (new-context + (etaf--semantic-component-context-frame semantic))) + (unless (eq old-context new-context) + (push (list 'instance-context instance + old-context new-context) + journal) + (setf (etaf--component-instance-context instance) + new-context))))) + (etaf-runtime-candidate-semantic-nodes runtime)) (when (and (hash-table-p (etaf-runtime-candidate-behavior-resource-keys runtime)) (hash-table-p @@ -4210,6 +4273,22 @@ removed inside the same rollback journal." "Remove RUNTIME resources still owned by failed JOURNAL entries." (dolist (entry journal) (pcase (car entry) + ('instance + (let ((identity (nth 1 entry)) + (present-p (nth 2 entry)) + (old (nth 3 entry)) + (candidate (nth 4 entry))) + (when (eq (gethash identity (etaf-runtime-instances runtime)) + candidate) + (if present-p + (puthash identity old (etaf-runtime-instances runtime)) + (remhash identity (etaf-runtime-instances runtime)))))) + ('instance-context + (let ((instance (nth 1 entry)) + (old-context (nth 2 entry)) + (new-context (nth 3 entry))) + (when (eq (etaf--component-instance-context instance) new-context) + (setf (etaf--component-instance-context instance) old-context)))) ('resource (when (eq (gethash (nth 1 entry) (etaf-runtime-resource-registry runtime)) @@ -4247,12 +4326,51 @@ removed inside the same rollback journal." (error "ETAF artifact authority changed during rollback: %S" key))))))) nil) +(defun etaf--runtime-bind-semantic-inverse-journal + (candidate runtime resource-journal route-journal) + "Bind CANDIDATE inverse journals for RUNTIME before authority staging. +RESOURCE-JOURNAL and ROUTE-JOURNAL remain opaque owner-local entries." + (setf (etaf-semantic-candidate-inverse-journal candidate) + (list :runtime runtime + :resource-journal resource-journal + :route-journal route-journal + :state 'armed)) + candidate) + +(defun etaf--runtime-rollback-semantic-inverse-journal (candidate) + "Rollback CANDIDATE route/resource journals exactly once." + (when-let* ((inverse (etaf-semantic-candidate-inverse-journal candidate)) + ((eq (plist-get inverse :state) 'armed))) + (let ((runtime (plist-get inverse :runtime))) + (plist-put inverse :state 'rolling-back) + (unwind-protect + (progn + (etaf--runtime-rollback-prearm + runtime (plist-get inverse :route-journal)) + (etaf--runtime-rollback-resource-journal + runtime (plist-get inverse :resource-journal))) + (plist-put inverse :state 'rolled-back)))) + candidate) + +(defun etaf--runtime-commit-semantic-inverse-journal (candidate) + "Mark CANDIDATE inverse journal committed and no longer rollback-capable." + (when-let* ((inverse (etaf-semantic-candidate-inverse-journal candidate))) + (unless (eq (plist-get inverse :state) 'armed) + (signal 'etaf-generation-error + (list :inverse-journal-not-armed + (plist-get inverse :state)))) + (plist-put inverse :state 'committed)) + candidate) + (defun etaf--runtime-participant-publish (participant) "Publish PARTICIPANT generation, restoring old authority on any failure." - (let ((success nil) + (let* ((success nil) (runtime (etaf--generation-participant-runtime participant)) - (old (etaf--generation-participant-old participant)) - (candidate (etaf--generation-participant-candidate participant)) + (semantic-candidate + (etaf--generation-participant-semantic-candidate participant)) + (old (etaf-semantic-candidate-expected-generation semantic-candidate)) + (candidate + (etaf-semantic-candidate-candidate-generation semantic-candidate)) paint-updates) (when-let* ((table (etaf-runtime-candidate-theme-paint-updates runtime))) @@ -4265,30 +4383,41 @@ removed inside the same rollback journal." (setf (etaf--generation-participant-paint-journal participant) (tp-paint-slot-apply-updates (etaf-runtime-buffer runtime) paint-updates))) - (etaf--runtime-swap-generation runtime old candidate) + (etaf--runtime-swap-generation + runtime old candidate semantic-candidate) (setf (etaf--generation-participant-state participant) 'published success t)) (unless success - (when-let* ((paint-journal - (etaf--generation-participant-paint-journal participant))) - (tp-paint-slot-rollback-updates paint-journal) - (setf (etaf--generation-participant-paint-journal participant) nil)) - (etaf--runtime-rollback-generation runtime old candidate))) + (etaf--runtime-participant-rollback participant))) participant)) (defun etaf--runtime-participant-rollback (participant) "Rollback PARTICIPANT generation exactly and idempotently." - (when-let* ((paint-journal - (etaf--generation-participant-paint-journal participant))) - (tp-paint-slot-rollback-updates paint-journal) - (setf (etaf--generation-participant-paint-journal participant) nil)) - (etaf--runtime-rollback-generation - (etaf--generation-participant-runtime participant) - (etaf--generation-participant-old participant) - (etaf--generation-participant-candidate participant)) - (setf (etaf--generation-participant-state participant) 'rolled-back) + (unless (eq (etaf--generation-participant-state participant) 'rolled-back) + (let ((semantic-candidate + (etaf--generation-participant-semantic-candidate participant))) + (etaf--runtime-rollback-generation + (etaf--generation-participant-runtime participant) + (etaf-semantic-candidate-expected-generation semantic-candidate) + (etaf-semantic-candidate-candidate-generation semantic-candidate) + semantic-candidate) + (when-let* ((paint-journal + (etaf--generation-participant-paint-journal participant))) + (tp-paint-slot-rollback-updates paint-journal) + (setf (etaf--generation-participant-paint-journal participant) nil)) + (etaf--runtime-rollback-semantic-inverse-journal semantic-candidate) + (setf (etaf--generation-participant-state participant) 'rolled-back))) participant) +(defun etaf--runtime-participant-commit (participant) + "Commit PARTICIPANT semantic candidate after render final accept." + (let ((candidate + (etaf--generation-participant-semantic-candidate participant))) + (etaf-semantic-candidate-commit candidate) + (etaf--runtime-commit-semantic-inverse-journal candidate) + (setf (etaf--generation-participant-state participant) 'committed) + participant)) + (defun etaf--runtime-begin-component-overlay (runtime generation) "Seed RUNTIME candidate tables from committed GENERATION without traversal." (etaf--runtime-begin-candidate runtime) @@ -5401,7 +5530,8 @@ RENDERED-IDENTITIES names the Component render participants." queued-effect-ids)) changes range-changes inline-changes host-property-semantics host-changes backend-component-identities - journal resource-journal candidate-generation participant) + journal resource-journal candidate-generation semantic-candidate + participant) (etaf--runtime-begin-component-overlay runtime old) ;; A source notification can race a generation promotion and leave an old ;; effect id in the FIFO. Keep the dirty-id set and FIFO coherent before @@ -5625,6 +5755,9 @@ RENDERED-IDENTITIES names the Component render participants." semantic-id) host-changes))))) (setq host-changes (nreverse host-changes)) + (setq semantic-candidate + (etaf--runtime-new-semantic-candidate + runtime candidate-generation)) (condition-case err (progn (setq resource-journal @@ -5632,9 +5765,11 @@ RENDERED-IDENTITIES names the Component render participants." runtime old candidate-generation) participant (etaf--generation-participant-create - :runtime runtime :old old :candidate candidate-generation) + :runtime runtime :semantic-candidate semantic-candidate) journal (etaf--runtime-prearm-generation runtime candidate-generation)) + (etaf--runtime-bind-semantic-inverse-journal + semantic-candidate runtime resource-journal journal) (if (and (null changes) (null range-changes) (cl-every @@ -5686,6 +5821,10 @@ RENDERED-IDENTITIES names the Component render participants." (lambda (_report) (etaf--runtime-participant-rollback participant)))))) ((error quit) + (when semantic-candidate + (etaf-semantic-candidate-rollback semantic-candidate) + (etaf--runtime-rollback-semantic-inverse-journal + semantic-candidate)) (etaf--runtime-rollback-prearm runtime journal) (etaf--runtime-rollback-resource-journal runtime resource-journal) (etaf--runtime-clear-dirty-effects runtime) @@ -5694,6 +5833,7 @@ RENDERED-IDENTITIES names the Component render participants." (etaf--runtime-dispose-created-candidate runtime) (etaf--runtime-clear-candidate runtime) (signal (car err) (cdr err)))) + (etaf--runtime-participant-commit participant) (etaf--runtime-complete-generation runtime candidate-generation) (etaf--runtime-install-generation-mirrors runtime candidate-generation nil) @@ -5719,8 +5859,8 @@ RENDERED-IDENTITIES names the Component render participants." "Build and publish one Root-owned candidate for RUNTIME." (setf (etaf-runtime-candidate-full-rebuild-p runtime) t) (let ((old-generation (etaf-runtime-current-generation runtime)) - next-root root-node candidate-generation journal resource-journal - participant) + next-root root-node candidate-generation semantic-candidate + journal resource-journal participant) (condition-case err (let* ((source-builder (ebox-source-builder-create)) (etaf--render-runtime runtime) @@ -5746,13 +5886,18 @@ RENDERED-IDENTITIES names the Component render participants." (ebox-source-builder-finish source-builder))) (setq candidate-generation (etaf--runtime-build-generation runtime old-generation) + semantic-candidate + (etaf--runtime-new-semantic-candidate + runtime candidate-generation) resource-journal (etaf--runtime-preinstall-resources runtime old-generation candidate-generation) participant (etaf--generation-participant-create - :runtime runtime :old old-generation - :candidate candidate-generation) + :runtime runtime + :semantic-candidate semantic-candidate) journal (etaf--runtime-prearm-generation runtime candidate-generation)) + (etaf--runtime-bind-semantic-inverse-journal + semantic-candidate runtime resource-journal journal) (if old-generation (let ((candidate (ebox-candidate-begin (etaf-runtime-buffer runtime)))) @@ -5767,14 +5912,12 @@ RENDERED-IDENTITIES names the Component render participants." (etaf-runtime-buffer runtime) next-root (when (etaf-runtime-observer runtime) (list :observer #'etaf--runtime-forward-ebox-report))) - (etaf--runtime-participant-publish participant)) - (etaf--runtime-complete-generation runtime candidate-generation) - (etaf--runtime-install-generation-mirrors - runtime candidate-generation t) - (setf (etaf-runtime-root-node runtime) root-node - (etaf-runtime-root-dirty-p runtime) nil) - (etaf--runtime-clear-dirty-effects runtime)) + (etaf--runtime-participant-publish participant))) ((error quit) + (when semantic-candidate + (etaf-semantic-candidate-rollback semantic-candidate) + (etaf--runtime-rollback-semantic-inverse-journal + semantic-candidate)) (etaf--runtime-rollback-prearm runtime journal) (etaf--runtime-rollback-resource-journal runtime resource-journal) (etaf--runtime-clear-dirty-effects runtime) @@ -5782,6 +5925,13 @@ RENDERED-IDENTITIES names the Component render participants." (etaf--runtime-rollback-behaviors runtime) (etaf--runtime-clear-candidate runtime) (signal (car err) (cdr err)))) + (etaf--runtime-participant-commit participant) + (etaf--runtime-complete-generation runtime candidate-generation) + (etaf--runtime-install-generation-mirrors + runtime candidate-generation t) + (setf (etaf-runtime-root-node runtime) root-node + (etaf-runtime-root-dirty-p runtime) nil) + (etaf--runtime-clear-dirty-effects runtime) ;; Publication has completed. Lifecycle and cleanup callbacks run after ;; the retained state is promoted; their errors remain visible without ;; incorrectly rolling back an already published Ebox tree. diff --git a/tests/etaf-generation-tests.el b/tests/etaf-generation-tests.el index 88e1d4f..71044d2 100644 --- a/tests/etaf-generation-tests.el +++ b/tests/etaf-generation-tests.el @@ -6,6 +6,16 @@ (require 'etaf) (require 'etaf-generation) +(etaf-define-component etaf-generation-test-dependency-only (&key source) + "Track SOURCE while producing an equal Ebox artifact." + :view + (text (expr (progn (etaf-value source) "same")))) + +(etaf-define-component etaf-generation-test-visible (&key source) + "Render SOURCE as visible text for semantic conflict tests." + :view + (text (expr (format "value=%s" (etaf-value source))))) + (defun etaf-generation-test--view (visible) "Return a root View selected by reactive VISIBLE." (if (etaf-value visible) @@ -122,6 +132,271 @@ (etaf--runtime-install-generation-mirrors runtime nil t) :type 'etaf-generation-error))) +(ert-deftest etaf-semantic-candidate-cas-and-rollback-are-exactly-once () + "CAS stages generation/token/versions together and rollback restores all." + (let* ((old (list 'old-generation)) + (next (list 'next-generation)) + (authority (etaf-generation-authority-create old)) + (candidate + (etaf-semantic-candidate-create + authority next 7 11 13 17))) + (etaf-semantic-candidate-stage candidate) + (should (eq next (etaf-generation-authority-current authority))) + (should (= (etaf-generation-authority-token authority) 1)) + (should + (equal (etaf-generation-authority-store-versions authority) + (etaf-semantic-candidate-candidate-store-versions candidate))) + (should-error (etaf-semantic-candidate-stage candidate) + :type 'etaf-generation-error) + (etaf-semantic-candidate-rollback candidate) + (should (eq old (etaf-generation-authority-current authority))) + (should (zerop (etaf-generation-authority-token authority))) + (should + (equal (etaf-generation-authority-store-versions authority) + (etaf-semantic-candidate-expected-store-versions candidate))) + (etaf-semantic-candidate-rollback candidate) + (should-error (etaf-semantic-candidate-commit candidate) + :type 'etaf-generation-error))) + +(ert-deftest etaf-semantic-candidate-rejects-stale-authority-snapshots () + "Generation, token, and store-version conflicts fail before authority swap." + (dolist (kind '(generation token stores)) + (let* ((old (list 'old-generation)) + (next (list 'next-generation)) + (authority (etaf-generation-authority-create old)) + (candidate + (etaf-semantic-candidate-create authority next 1 2 3 4))) + (pcase kind + ('generation + (etaf-generation-authority-set-current authority (list 'foreign))) + ('token + (setf (etaf-generation-authority-token authority) 9)) + ('stores + (setf (etaf-generation-authority-store-versions authority) + (etaf-generation-store-versions-next + (etaf-generation-authority-store-versions authority))))) + (should-error (etaf-semantic-candidate-stage candidate) + :type 'etaf-generation-conflict) + (should (eq (etaf-semantic-candidate-state candidate) 'prepared))))) + +(ert-deftest etaf-semantic-candidate-commit-is-terminal () + "A committed semantic candidate cannot rollback or commit twice." + (let* ((authority (etaf-generation-authority-create 'old)) + (candidate + (etaf-semantic-candidate-create authority 'next 1 2 3 4))) + (etaf-semantic-candidate-stage candidate) + (etaf-semantic-candidate-commit candidate) + (should (eq (etaf-semantic-candidate-state candidate) 'committed)) + (should-error (etaf-semantic-candidate-commit candidate) + :type 'etaf-generation-error) + (should-error (etaf-semantic-candidate-rollback candidate) + :type 'etaf-generation-error) + (should (eq (etaf-generation-authority-current authority) 'next)))) + +(ert-deftest etaf-semantic-only-commit-advances-token-without-ebox-or-tp () + "Equal output commits semantic token/version only, with no surface revision." + (let ((buffer-name " *etaf-semantic-token-test*") + (source (etaf-ref 0)) + (ebox-updates 0)) + (unwind-protect + (progn + (etaf-mount + buffer-name + (etaf--view-call 'etaf-generation-test-dependency-only + (list :source source) nil)) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (surface (with-current-buffer buffer-name + (car tp--buffer-surfaces))) + (generation (etaf-runtime-generation runtime)) + (token (etaf-runtime-generation-token runtime)) + (versions (etaf-runtime-store-versions runtime)) + (revision (tp-surface-revision surface)) + (original + (symbol-function 'etaf-render-port-update))) + (cl-letf (((symbol-function 'etaf-render-port-update) + (lambda (&rest arguments) + (cl-incf ebox-updates) + (apply original arguments)))) + (setf (etaf-value source) 1)) + (should (= (1+ generation) + (etaf-runtime-generation runtime))) + (should (= (1+ token) + (etaf-runtime-generation-token runtime))) + (should + (equal (etaf-generation-store-versions-next versions) + (etaf-runtime-store-versions runtime))) + (should (zerop ebox-updates)) + (should (= revision (tp-surface-revision surface))))) + (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-store-conflict-restores-and-retries () + "A stale store version leaves generation/buffer old and a fresh retry wins." + (let ((buffer-name " *etaf-semantic-conflict-test*") + (source (etaf-ref 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)) + (authority (etaf-runtime-generation-authority runtime)) + (generation (etaf-runtime-current-generation runtime)) + (token (etaf-runtime-generation-token runtime)) + (versions (etaf-runtime-store-versions runtime)) + (original + (symbol-function 'etaf--runtime-participant-publish))) + (cl-letf + (((symbol-function 'etaf--runtime-participant-publish) + (lambda (participant) + (setf (etaf-generation-authority-store-versions authority) + (etaf-generation-store-versions-next versions)) + (funcall original participant)))) + (should-error (setf (etaf-value source) 1) + :type 'etaf-generation-conflict)) + (should (eq generation + (etaf-runtime-current-generation runtime))) + (should (= token (etaf-runtime-generation-token runtime))) + (should (equal "value=0" + (with-current-buffer buffer-name + (buffer-string)))) + (etaf-runtime-flush runtime) + (should (= (1+ token) (etaf-runtime-generation-token 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-postcommit-mirror-failure-keeps-token-committed () + "A postcommit mirror error cannot reverse generation/token or TP facts." + (let ((buffer-name " *etaf-semantic-postcommit-test*") + (source (etaf-ref 0))) + (unwind-protect + (progn + (etaf-mount + buffer-name + (etaf--view-call 'etaf-generation-test-dependency-only + (list :source source) nil)) + (let* ((runtime (etaf-runtime-for-buffer buffer-name)) + (surface (with-current-buffer buffer-name + (car tp--buffer-surfaces))) + (generation (etaf-runtime-generation runtime)) + (token (etaf-runtime-generation-token runtime)) + (revision (tp-surface-revision surface))) + (cl-letf + (((symbol-function 'etaf--runtime-install-generation-mirrors) + (lambda (&rest _arguments) + (error "injected postcommit mirror failure")))) + (should-error (setf (etaf-value source) 1) :type 'error)) + (should (= (1+ generation) + (etaf-runtime-generation runtime))) + (should (= (1+ token) + (etaf-runtime-generation-token runtime))) + (should (= revision (tp-surface-revision surface))) + (should (equal "same" + (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*") + (source (etaf-ref 0)) + rollback-evidence) + (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-current-generation runtime)) + (token (etaf-runtime-generation-token runtime)) + (versions (etaf-runtime-store-versions runtime)) + (original-precommit + (symbol-function 'tp--run-transaction-precommit-functions)) + (original-rollback + (symbol-function 'etaf--runtime-participant-rollback))) + (cl-letf + (((symbol-function 'tp--run-transaction-precommit-functions) + (lambda () + (funcall original-precommit) + (error "injected precommit failure"))) + ((symbol-function 'etaf--runtime-participant-rollback) + (lambda (participant) + (prog1 (funcall original-rollback participant) + (let* ((semantic + (etaf--generation-participant-semantic-candidate + participant)) + (inverse + (etaf-semantic-candidate-inverse-journal semantic))) + (setq rollback-evidence + (list + :generation + (eq generation + (etaf-runtime-current-generation runtime)) + :token + (= token (etaf-runtime-generation-token runtime)) + :versions + (equal versions + (etaf-runtime-store-versions runtime)) + :candidate-state + (etaf-semantic-candidate-state semantic) + :journal-state + (plist-get inverse :state)))))))) + (should-error (setf (etaf-value source) 1) :type 'error)) + (should + (equal rollback-evidence + '(:generation t :token t :versions t + :candidate-state rolled-back + :journal-state rolled-back))) + (should (equal "value=0" + (with-current-buffer buffer-name + (buffer-string)))) + (etaf-runtime-flush 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-legacy-and-shadow-routes-remain-recoverable () + "Legacy keeps its token while shadow validates and advances the CAS token." + (dolist (route '(legacy shadow)) + (let ((buffer-name + (format " *etaf-semantic-%s-route-test*" route)) + (source (etaf-ref 0)) + (etaf-semantic-commit-route route)) + (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)) + (token (etaf-runtime-generation-token runtime))) + (setf (etaf-value source) 1) + (should (= (1+ generation) + (etaf-runtime-generation runtime))) + (should (= (etaf-runtime-generation-token runtime) + (if (eq route 'legacy) token (1+ token)))))) + (when-let* ((runtime (etaf-runtime-for-buffer buffer-name))) + (etaf-unmount runtime)) + (when-let* ((buffer (get-buffer buffer-name))) + (kill-buffer buffer)))))) + (provide 'etaf-generation-tests) ;;; etaf-generation-tests.el ends here