;;; ebox-state-contract-tests.el --- M2a state ownership contracts -*- lexical-binding: t; -*- ;;; Code: (require 'ert) (require 'cl-lib) (require 'ebox) (require 'ebox-state-contract) (require 'ebox-fixtures) (defconst ebox-state-contract-test--plan-expectations '((runtime-generation-indexes (:source-index ebox-source-index/records ebox-source-index/handle-records ebox-source-index/host-ref-table :root-node :node-table :parent-table :runtime-type-count-table :range-ref-table :selector-id-table :selector-class-table :selector-type-table) generation-fact ebox candidate-construction-only immutable-generation-token discard-candidate source-and-runtime-index-rebuild generation-replacement) (region-generation-indexes (:region-id-set :region-node-table :region-box-count-table :region-box-table :layout-snapshots) generation-fact ebox candidate-layout-materialization-only immutable-generation-token discard-candidate layout-and-region-index-rebuild generation-replacement) (scroll-membership (:scroll-region-ids) generation-fact ebox candidate-layout-materialization-only immutable-generation-token discard-candidate layout-scroll-membership-rebuild generation-replacement) (scroll-runtime-authority (:scroll-state-table :scroll-offset :scroll-window ebox--scroll-global-state ebox--smooth-scroll-state-table ebox--scroll-idle-prefetch-timers) generation-bound-mutable-authority ebox-scroll stable-scroll-id-and-generation-token required participant-journal-restores-prior-authority not-rebuildable-from-cache cancel-timers-and-retire-generation) (native-runtime-authority (:native-sync-session :native-sync-pending :native-session ebox-native-reflow-preparation ebox-native-reflow-session) generation-bound-mutable-authority ebox-native native-candidate-confirm-or-abort required abort-candidate-and-keep-confirmed-session not-rebuildable-from-cache release-losing-session) (tp-client-state-custody (tp-surface-client-state) tp-storage-custody tp opaque-ebox-generation-correlation-only opaque-correlation tp-restores-client-state ebox-generation-remains-source-of-truth tp-surface-unmount) (buffer-render-state-mirror (ebox--buffer-render-state-table) compatibility-mirror ebox-compatibility project-from-committed-generation committed-generation-token participant-restores-prior-projection project-buffer-mirror-from-committed-states remove-buffer-entry) (region-box-lookup-mirror (ebox--region-box-table) compatibility-mirror ebox-compatibility project-from-committed-generation committed-generation-token participant-restores-prior-projection project-region-mirror-from-generation-indexes remove-retired-generation-entries) (derived-caches (ebox--char-width-cache ebox--face-height-width-cache ebox--display-signature-cache ebox--render-cache-signature-cache) disposable-cache ebox-cache cache-fill-and-evict cache-key-or-display-signature discard recompute-with-identical-semantic-result bounded-eviction-or-clear)) "Exact M2a section 7.2 lifecycle expectations used by the E1 gate.") (ert-deftest ebox-state-contract-inventory-is-complete-and-closed () "Every retained-state family has one complete closed classification." (let* ((inventory (ebox-state-contract-validate)) (ids (mapcar (lambda (record) (plist-get record :id)) inventory))) (should (= (length inventory) 9)) (should (= (length ids) (length (delete-dups (copy-sequence ids))))) (dolist (record inventory) (dolist (field ebox-state-contract-required-fields) (should (plist-get record field))) (should (memq (plist-get record :category) ebox-state-contract-categories))) (should (equal ids '(runtime-generation-indexes region-generation-indexes scroll-membership scroll-runtime-authority native-runtime-authority tp-client-state-custody buffer-render-state-mirror region-box-lookup-mirror derived-caches))))) (ert-deftest ebox-state-contract-inventory-matches-plan-table-exactly () "Every plan-named storage family keeps its exact lifecycle classification." (dolist (expected ebox-state-contract-test--plan-expectations) (let ((record (ebox-state-contract-record (nth 0 expected)))) (should (equal (plist-get record :storage) (nth 1 expected))) (should (eq (plist-get record :category) (nth 2 expected))) (should (eq (plist-get record :owner) (nth 3 expected))) (should (eq (plist-get record :mutation-api) (nth 4 expected))) (should (eq (plist-get record :generation-binding) (nth 5 expected))) (should (eq (plist-get record :rollback) (nth 6 expected))) (should (eq (plist-get record :rebuild-proof) (nth 7 expected))) (should (eq (plist-get record :cleanup) (nth 8 expected)))))) (ert-deftest ebox-state-contract-inventory-is-detached () "Callers cannot mutate the retained package inventory." (let ((copy (ebox-state-contract-inventory))) (setf (plist-get (car copy) :category) 'disposable-cache) (should (eq (plist-get (ebox-state-contract-record 'runtime-generation-indexes) :category) 'generation-fact)))) (ert-deftest ebox-state-contract-never-classifies-live-authority-as-cache () "Scroll and native handles retain generation-bound mutable authority." (dolist (id '(scroll-runtime-authority native-runtime-authority)) (let ((record (ebox-state-contract-record id))) (should (eq (plist-get record :category) 'generation-bound-mutable-authority)) (should (eq (plist-get record :generation-binding) 'required)) (should (eq (plist-get record :rebuild-proof) 'not-rebuildable-from-cache))))) (ert-deftest ebox-state-contract-tp-custody-is-opaque () "The inventory separates current whole-state custody from its M2a target." (let ((record (ebox-state-contract-record 'tp-client-state-custody))) (should (eq (plist-get record :owner) 'tp)) (should (eq (plist-get record :current-contract) 'entire-ebox-state-plist)) (should (eq (plist-get record :target-contract) 'opaque-generation-correlation-only)) (should (eq (plist-get record :mutation-api) 'opaque-ebox-generation-correlation-only)) (should (eq (plist-get record :rebuild-proof) 'ebox-generation-remains-source-of-truth)))) (ert-deftest ebox-state-contract-rebuilds-current-compatibility-mirrors () "Committed client state rebuilds the current buffer and region mirrors." (let ((buffer (generate-new-buffer " *ebox-m2a-e1-mirror*"))) (unwind-protect (let* ((_rendered (ebox-render-to-buffer buffer (ebox-test-column (ebox-test-box :key 'first (ebox-test-text "first")) (ebox-test-box :key 'second (ebox-test-text "second"))))) (surface (ebox-surface--live-buffer-surface buffer)) (state (tp-surface-client-state surface)) (before-text (with-current-buffer buffer (buffer-substring (point-min) (point-max)))) (before-revision (tp-surface-revision surface)) (entries (list (cons buffer state))) (rebuilt (ebox-state-contract-rebuild-compatibility-mirrors entries)) (report (ebox-state-contract-probe-compatibility-mirrors entries ebox--buffer-render-state-table ebox--region-box-table))) (should (plist-get report :consistent-p)) (should-not (plist-get report :buffer-differences)) (should-not (plist-get report :region-differences)) (should-not (eq (plist-get rebuilt :buffer-table) ebox--buffer-render-state-table)) (should-not (eq (plist-get rebuilt :region-table) ebox--region-box-table)) (should (eq (gethash buffer (plist-get rebuilt :buffer-table)) state)) (should (equal (hash-table-count (plist-get rebuilt :region-table)) (hash-table-count (plist-get state :region-box-table)))) (should (eq (tp-surface-client-state surface) state)) (should (= (tp-surface-revision surface) before-revision)) (should (equal (with-current-buffer buffer (buffer-substring (point-min) (point-max))) before-text))) (when (buffer-live-p buffer) (kill-buffer buffer))))) (ert-deftest ebox-state-contract-probe-detects-mirror-drift-without-mutation () "The read-only probe reports stale compatibility entries." (let* ((buffer (generate-new-buffer " *ebox-m2a-e1-drift*")) (region-id 'ebox/m2a-e1-region) (box (list :node-id 'ebox/m2a-e1-box)) (regions (make-hash-table :test #'equal)) (state (list :region-box-table regions)) (entries (list (cons buffer state))) (buffer-mirror (make-hash-table :test #'eq)) (region-mirror (make-hash-table :test #'equal)) (stale (list :node-id 'stale))) (unwind-protect (progn (puthash region-id box regions) (puthash buffer state buffer-mirror) (puthash region-id stale region-mirror) (let ((report (ebox-state-contract-probe-compatibility-mirrors entries buffer-mirror region-mirror))) (should-not (plist-get report :consistent-p)) (should (equal (plist-get report :region-differences) (list region-id))) (should (eq (gethash region-id region-mirror) stale)))) (when (buffer-live-p buffer) (kill-buffer buffer))))) (ert-deftest ebox-state-contract-rejects-cross-generation-region-collision () "Two committed generations cannot project different boxes for one region." (let ((first-buffer (generate-new-buffer " *ebox-m2a-e1-first*")) (second-buffer (generate-new-buffer " *ebox-m2a-e1-second*")) (first-regions (make-hash-table :test #'equal)) (second-regions (make-hash-table :test #'equal))) (unwind-protect (progn (puthash 'shared (list :node-id 'first) first-regions) (puthash 'shared (list :node-id 'second) second-regions) (should-error (ebox-state-contract-rebuild-compatibility-mirrors (list (cons first-buffer (list :region-box-table first-regions)) (cons second-buffer (list :region-box-table second-regions)))) :type 'ebox-state-contract-error)) (when (buffer-live-p first-buffer) (kill-buffer first-buffer)) (when (buffer-live-p second-buffer) (kill-buffer second-buffer))))) (ert-deftest ebox-state-contract-probe-work-is-bounded-by-projection-size () "The E1 probe performs bounded table work and never traverses a node tree." (let (buffers entries) (unwind-protect (progn (dotimes (buffer-index 64) (let ((buffer (generate-new-buffer (format " *ebox-m2a-e1-perf-%d*" buffer-index))) (regions (make-hash-table :test #'equal))) (push buffer buffers) (dotimes (region-index 16) (puthash (cons buffer-index region-index) (list :node-id (cons buffer-index region-index)) regions)) (push (cons buffer (list :region-box-table regions)) entries))) (setq entries (nreverse entries)) (let* ((rebuilt (ebox-state-contract-rebuild-compatibility-mirrors entries)) (report (cl-letf (((symbol-function 'ebox-tree-map) (lambda (&rest _arguments) (error "E1 probe traversed the node tree")))) (ebox-state-contract-probe-compatibility-mirrors entries (plist-get rebuilt :buffer-table) (plist-get rebuilt :region-table))))) (should (plist-get report :consistent-p)) (should (= (plist-get report :entry-count) 64)) (should (= (plist-get report :projected-region-count) 1024)) (should (= (plist-get report :buffer-comparisons) 64)) (should (= (plist-get report :region-comparisons) 1024)))) (dolist (buffer buffers) (when (buffer-live-p buffer) (kill-buffer buffer)))))) (provide 'ebox-state-contract-tests) ;;; ebox-state-contract-tests.el ends here