From 3ed2d39f4cbcac7d78ddffa55dc1dd5ddb4a7ec3 Mon Sep 17 00:00:00 2001
From: Kinneyzhang <kinneyzhang666@gmail.com>
Date: Mon, 31 Aug 2026 16:07:38 +0800
Subject: [PATCH] test: keep M0 evidence package-local

---
 Makefile                                   |   3 +-
 scripts/research-shelf-m0a-evidence.el     | 870 +++++++++++++++++++++
 tests/research-shelf-m0a-evidence-tests.el | 240 ++++++
 3 files changed, 1112 insertions(+), 1 deletion(-)
 create mode 100644 scripts/research-shelf-m0a-evidence.el
 create mode 100644 tests/research-shelf-m0a-evidence-tests.el

diff --git a/Makefile b/Makefile
index 1d27dd5..701d90b 100644
--- a/Makefile
+++ b/Makefile
@@ -32,6 +32,7 @@ compile:
 		--eval '(dolist (file (quote ($(foreach file,$(EXAMPLES),"$(file)")))) (byte-compile-file file))' \
 		--eval '(byte-compile-file "etaf-playground.el")' \
 		--eval '(byte-compile-file "scripts/playground-gui-scenarios.el")' \
+		--eval '(byte-compile-file "scripts/research-shelf-m0a-evidence.el")' \
 		--eval '(dolist (file (quote ($(foreach file,$(TEST_FILES),"$(file)")))) (byte-compile-file file))'
 
 examples-read: compile
@@ -99,7 +100,7 @@ load: compile
 		--eval '(princ "etaf-playground load OK\\n")'
 
 checkdoc:
-	$(EMACS) -Q --batch --eval '(progn (require (quote checkdoc)) (dolist (file (append (list "etaf-playground.el" "scripts/benchmark-research-shelf.el" "scripts/playground-gui-scenarios.el") (directory-files-recursively "tests" "\\.el$$") (directory-files-recursively "examples" "\\.el$$"))) (checkdoc-file file)))'
+	$(EMACS) -Q --batch --eval '(progn (require (quote checkdoc)) (dolist (file (append (list "etaf-playground.el" "scripts/benchmark-research-shelf.el" "scripts/playground-gui-scenarios.el" "scripts/research-shelf-m0a-evidence.el") (directory-files-recursively "tests" "\\.el$$") (directory-files-recursively "examples" "\\.el$$"))) (checkdoc-file file)))'
 
 check: checkdoc test
 
diff --git a/scripts/research-shelf-m0a-evidence.el b/scripts/research-shelf-m0a-evidence.el
new file mode 100644
index 0000000..fbe2441
--- /dev/null
+++ b/scripts/research-shelf-m0a-evidence.el
@@ -0,0 +1,870 @@
+;;; research-shelf-m0a-evidence.el --- Research Shelf M0a evidence -*- lexical-binding: t; -*-
+
+;;; Commentary:
+;; Reproducible current-behavior evidence for Research Shelf.  Missing target
+;; observability is represented as `observed-gap'; no target counter is
+;; synthesized from elapsed time or inferred from unrelated provider fields.
+
+;;; Code:
+(require 'cl-lib)
+(require 'seq)
+(require 'subr-x)
+(require 'etaf-playground)
+(require 'etaf-performance)
+
+(defvar etaf-research-shelf-database-file)
+(defvar etaf-research-shelf-fixture-size)
+(defvar etaf-research-shelf-page-size)
+(declare-function etaf-research-shelf--database "../examples/research-shelf")
+(declare-function etaf-sqlite-source "etaf-sqlite")
+
+(etaf-define-component etaf-playground-m0a-dependency-fixture (&key source)
+  "Observe SOURCE while retaining equal semantic output."
+  :view (text (expr (progn (etaf-value source) "same"))))
+
+(defvar etaf-playground-m0a--database-label nil
+  "Dynamic database basename redacted from reproducible evidence.")
+
+(defvar etaf-playground-m0a--property-identities nil
+  "Dynamic map used to canonicalize publication-local property identities.")
+
+(defvar etaf-playground-m0a--next-property-identity 0
+  "Next canonical property identity in the current evidence capture.")
+
+(defconst etaf-playground-m0a--package-root
+  (file-name-directory
+   (directory-file-name
+    (file-name-directory (or load-file-name buffer-file-name))))
+  "Absolute etaf-playground package root used by M0a evidence.")
+
+(defconst etaf-playground-m0a-evidence-schema
+  '(:schema-version 1
+    :evidence-mode observed-baseline
+    :semantic
+    (generation root-semantic-id identity-count handler-refs host-refs)
+    :text-properties
+    (text-sha256 property-runs-sha256 property-run-count property-names)
+    :identity (range-identity-count handler-refs host-refs)
+    :lifecycle (mounted unmounted buffer-killed)
+    :sqlite (provider total item-ids result-sha256)
+    :performance
+    (operation-id operation-kind elapsed-ms generation-before generation-after
+                  provider-stages gc-count gc-duration-ms tp-text-operations
+                  tp-property-operations tp-reconciled-objects
+                  tp-created-objects tp-removed-objects tp-moved-objects
+                  tp-full-root tp-scope-count tp-scope-fallback dirty-count
+                  patch-count cost-class changed-sources queued-effects
+                  evaluated-effects turn-count turn-index turn-epoch
+                  semantic-nodes-visited semantic-nodes-changed
+                  semantic-nodes-reused
+                  semantic-nodes-created semantic-nodes-removed
+                  ebox-nodes-materialized full-path-reason
+                  candidate-index-node-visits candidate-index-node-copies
+                  candidate-effect-index-visits candidate-source-index-visits
+                  committed-generation-delta allocation)
+    :gui-first-paint
+    (:status observed-gap
+     :reason no-action-start-to-forced-redisplay-complete-marker
+     :activation before-performance-complete))
+  "Versioned package-local M0a semantic and trace evidence schema.")
+
+(defun etaf-playground-m0a--sha256 (value)
+  "Return a stable SHA-256 digest for printed VALUE."
+  (secure-hash 'sha256 (encode-coding-string (prin1-to-string value) 'utf-8)))
+
+(defun etaf-playground-m0a--canonical-property-identity (value)
+  "Return a stable encounter-order identity for publication-local VALUE."
+  (or (gethash value etaf-playground-m0a--property-identities)
+      (puthash value
+               (prog1 etaf-playground-m0a--next-property-identity
+                 (setq etaf-playground-m0a--next-property-identity
+                       (1+ etaf-playground-m0a--next-property-identity)))
+               etaf-playground-m0a--property-identities)))
+
+(defun etaf-playground-m0a--canonical-paint-value (value)
+  "Canonicalize publication-local TP paint slot symbols in VALUE."
+  (cond
+   ((and (symbolp value)
+         (string-match-p "\\`tp-paint-slot-[0-9]+\\'" (symbol-name value)))
+    (list 'tp-paint-slot
+          (etaf-playground-m0a--canonical-property-identity value)))
+   ((consp value)
+    (cons (etaf-playground-m0a--canonical-paint-value (car value))
+          (etaf-playground-m0a--canonical-paint-value (cdr value))))
+   (t value)))
+
+(defun etaf-playground-m0a--stable-property-value (value &optional property)
+  "Return reproducible evidence for text property VALUE under PROPERTY."
+  (cond
+   ((memq property '(ebox-content ebox-content-owner ebox-content-owners
+                                  ebox-bb ebox-bl ebox-br ebox-bt
+                                  ebox-pb ebox-pl ebox-pr ebox-pt
+                                  ebox-region-id ebox-scroll-region-id))
+    (if (consp value)
+        (mapcar #'etaf-playground-m0a--canonical-property-identity value)
+      (etaf-playground-m0a--canonical-property-identity value)))
+   ((eq property 'face)
+    (etaf-playground-m0a--canonical-paint-value value))
+   ((and (symbolp value)
+         (string-match-p "\\`tp-paint-slot-[0-9]+\\'" (symbol-name value)))
+    (list 'tp-paint-slot
+          (etaf-playground-m0a--canonical-property-identity value)))
+   ((stringp value)
+    (if etaf-playground-m0a--database-label
+        (replace-regexp-in-string
+         (regexp-quote etaf-playground-m0a--database-label)
+         "<database>" value t t)
+      value))
+   ((or (null value) (numberp value) (symbolp value)) value)
+   ((and (consp value)
+         (not (seq-some (lambda (item)
+                          (or (functionp item) (markerp item)
+                              (recordp item) (hash-table-p item)))
+                        (flatten-tree value))))
+    value)
+   ((functionp value) '<function>)
+   ((markerp value) '<marker>)
+   ((hash-table-p value) '<hash-table>)
+   ((recordp value) (list '<record> (type-of value)))
+   (t (list '<opaque> (type-of value)))))
+
+(defun etaf-playground-m0a--property-runs (buffer)
+  "Return normalized text-property runs from BUFFER."
+  (with-current-buffer buffer
+    (let ((position (point-min))
+          (etaf-playground-m0a--property-identities
+           (make-hash-table :test #'equal))
+          (etaf-playground-m0a--next-property-identity 0)
+          runs)
+      (while (< position (point-max))
+        (let* ((next (or (next-property-change position nil (point-max))
+                         (point-max)))
+               (properties (text-properties-at position))
+               normalized)
+          (while properties
+            (let ((property (pop properties))
+                  (value (pop properties)))
+              (push (cons property
+                          (etaf-playground-m0a--stable-property-value
+                           value property))
+                    normalized)))
+          (push (list :start (1- position) :end (1- next)
+                      :properties
+                      (sort normalized
+                            (lambda (left right)
+                              (string< (symbol-name (car left))
+                                       (symbol-name (car right))))))
+                runs)
+          (setq position next)))
+      (nreverse runs))))
+
+(defun etaf-playground-m0a--stable-refs (entries)
+  "Return stable symbol/string/number keys from public ENTRIES."
+  (sort
+   (delq nil
+         (mapcar (lambda (entry)
+                   (let ((key (car entry)))
+                     (and (or (symbolp key) (stringp key) (numberp key)) key)))
+                 entries))
+   (lambda (left right) (string< (format "%S" left) (format "%S" right)))))
+
+(defun etaf-playground-m0a--semantic-evidence (runtime)
+  "Return stable public semantic/identity evidence for RUNTIME."
+  (let* ((generation (etaf-runtime-current-generation runtime))
+         (identity-index (etaf-generation-identity-index generation))
+         (range-count 0))
+    (maphash (lambda (identity _semantic-id)
+               (when (eq (car-safe identity) 'range)
+                 (setq range-count (1+ range-count))))
+             identity-index)
+    (list :generation (etaf-runtime-generation runtime)
+          :root-semantic-id (etaf-generation-root-semantic-id generation)
+          :identity-count (hash-table-count identity-index)
+          :range-identity-count range-count
+          :handler-refs
+          (etaf-playground-m0a--stable-refs
+           (etaf-runtime-handler-entries runtime))
+          :host-refs
+          (etaf-playground-m0a--stable-refs
+           (etaf-runtime-host-props-entries runtime)))))
+
+(defun etaf-playground-m0a--text-evidence (buffer)
+  "Return stable text and text-property evidence from BUFFER."
+  (with-current-buffer buffer
+    (let* ((text (substring-no-properties (buffer-string)))
+           (text (if etaf-playground-m0a--database-label
+                     (replace-regexp-in-string
+                      (regexp-quote etaf-playground-m0a--database-label)
+                      "<database>" text t t)
+                   text))
+           (runs (etaf-playground-m0a--property-runs buffer))
+           names)
+      (dolist (run runs)
+        (dolist (entry (plist-get run :properties))
+          (cl-pushnew (car entry) names)))
+      (list :text-sha256 (etaf-playground-m0a--sha256 text)
+            :text-length (length text)
+            :property-runs-sha256 (etaf-playground-m0a--sha256 runs)
+            :property-run-count (length runs)
+            :property-names
+            (sort names (lambda (left right)
+                          (string< (symbol-name left) (symbol-name right))))))))
+
+(defun etaf-playground-m0a--sqlite-evidence ()
+  "Return stable Research Shelf SQLite result evidence."
+  (let* ((source (etaf-sqlite-source (etaf-research-shelf--database)))
+         (result (etaf-data-source-load-page source nil 1 8))
+         (items (plist-get result :items))
+         (canonical
+          (mapcar
+           (lambda (item)
+             (mapcar (lambda (key) (cons key (plist-get item key)))
+                     '(:id :title :author :kind :status :progress :priority
+                           :starred :note :updated)))
+           items)))
+    (list :provider (plist-get source :provider)
+          :total (plist-get result :total)
+          :item-ids (mapcar (lambda (item) (plist-get item :id)) items)
+          :result-sha256 (etaf-playground-m0a--sha256 canonical))))
+
+(defun etaf-playground-m0a--metadata-field (operation keys)
+  "Return `(FOUND . VALUE)' for the first of KEYS in OPERATION stages."
+  (catch 'found
+    (dolist (stage (etaf-performance-operation-stages operation))
+      (let ((metadata (etaf-performance-stage-metadata stage)))
+        (dolist (key keys)
+          (when (plist-member metadata key)
+            (throw 'found (cons t (plist-get metadata key)))))))
+    (cons nil nil)))
+
+(defun etaf-playground-m0a--observed (value)
+  "Return an observed evidence cell for VALUE."
+  (list :status 'observed :value value))
+
+(defun etaf-playground-m0a--gap (reason)
+  "Return an observed-gap evidence cell with REASON."
+  (list :status 'observed-gap :reason reason))
+
+(defun etaf-playground-m0a--metadata-evidence (operation name keys)
+  "Return NAME evidence read from OPERATION metadata using KEYS."
+  (let ((found (etaf-playground-m0a--metadata-field operation keys)))
+    (cons name
+          (if (car found)
+              (etaf-playground-m0a--observed (cdr found))
+            (etaf-playground-m0a--gap 'not-in-public-report)))))
+
+(defun etaf-playground-m0a--metadata-present-p (operation keys)
+  "Return non-nil when OPERATION reports a non-nil value under KEYS."
+  (let ((found (etaf-playground-m0a--metadata-field operation keys)))
+    (and (car found) (cdr found))))
+
+(defun etaf-playground-m0a--zeroable-metadata-evidence
+    (operation name keys provider)
+  "Return numeric NAME from OPERATION KEYS, observing zero without PROVIDER.
+
+The zero is not a synthesized span: the ordered public provider-stage list is
+the observation that PROVIDER did not participate in the operation."
+  (let ((found (etaf-playground-m0a--metadata-field operation keys)))
+    (cons name
+          (cond
+           ((car found) (etaf-playground-m0a--observed (cdr found)))
+           ((not (seq-some
+                  (lambda (stage)
+                    (eq provider (etaf-performance-stage-provider stage)))
+                  (etaf-performance-operation-stages operation)))
+            (append (etaf-playground-m0a--observed 0)
+                    (list :basis 'provider-stage-absent)))
+           (t (etaf-playground-m0a--gap 'provider-stage-omits-counter))))))
+
+(defun etaf-playground-m0a-performance-evidence (operation &optional allocation)
+  "Return current public report fields and explicit gaps for OPERATION.
+ALLOCATION is the harness-owned before/after allocation observation."
+  (append
+   (list
+    (cons 'operation-id
+          (etaf-playground-m0a--observed
+           (etaf-performance-operation-id operation)))
+    (cons 'operation-kind
+          (etaf-playground-m0a--observed
+           (etaf-performance-operation-kind operation)))
+    (cons 'elapsed-ms
+          (etaf-playground-m0a--observed
+           (etaf-performance-operation-elapsed operation)))
+    (cons 'generation-before
+          (etaf-playground-m0a--observed
+           (etaf-performance-operation-generation-before operation)))
+    (cons 'generation-after
+          (etaf-playground-m0a--observed
+           (etaf-performance-operation-generation-after operation)))
+    (cons 'provider-stages
+          (etaf-playground-m0a--observed
+           (mapcar (lambda (stage)
+                     (cons (etaf-performance-stage-category stage)
+                           (etaf-performance-stage-name stage)))
+                   (etaf-performance-operation-stages operation))))
+    (cons 'gc-count
+          (etaf-playground-m0a--observed
+           (etaf-performance-operation-gc-count operation)))
+    (cons 'gc-duration-ms
+          (etaf-playground-m0a--observed
+           (etaf-performance-operation-gc-elapsed operation))))
+   (mapcar
+    (lambda (spec)
+      (etaf-playground-m0a--zeroable-metadata-evidence
+       operation (car spec) (cdr spec) 'tp))
+    '((tp-text-operations :tp-text-operations :text-operations)
+      (tp-property-operations :tp-property-operations :property-operations)
+      (tp-reconciled-objects :reconciled-objects)
+      (tp-created-objects :created-objects)
+      (tp-removed-objects :removed-objects)
+      (tp-moved-objects :moved-objects)))
+   (mapcar
+    (lambda (spec)
+      (etaf-playground-m0a--metadata-evidence operation (car spec) (cdr spec)))
+    '((tp-full-root :tp-full-root :full-root)
+      (tp-scope-count :tp-scope-count :scope-count)
+      (tp-scope-fallback :tp-scope-fallback :scope-fallback)
+      (dirty-count :dirty-count)
+      (patch-count :patch-count)))
+   (list
+    (cons 'allocation
+          (if allocation
+              (etaf-playground-m0a--observed allocation)
+            (etaf-playground-m0a--gap 'not-measured-by-caller))))))
+
+(defun etaf-playground-m0a--work-probe-create ()
+  "Return empty operation-local current-work instrumentation."
+  (list :changed-sources (make-hash-table :test #'eql)
+        :queued-effects (make-hash-table :test #'eql)
+        :evaluated-effects nil :turns nil
+        :semantic-nodes-visited 0 :semantic-nodes-changed 0
+        :semantic-nodes-reused 0 :semantic-nodes-created 0
+        :semantic-nodes-removed 0 :ebox-nodes-materialized 0
+        :full-generation-p nil))
+
+(defun etaf-playground-m0a--probe-increment (probe key &optional amount)
+  "Increment PROBE numeric KEY by AMOUNT, defaulting to one."
+  (plist-put probe key (+ (or (plist-get probe key) 0) (or amount 1))))
+
+(defun etaf-playground-m0a--probe-semantic-generation
+    (probe runtime base generation)
+  "Record exact candidate classifications for RUNTIME into PROBE.
+BASE and GENERATION are the committed generations bracketing the candidate."
+  (let ((candidate (etaf-runtime-candidate-graph-nodes runtime))
+        (removed (etaf-runtime-candidate-removed-semantic-ids runtime)))
+    (when (hash-table-p candidate)
+      (maphash
+       (lambda (semantic-id semantic)
+         (etaf-playground-m0a--probe-increment
+          probe :semantic-nodes-visited)
+         (let ((old (and base
+                         (etaf--pvec-get
+                          (etaf-generation-semantic-nodes base) semantic-id))))
+           (cond
+            ((null old)
+             (etaf-playground-m0a--probe-increment
+              probe :semantic-nodes-created))
+            ((equal-including-properties old semantic)
+             (etaf-playground-m0a--probe-increment
+              probe :semantic-nodes-reused))
+            (t
+             (etaf-playground-m0a--probe-increment
+              probe :semantic-nodes-changed)))))
+       candidate))
+    (etaf-playground-m0a--probe-increment
+     probe :semantic-nodes-removed (length removed))
+    (when (etaf-runtime-candidate-full-rebuild-p runtime)
+      (plist-put probe :full-generation-p t))
+    generation))
+
+(defun etaf-playground-m0a--call-with-work-probe (runtime function)
+  "Call FUNCTION with operation-local current-work counters for RUNTIME.
+Return `(RESULT . PROBE)'.  Counters observe existing internal boundaries;
+they neither alter scheduling nor add a product reporting contract."
+  (let* ((probe (etaf-playground-m0a--work-probe-create))
+         (route-scheduler (symbol-function 'etaf--runtime-route-scheduler))
+         (enqueue-effect (symbol-function 'etaf--runtime-enqueue-effect))
+         (record-effect (symbol-function
+                         'etaf--runtime-record-effect-input-version))
+         (component-turn (symbol-function 'etaf--runtime-component-overlay))
+         (root-turn (symbol-function 'etaf--runtime-render-root-turn))
+         (build-generation (symbol-function 'etaf--runtime-build-generation))
+         (text-node (symbol-function 'etaf--ebox-text-node))
+         (box-node (symbol-function 'etaf--ebox-box-node))
+         result)
+    (cl-letf
+        (((symbol-function 'etaf--runtime-route-scheduler)
+          (lambda (route source)
+            (when (= (etaf-runtime-route-mount-epoch route)
+                     (etaf-runtime-mount-epoch runtime))
+              (puthash (etaf-reactive-source-id source) t
+                       (plist-get probe :changed-sources)))
+            (funcall route-scheduler route source)))
+         ((symbol-function 'etaf--runtime-enqueue-effect)
+          (lambda (owner effect-id)
+            (let ((new-p (and (eq owner runtime)
+                              (not (gethash
+                                    effect-id
+                                    (etaf-runtime-dirty-effect-ids owner))))))
+              (prog1 (funcall enqueue-effect owner effect-id)
+                (when new-p
+                  (puthash effect-id t (plist-get probe :queued-effects)))))))
+         ((symbol-function 'etaf--runtime-record-effect-input-version)
+          (lambda (owner generation effect-id)
+            (when (eq owner runtime)
+              (push effect-id (plist-get probe :evaluated-effects)))
+            (funcall record-effect owner generation effect-id)))
+         ((symbol-function 'etaf--runtime-component-overlay)
+          (lambda (owner)
+            (when (eq owner runtime)
+              (push (list :kind 'component-overlay
+                          :epoch (etaf-runtime-generation owner))
+                    (plist-get probe :turns)))
+            (funcall component-turn owner)))
+         ((symbol-function 'etaf--runtime-render-root-turn)
+          (lambda (owner &optional force-components-p)
+            (when (eq owner runtime)
+              (push (list :kind 'root
+                          :epoch (etaf-runtime-generation owner))
+                    (plist-get probe :turns)))
+            (funcall root-turn owner force-components-p)))
+         ((symbol-function 'etaf--runtime-build-generation)
+          (lambda (owner &optional base)
+            (let ((generation (funcall build-generation owner base)))
+              (when (eq owner runtime)
+                (etaf-playground-m0a--probe-semantic-generation
+                 probe owner base generation))
+              generation)))
+         ((symbol-function 'etaf--ebox-text-node)
+          (lambda (&rest args)
+            (etaf-playground-m0a--probe-increment
+             probe :ebox-nodes-materialized)
+            (apply text-node args)))
+         ((symbol-function 'etaf--ebox-box-node)
+          (lambda (&rest args)
+            (etaf-playground-m0a--probe-increment
+             probe :ebox-nodes-materialized)
+            (apply box-node args))))
+      (setq result (funcall function)))
+    (cons result probe)))
+
+(defun etaf-playground-m0a--probe-set-value (table)
+  "Return sorted numeric keys observed in hash TABLE."
+  (let (values)
+    (maphash (lambda (key _value) (push key values)) table)
+    (sort values #'<)))
+
+(defun etaf-playground-m0a--work-evidence
+    (operation category probe)
+  "Return M0a current-work evidence for OPERATION, CATEGORY, and PROBE."
+  (let* ((turns (nreverse (plist-get probe :turns)))
+         (changed
+          (etaf-playground-m0a--probe-set-value
+           (plist-get probe :changed-sources)))
+         (queued
+          (etaf-playground-m0a--probe-set-value
+           (plist-get probe :queued-effects)))
+         (evaluated (nreverse (plist-get probe :evaluated-effects)))
+         (public-full-p
+          (etaf-playground-m0a--metadata-present-p
+           operation '(:tp-full-root :full-root :full-rerender)))
+         (full-p (or (plist-get probe :full-generation-p) public-full-p))
+         (cost-class
+          (cond
+           (full-p 'full)
+           ((eq category 'data-mutation) "scope(collection)")
+           ((memq category '(semantic-style viewport-scroll scroll))
+            "scope(subtree/owners)")
+           ((or changed
+                (> (etaf-performance-operation-generation-after operation)
+                   (etaf-performance-operation-generation-before operation)))
+            'delta)
+           (t 'no-op)))
+         (full-reason
+          (if full-p
+              (or (cdr (etaf-playground-m0a--metadata-field
+                        operation '(:native-fallback-reason
+                                    :full-path-reason :fallback-reason)))
+                  (and (plist-get probe :full-generation-p)
+                       'runtime-candidate-full-rebuild)
+                  (and public-full-p 'public-full-root-publication))
+            'not-full-path)))
+    (list
+     (cons 'cost-class (etaf-playground-m0a--observed cost-class))
+     (cons 'changed-sources
+           (etaf-playground-m0a--observed
+            (list :count (length changed) :ids changed)))
+     (cons 'queued-effects
+           (etaf-playground-m0a--observed
+            (list :count (length queued) :ids queued)))
+     (cons 'evaluated-effects
+           (etaf-playground-m0a--observed
+            (list :count (length evaluated) :ids evaluated)))
+     (cons 'turn-count
+           (etaf-playground-m0a--observed (length turns)))
+     (cons 'turn-index
+           (etaf-playground-m0a--observed
+            (number-sequence 1 (length turns))))
+     (cons 'turn-epoch
+           (etaf-playground-m0a--observed
+            (mapcar (lambda (turn) (plist-get turn :epoch)) turns)))
+     (cons 'semantic-nodes-visited
+           (etaf-playground-m0a--observed
+            (plist-get probe :semantic-nodes-visited)))
+     (cons 'semantic-nodes-changed
+           (etaf-playground-m0a--observed
+            (plist-get probe :semantic-nodes-changed)))
+     (cons 'semantic-nodes-reused
+           (etaf-playground-m0a--observed
+            (plist-get probe :semantic-nodes-reused)))
+     (cons 'semantic-nodes-created
+           (etaf-playground-m0a--observed
+            (plist-get probe :semantic-nodes-created)))
+     (cons 'semantic-nodes-removed
+           (etaf-playground-m0a--observed
+            (plist-get probe :semantic-nodes-removed)))
+     (cons 'ebox-nodes-materialized
+           (etaf-playground-m0a--observed
+            (plist-get probe :ebox-nodes-materialized)))
+     (cons 'full-path-reason
+           (etaf-playground-m0a--observed full-reason)))))
+
+(defun etaf-playground-m0a--allocation-observation (before after)
+  "Return raw BEFORE/AFTER `memory-use-counts' plus numeric deltas."
+  (list :api 'memory-use-counts
+        :before before :after after
+        :delta
+        (cl-mapcar (lambda (left right)
+                     (and (numberp left) (numberp right) (- right left)))
+                   before after)))
+
+(defun etaf-playground-m0a--candidate-metric-evidence
+    (runtime generation-before generation-after)
+  "Return candidate metrics for RUNTIME from GENERATION-BEFORE to GENERATION-AFTER."
+  (let ((names '(candidate-index-node-visits candidate-index-node-copies
+                                             candidate-effect-index-visits
+                                             candidate-source-index-visits)))
+    (if (<= generation-after generation-before)
+        (mapcar (lambda (name)
+                  (cons name
+                        (etaf-playground-m0a--gap
+                         'no-candidate-generation-in-operation)))
+                names)
+      (let ((metrics (etaf-runtime-candidate-generation-metrics runtime)))
+        (if (null metrics)
+            (mapcar (lambda (name)
+                      (cons name
+                            (etaf-playground-m0a--gap
+                             'candidate-metrics-unavailable)))
+                    names)
+          (list
+           (cons 'candidate-index-node-visits
+                 (etaf-playground-m0a--observed
+                  (etaf--generation-metrics-node-visits metrics)))
+           (cons 'candidate-index-node-copies
+                 (etaf-playground-m0a--observed
+                  (etaf--generation-metrics-node-copies metrics)))
+           (cons 'candidate-effect-index-visits
+                 (etaf-playground-m0a--observed
+                  (etaf--generation-metrics-effect-visits metrics)))
+           (cons 'candidate-source-index-visits
+                 (etaf-playground-m0a--observed
+                  (etaf--generation-metrics-source-visits metrics)))))))))
+
+(defun etaf-playground-m0a--trace-operation
+    (runtime scenario category function)
+  "Run FUNCTION as SCENARIO on RUNTIME and return CATEGORY evidence."
+  (let* ((before (car (etaf-performance-records)))
+         (before-id (and before (etaf-performance-operation-id before)))
+         (allocation-before (memory-use-counts))
+         (observed
+          (etaf-playground-m0a--call-with-work-probe
+           runtime
+           (lambda ()
+             (etaf-performance-call-operation
+              runtime 'm0a-trace scenario function))))
+         (result (car observed))
+         (probe (cdr observed))
+         (allocation-after (memory-use-counts)))
+    (let ((operation (car (etaf-performance-records))))
+      (unless (and operation
+                   (not (equal before-id
+                               (etaf-performance-operation-id operation)))
+                   (equal scenario
+                          (etaf-performance-operation-label operation)))
+        (error "M0a scenario %s did not emit one public operation" scenario))
+      (let* ((generation-before
+              (etaf-performance-operation-generation-before operation))
+             (generation-after
+              (etaf-performance-operation-generation-after operation))
+             (fields
+              (append
+               (etaf-playground-m0a-performance-evidence
+                operation
+                (etaf-playground-m0a--allocation-observation
+                 allocation-before allocation-after))
+               (etaf-playground-m0a--work-evidence
+                operation category probe)
+               (etaf-playground-m0a--candidate-metric-evidence
+                runtime generation-before generation-after)
+               (list
+                (cons 'committed-generation-delta
+                      (etaf-playground-m0a--observed
+                       (- generation-after generation-before)))))))
+        (list :scenario-id (intern scenario)
+              :category category
+              :operation-label (etaf-performance-operation-label operation)
+              :operation-kind (etaf-performance-operation-kind operation)
+              :result result
+              :public-report-fields fields
+              :gui-first-paint
+              (plist-get etaf-playground-m0a-evidence-schema
+                         :gui-first-paint))))))
+
+(defun etaf-playground-m0a--dependency-only-scenario ()
+  "Capture one equal-output dependency-only scenario."
+  (let ((buffer (generate-new-buffer-name " *etaf-m0a-dependency*"))
+        (source (etaf-ref 0)) runtime evidence)
+    (unwind-protect
+        (progn
+          (etaf-mount
+           buffer
+           (etaf-view
+            (etaf-playground-m0a-dependency-fixture :source source)))
+          (setq runtime (etaf-runtime-for-buffer buffer))
+          (etaf-performance-clear)
+          (etaf-performance-start runtime)
+          (setq evidence
+                (etaf-playground-m0a--trace-operation
+                 runtime "dependency-only" 'dependency-only
+                 (lambda () (setf (etaf-value source) 1))))
+          (etaf-performance-stop runtime))
+      (when (and runtime (etaf-runtime-mounted-p runtime))
+        (ignore-errors (etaf-performance-stop runtime))
+        (etaf-unmount runtime))
+      (when (get-buffer buffer) (kill-buffer buffer)))
+    evidence))
+
+(defun etaf-playground-m0a--scroll-property-position (buffer)
+  "Return a BUFFER position carrying an Ebox scroll-window identity."
+  (with-current-buffer buffer
+    (let ((position (point-min)) found)
+      (while (and (< position (point-max)) (not found))
+        (when (get-text-property position 'ebox-scroll-window)
+          (setq found position))
+        (setq position
+              (or (next-single-property-change
+                   position 'ebox-scroll-window nil (point-max))
+                  (point-max))))
+      found)))
+
+(defun etaf-playground-m0a--scroll-scenario ()
+  "Capture one real public scroll operation."
+  (let ((buffer (generate-new-buffer-name " *etaf-m0a-scroll*"))
+        runtime evidence)
+    (unwind-protect
+        (progn
+          (etaf-mount
+           buffer
+           (etaf-view
+            (column :height 3 :overflow 'scroll
+              (box "line-1") (box "line-2") (box "line-3")
+              (box "line-4") (box "line-5") (box "line-6"))))
+          (setq runtime (etaf-runtime-for-buffer buffer))
+          (let* ((position (etaf-playground-m0a--scroll-property-position
+                            buffer))
+                 (region-id
+                  (and position
+                       (with-current-buffer buffer
+                         (get-text-property position 'ebox-scroll-window))))
+                 (before (and region-id
+                              (plist-get (ebox-scroll-state region-id)
+                                         :scroll-offset))))
+            (unless (and position region-id (numberp before))
+              (error "M0a scroll fixture did not publish a scroll owner"))
+            (etaf-performance-clear)
+            (etaf-performance-start runtime)
+            (setq evidence
+                  (etaf-playground-m0a--trace-operation
+                   runtime "public-scroll" 'scroll
+                   (lambda ()
+                     (with-current-buffer buffer
+                       (goto-char position)
+                       (ebox-scroll-down 1)))))
+            (let ((after (plist-get (ebox-scroll-state region-id)
+                                    :scroll-offset)))
+              (unless (> after before)
+                (error "M0a public scroll did not advance its owner"))
+              (setq evidence
+                    (plist-put evidence :current-facts
+                               (list :region-id-present t
+                                     :offset-before before
+                                     :offset-after after))))
+            (etaf-performance-stop runtime)))
+      (when (and runtime (etaf-runtime-mounted-p runtime))
+        (ignore-errors (etaf-performance-stop runtime))
+        (etaf-unmount runtime))
+      (when (get-buffer buffer) (kill-buffer buffer)))
+    evidence))
+
+(defun etaf-playground-m0a--load-app ()
+  "Load the Research Shelf companion from the package root."
+  (unless (featurep 'etaf-research-shelf)
+    (load-file (expand-file-name "examples/research-shelf.el"
+                                etaf-playground-m0a--package-root))))
+
+(defun etaf-playground-m0a-capture-baseline (database buffer)
+  "Capture one complete deterministic baseline using DATABASE and BUFFER."
+  (etaf-playground-m0a--load-app)
+  (let ((default-directory etaf-playground-m0a--package-root)
+        (etaf-research-shelf-database-file database)
+        (etaf-research-shelf-fixture-size 256)
+        (etaf-research-shelf-page-size 12)
+        (etaf-playground-m0a--database-label
+         (file-name-nondirectory database))
+        runtime semantic text sqlite lifecycle result matrix)
+    (unwind-protect
+        (progn
+          (etaf-playground-mount-example
+           buffer "research-shelf" nil
+           '(:viewport-width 1400 :viewport-height 80))
+          (setq runtime (etaf-runtime-for-buffer buffer)
+                lifecycle (list (list :event 'mounted
+                                      :runtime-mounted t :buffer-live t)))
+          (etaf-performance-clear)
+          (etaf-performance-start runtime)
+          (etaf-dispatch-event runtime 'research-shelf-row-1 'press)
+          (push
+           (etaf-playground-m0a--trace-operation
+            runtime "data-mutation" 'data-mutation
+            (lambda ()
+              (etaf-dispatch-event runtime 'research-shelf-progress 'press)))
+           matrix)
+          (push
+           (etaf-playground-m0a--trace-operation
+            runtime "semantic-style-theme" 'semantic-style
+            (lambda ()
+              (etaf-dispatch-event
+               runtime 'research-shelf-theme-toggle 'press)))
+           matrix)
+          (push
+           (etaf-playground-m0a--trace-operation
+            runtime "viewport-resize" 'viewport-scroll
+            (lambda ()
+              (ebox-rerender-buffer-with-context (get-buffer buffer) 720 80)))
+           matrix)
+          (setq semantic (etaf-playground-m0a--semantic-evidence runtime)
+                text (etaf-playground-m0a--text-evidence buffer)
+                sqlite (etaf-playground-m0a--sqlite-evidence))
+          (delete-file database)
+          (let ((controller
+                 (etaf-data-controller
+                  (etaf-sqlite-source (etaf-research-shelf--database))
+                  :auto-load nil :name 'm0a-load-error)))
+            (unwind-protect
+                (push
+                 (etaf-playground-m0a--trace-operation
+                  runtime "data-load-error" 'data-load-error
+                  (lambda ()
+                    (condition-case condition
+                        (etaf-data-load controller)
+                      (error (list :condition (car condition))))))
+                 matrix)
+              (etaf-data-stop controller)))
+          (etaf-performance-stop runtime)
+          (etaf-playground-close buffer)
+          (setq lifecycle
+                (append lifecycle
+                        (list (list :event 'unmounted :runtime-mounted nil)
+                              (list :event 'buffer-killed :buffer-live nil))))
+          (setq result
+                (list :schema-version 1
+                      :semantic semantic :text-properties text
+                      :identity
+                      (list :range-identity-count
+                            (plist-get semantic :range-identity-count)
+                            :handler-refs (plist-get semantic :handler-refs)
+                            :host-refs (plist-get semantic :host-refs))
+                      :lifecycle lifecycle :sqlite sqlite
+                      :performance
+                      (list
+                       :scenario-matrix
+                       (append
+                        (nreverse matrix)
+                        (list
+                         (etaf-playground-m0a--dependency-only-scenario)
+                         (etaf-playground-m0a--scroll-scenario))))
+                      :gui-first-paint
+                      (plist-get etaf-playground-m0a-evidence-schema
+                                 :gui-first-paint))))
+      (when (and runtime (etaf-runtime-mounted-p runtime))
+        (ignore-errors (etaf-performance-stop runtime))
+        (ignore-errors (etaf-unmount runtime)))
+      (when (get-buffer buffer)
+        (kill-buffer buffer)))
+    result))
+
+(defconst etaf-playground-m0a--required-work-fields
+  '(cost-class changed-sources queued-effects evaluated-effects turn-count
+               turn-index turn-epoch semantic-nodes-visited
+               semantic-nodes-changed semantic-nodes-reused
+               semantic-nodes-created semantic-nodes-removed
+               ebox-nodes-materialized full-path-reason
+               tp-text-operations tp-property-operations
+               tp-reconciled-objects tp-created-objects
+               tp-removed-objects tp-moved-objects allocation)
+  "Fields that every representative M0a operation must actually observe.")
+
+(defun etaf-playground-m0a--required-work-observed-p (baseline)
+  "Return non-nil when every representative operation in BASELINE is observed."
+  (cl-every
+   (lambda (scenario)
+     (let ((fields (plist-get scenario :public-report-fields)))
+       (cl-every
+        (lambda (name)
+          (eq 'observed (plist-get (cdr (assq name fields)) :status)))
+        etaf-playground-m0a--required-work-fields)))
+   (plist-get (plist-get baseline :performance) :scenario-matrix)))
+
+(defun etaf-playground-m0a-capture-baseline-batch ()
+  "Write a fresh semantic/trace baseline and JSON metadata from environment.
+`ETAF_M0A_SEMANTIC_OUTPUT' names the raw printed Lisp artifact and
+`ETAF_M0A_SEMANTIC_METADATA' names its machine-readable summary."
+  (let ((output (or (getenv "ETAF_M0A_SEMANTIC_OUTPUT")
+                    (error "ETAF_M0A_SEMANTIC_OUTPUT is not configured")))
+        (metadata (or (getenv "ETAF_M0A_SEMANTIC_METADATA")
+                      (error "ETAF_M0A_SEMANTIC_METADATA is not configured")))
+        (database (make-temp-file "research-shelf-m0a-batch-" nil ".sqlite"))
+        (buffer (generate-new-buffer-name " *research-shelf-m0a-batch*")))
+    (unwind-protect
+        (let* ((baseline
+                (etaf-playground-m0a-capture-baseline database buffer))
+               (matrix
+                (plist-get (plist-get baseline :performance)
+                           :scenario-matrix))
+               (observed-p
+                (etaf-playground-m0a--required-work-observed-p baseline)))
+          (unless observed-p
+            (error "M0a semantic evidence has unobserved required work"))
+          (make-directory (file-name-directory output) t)
+          (make-directory (file-name-directory metadata) t)
+          (with-temp-file output
+            (let ((print-circle t) (print-length nil) (print-level nil))
+              (prin1 baseline (current-buffer))
+              (insert "\n")))
+          (with-temp-file metadata
+            (insert
+             (json-serialize
+              `((schema_version . 1)
+                (scenario_count . ,(length matrix))
+                (required_work_fields_observed . t)
+                (semantic_artifact . ,(file-name-nondirectory output)))))
+            (insert "\n"))
+          (princ (format "semantic-evidence-scenarios=%d required-work=observed\n"
+                         (length matrix)))
+          t)
+      (when (get-buffer buffer) (kill-buffer buffer))
+      (when (file-exists-p database) (delete-file database)))))
+
+(provide 'research-shelf-m0a-evidence)
+;;; research-shelf-m0a-evidence.el ends here
diff --git a/tests/research-shelf-m0a-evidence-tests.el b/tests/research-shelf-m0a-evidence-tests.el
new file mode 100644
index 0000000..e7a1125
--- /dev/null
+++ b/tests/research-shelf-m0a-evidence-tests.el
@@ -0,0 +1,240 @@
+;;; research-shelf-m0a-evidence-tests.el --- Research Shelf M0a tests -*- lexical-binding: t; -*-
+
+;;; Code:
+(require 'ert)
+(defvar etaf-playground-m0a-evidence-schema)
+(declare-function etaf-playground-m0a-capture-baseline
+                  "../scripts/research-shelf-m0a-evidence")
+(declare-function etaf-playground-m0a-capture-baseline-batch
+                  "../scripts/research-shelf-m0a-evidence")
+(load-file (expand-file-name "scripts/research-shelf-m0a-evidence.el"
+                            default-directory))
+
+(defmacro etaf-playground-m0a-test--with-baseline (variable &rest body)
+  "Bind VARIABLE to a fresh Research Shelf baseline while running BODY."
+  (declare (indent 1))
+  `(let ((database (make-temp-file "research-shelf-m0a-" nil ".sqlite"))
+         (buffer (generate-new-buffer-name " *research-shelf-m0a*")))
+     (unwind-protect
+         (let ((,variable
+                (etaf-playground-m0a-capture-baseline database buffer)))
+           ,@body)
+       (when (get-buffer buffer) (kill-buffer buffer))
+       (when (file-exists-p database) (delete-file database)))))
+
+(ert-deftest etaf-playground-m0a-schema-separates-evidence-lanes ()
+  "Define package-local semantic/trace evidence without conflating GUI timing."
+  (dolist (key '(:semantic :text-properties :identity :lifecycle :sqlite
+                           :performance :gui-first-paint))
+    (should (plist-member etaf-playground-m0a-evidence-schema key)))
+  (should
+   (eq 'observed-gap
+       (plist-get
+        (plist-get etaf-playground-m0a-evidence-schema :gui-first-paint)
+        :status))))
+
+(ert-deftest etaf-playground-m0a-baseline-captures-five-current-contracts ()
+  "Capture semantic, text/property, identity, lifecycle, and SQLite evidence."
+  (etaf-playground-m0a-test--with-baseline baseline
+    (should (= 64 (length (plist-get (plist-get baseline :text-properties)
+                                     :text-sha256))))
+    (should (> (plist-get (plist-get baseline :text-properties)
+                          :property-run-count)
+               0))
+    (should (> (plist-get (plist-get baseline :semantic) :identity-count) 0))
+    (should (memq 'research-shelf-row-2
+                  (plist-get (plist-get baseline :identity) :handler-refs)))
+    (should (equal '(mounted unmounted buffer-killed)
+                   (mapcar (lambda (entry) (plist-get entry :event))
+                           (plist-get baseline :lifecycle))))
+    (should (equal 'sqlite
+                   (plist-get (plist-get baseline :sqlite) :provider)))
+    (should (= 256 (plist-get (plist-get baseline :sqlite) :total)))
+    (should (equal '(1 2 3 4 5 6 7 8)
+                   (plist-get (plist-get baseline :sqlite) :item-ids)))))
+
+(ert-deftest etaf-playground-m0a-performance-records-observed-public-fields ()
+  "Record fields actually obtainable for every current scenario report."
+  (etaf-playground-m0a-test--with-baseline baseline
+    (dolist (scenario
+             (plist-get (plist-get baseline :performance) :scenario-matrix))
+      (let ((performance (plist-get scenario :public-report-fields)))
+        (dolist (field '(operation-id operation-kind elapsed-ms
+                                     generation-before generation-after
+                                     provider-stages gc-count gc-duration-ms))
+          (should (eq 'observed (plist-get (cdr (assq field performance))
+                                           :status))))
+        (dolist (field '(tp-text-operations tp-property-operations
+                                           tp-reconciled-objects
+                                           tp-created-objects
+                                           tp-removed-objects tp-moved-objects
+                                           tp-full-root tp-scope-count
+                                           tp-scope-fallback dirty-count
+                                           patch-count))
+          (should (memq (plist-get (cdr (assq field performance)) :status)
+                        '(observed observed-gap))))))))
+
+(ert-deftest etaf-playground-m0a-performance-observes-required-work-fields ()
+  "Observe current cost, reactive turn, and semantic work for every scenario."
+  (etaf-playground-m0a-test--with-baseline baseline
+    (dolist (scenario
+             (plist-get (plist-get baseline :performance) :scenario-matrix))
+      (let ((performance (plist-get scenario :public-report-fields)))
+        (dolist (field '(cost-class changed-sources queued-effects
+                                   evaluated-effects turn-count turn-index
+                                   turn-epoch semantic-nodes-visited
+                                   semantic-nodes-changed
+                                   semantic-nodes-reused semantic-nodes-created
+                                   semantic-nodes-removed
+                                   ebox-nodes-materialized full-path-reason))
+          (should (eq 'observed
+                      (plist-get (cdr (assq field performance)) :status))))
+        (dolist (field '(turn-count semantic-nodes-visited
+                                    semantic-nodes-changed
+                                    semantic-nodes-reused semantic-nodes-created
+                                    semantic-nodes-removed
+                                    ebox-nodes-materialized))
+          (should (natnump
+                   (plist-get (cdr (assq field performance)) :value))))))))
+
+(ert-deftest etaf-playground-m0a-performance-observes-tp-zero-work ()
+  "Distinguish a non-participating TP stage from missing observation."
+  (etaf-playground-m0a-test--with-baseline baseline
+    (dolist (scenario
+             (plist-get (plist-get baseline :performance) :scenario-matrix))
+      (let ((performance (plist-get scenario :public-report-fields)))
+        (dolist (field '(tp-text-operations tp-property-operations
+                                           tp-reconciled-objects
+                                           tp-created-objects
+                                           tp-removed-objects tp-moved-objects))
+          (should (eq 'observed
+                      (plist-get (cdr (assq field performance)) :status)))
+          (should (natnump
+                   (plist-get (cdr (assq field performance)) :value))))))))
+
+(ert-deftest etaf-playground-m0a-performance-work-counters-are-self-consistent ()
+  "Lock the harness counter identities without imposing future budgets."
+  (etaf-playground-m0a-test--with-baseline baseline
+    (dolist (scenario
+             (plist-get (plist-get baseline :performance) :scenario-matrix))
+      (let* ((fields (plist-get scenario :public-report-fields))
+             (value (lambda (field)
+                      (plist-get (cdr (assq field fields)) :value)))
+             (changed (funcall value 'changed-sources))
+             (queued (funcall value 'queued-effects))
+             (evaluated (funcall value 'evaluated-effects))
+             (visited (funcall value 'semantic-nodes-visited)))
+        (should (= (plist-get changed :count)
+                   (length (plist-get changed :ids))))
+        (should (= (plist-get queued :count)
+                   (length (plist-get queued :ids))))
+        (should (= (plist-get evaluated :count)
+                   (length (plist-get evaluated :ids))))
+        (should (= (funcall value 'turn-count)
+                   (length (funcall value 'turn-index))))
+        (should (= (funcall value 'turn-count)
+                   (length (funcall value 'turn-epoch))))
+        (should (= visited
+                   (+ (funcall value 'semantic-nodes-changed)
+                      (funcall value 'semantic-nodes-reused)
+                      (funcall value 'semantic-nodes-created))))
+        (should (or (eq 'not-full-path
+                        (funcall value 'full-path-reason))
+                    (eq 'full (funcall value 'cost-class))))))))
+
+(ert-deftest etaf-playground-m0a-performance-covers-required-scenario-matrix ()
+  "Cover Data, style, viewport, and dependency-only current paths."
+  (etaf-playground-m0a-test--with-baseline baseline
+    (let ((matrix
+            (plist-get (plist-get baseline :performance) :scenario-matrix)))
+      (should
+       (equal '(data-mutation semantic-style viewport-scroll data-load-error
+                              dependency-only scroll)
+              (mapcar (lambda (scenario) (plist-get scenario :category))
+                      matrix)))
+      (dolist (scenario matrix)
+        (should (eq 'm0a-trace (plist-get scenario :operation-kind)))
+        (should (stringp (plist-get scenario :operation-label)))
+        (should (eq 'observed-gap
+                    (plist-get (plist-get scenario :gui-first-paint)
+                               :status)))))))
+
+(ert-deftest etaf-playground-m0a-performance-observes-allocation-and-metrics ()
+  "Observe harness allocation and honest candidate-index metrics."
+  (etaf-playground-m0a-test--with-baseline baseline
+    (let ((matrix
+           (plist-get (plist-get baseline :performance) :scenario-matrix)))
+      (dolist (scenario matrix)
+        (let* ((fields (plist-get scenario :public-report-fields))
+               (allocation (cdr (assq 'allocation fields))))
+          (should (eq 'observed (plist-get allocation :status)))
+          (should (eq 'memory-use-counts
+                      (plist-get (plist-get allocation :value) :api)))
+          (should (listp (plist-get (plist-get allocation :value) :delta)))))
+      (let* ((mutation (car matrix))
+             (fields (plist-get mutation :public-report-fields)))
+        (dolist (field '(candidate-index-node-visits
+                         candidate-index-node-copies
+                         candidate-effect-index-visits
+                         candidate-source-index-visits
+                         committed-generation-delta))
+          (should (eq 'observed
+                      (plist-get (cdr (assq field fields)) :status))))))))
+
+(ert-deftest etaf-playground-m0a-load-error-and-scroll-lock-current-facts ()
+  "Lock isolated load-error facts and a real advancing public scroll owner."
+  (etaf-playground-m0a-test--with-baseline baseline
+    (let* ((matrix
+            (plist-get (plist-get baseline :performance) :scenario-matrix))
+           (load-error
+            (seq-find (lambda (scenario)
+                        (eq 'data-load-error
+                            (plist-get scenario :category)))
+                      matrix))
+           (scroll
+            (seq-find (lambda (scenario)
+                        (eq 'scroll (plist-get scenario :category)))
+                      matrix))
+           (load-fields (plist-get load-error :public-report-fields)))
+      (should (symbolp (plist-get (plist-get load-error :result) :condition)))
+      (should
+       (= (plist-get (cdr (assq 'generation-before load-fields)) :value)
+          (plist-get (cdr (assq 'generation-after load-fields)) :value)))
+      (should (plist-get (plist-get scroll :current-facts)
+                         :region-id-present))
+      (should (> (plist-get (plist-get scroll :current-facts) :offset-after)
+                 (plist-get (plist-get scroll :current-facts)
+                            :offset-before))))))
+
+(ert-deftest etaf-playground-m0a-baseline-stable-projections-are-reproducible ()
+  "Reproduce stable semantic/text/identity/SQLite projections twice."
+  (etaf-playground-m0a-test--with-baseline first
+    (etaf-playground-m0a-test--with-baseline second
+      (dolist (key '(:semantic :text-properties :identity :lifecycle :sqlite))
+        (should (equal (plist-get first key) (plist-get second key)))))))
+
+(ert-deftest etaf-playground-m0a-batch-writes-semantic-evidence-summary ()
+  "Persist raw package-local evidence plus a machine-readable summary."
+  (let* ((directory (make-temp-file "m0a-semantic-output-" t))
+         (output (expand-file-name "semantic.eld" directory))
+         (metadata (expand-file-name "semantic.json" directory))
+         (process-environment (copy-sequence process-environment)))
+    (unwind-protect
+        (progn
+          (setenv "ETAF_M0A_SEMANTIC_OUTPUT" output)
+          (setenv "ETAF_M0A_SEMANTIC_METADATA" metadata)
+          (should (etaf-playground-m0a-capture-baseline-batch))
+          (should (> (file-attribute-size (file-attributes output)) 0))
+          (with-temp-buffer
+            (insert-file-contents metadata)
+            (let ((record
+                   (json-parse-buffer :object-type 'plist
+                                      :array-type 'list)))
+              (should (= 6 (plist-get record :scenario_count)))
+              (should (= 1 (plist-get record :schema_version)))
+              (should (eq t (plist-get record
+                                       :required_work_fields_observed))))))
+      (delete-directory directory t))))
+
+(provide 'research-shelf-m0a-evidence-tests)
+;;; research-shelf-m0a-evidence-tests.el ends here