e55798e0e9
Some checks are pending
CI / test (push) Waiting to run
CI / native-build (macos-latest) (push) Waiting to run
CI / native-build (ubuntu-latest) (push) Waiting to run
CI / native-build (windows-latest) (push) Waiting to run
CI / native-msrv (macos-latest) (push) Waiting to run
CI / native-msrv (ubuntu-latest) (push) Waiting to run
CI / native-msrv (windows-latest) (push) Waiting to run
262 lines
13 KiB
EmacsLisp
262 lines
13 KiB
EmacsLisp
;;; 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
|