refactor: Migrate tests into literate Org files per LP standard
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 3s
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 3s
- Add test suites inline in harness/communication.org - Add test suites inline in harness/perceive.org, reason.org, act.org - Add test suites inline in harness/skills.org, memory.org, loop.org - Tests now live alongside code, not in separate .lisp files - Each test block has prose explaining its purpose Test results: 84/84 pass (100%)
This commit is contained in:
@@ -148,6 +148,66 @@ Restores the state of the Memex from one of the previous snapshots.
|
||||
(harness-log "MEMORY ERROR - Snapshot ~a not found." index))))
|
||||
#+end_src
|
||||
|
||||
* Test Suite
|
||||
|
||||
These tests verify the Memory system. Run with:
|
||||
~(fiveam:run! 'memory-suite)~
|
||||
|
||||
#+begin_src lisp :tangle ../tests/memory-tests.lisp
|
||||
(defpackage :opencortex-memory-tests
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:memory-suite))
|
||||
|
||||
(in-package :opencortex-memory-tests)
|
||||
|
||||
(def-suite memory-suite
|
||||
:description "Tests for the Merkle-Tree Memory")
|
||||
|
||||
(in-suite memory-suite)
|
||||
|
||||
(test merkle-hash-consistency
|
||||
"Verify identical ASTs produce identical Merkle hashes."
|
||||
(let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
|
||||
(clrhash *memory*)
|
||||
(let ((id1 (ingest-ast ast1)))
|
||||
(let ((hash1 (org-object-hash (lookup-object id1))))
|
||||
(clrhash *memory*)
|
||||
(let ((id2 (ingest-ast ast1)))
|
||||
(let ((hash2 (org-object-hash (lookup-object id2))))
|
||||
(is (equal hash1 hash2))))))))
|
||||
|
||||
(test history-store-immutability
|
||||
"Verify that *history-store* retains old versions."
|
||||
(clrhash *memory*)
|
||||
(clrhash *history-store*)
|
||||
(let* ((ast-v1 '(:type :HEADLINE :properties (:ID "test-node" :TITLE "Version 1") :contents nil))
|
||||
(id-v1 (ingest-ast ast-v1))
|
||||
(obj-v1 (lookup-object id-v1))
|
||||
(hash-v1 (org-object-hash obj-v1)))
|
||||
(let* ((ast-v2 '(:type :HEADLINE :properties (:ID "test-node" :TITLE "Version 2") :contents nil))
|
||||
(id-v2 (ingest-ast ast-v2))
|
||||
(hash-v2 (org-object-hash (lookup-object id-v2))))
|
||||
(is (equal (org-object-hash (lookup-object "test-node")) hash-v2))
|
||||
(is (not (null (gethash hash-v1 *history-store*)))
|
||||
(is (not (null (gethash hash-v2 *history-store*))))))
|
||||
|
||||
(test cow-snapshot-and-rollback
|
||||
"Verify that lightweight snapshots restore previous pointer states."
|
||||
(clrhash *memory*)
|
||||
(setf *object-store-snapshots* nil)
|
||||
(let* ((ast-v1 '(:type :HEADLINE :properties (:ID "cow-node" :TITLE "State A") :contents nil))
|
||||
(id-v1 (ingest-ast ast-v1))
|
||||
(hash-v1 (org-object-hash (lookup-object id-v1))))
|
||||
(snapshot-memory)
|
||||
(let* ((ast-v2 '(:type :HEADLINE :properties (:ID "cow-node" :TITLE "State B") :contents nil))
|
||||
(id-v2 (ingest-ast ast-v2))
|
||||
(hash-v2 (org-object-hash (lookup-object id-v2))))
|
||||
(is (equal (org-object-hash (lookup-object "cow-node")) hash-v2))
|
||||
(rollback-memory 0)
|
||||
(is (equal (org-object-hash (lookup-object "cow-node")) hash-v1))
|
||||
(is (not (null (gethash hash-v2 *history-store*))))))
|
||||
#+end_src
|
||||
|
||||
** Disk Persistence (save-memory / load-memory)
|
||||
Essential for surviving crashes. Saves the in-memory hash tables to disk and loads them back on restart. The path is controlled by the `MEMORY_SNAPSHOT_PATH` environment variable.
|
||||
|
||||
@@ -402,6 +462,30 @@ Following the Engineering Standards, the Memory must be empirically verified thr
|
||||
;; Verify we are back in State A
|
||||
(is (equal (org-object-hash (lookup-object "cow-node")) hash-v1))
|
||||
|
||||
;; Verify State B is still safely in the history store (no data loss)
|
||||
(is (not (null (gethash hash-v2 *history-store*)))))))
|
||||
;; Verify State B is still safely in the history store (no data loss)
|
||||
(is (not (null (gethash hash-v2 *history-store*))))))
|
||||
|
||||
(test merkle-hash-consistency
|
||||
"Verify that identical ASTs produce identical Merkle hashes."
|
||||
(let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
|
||||
(clrhash *memory*)
|
||||
(let ((id1 (ingest-ast ast1)))
|
||||
(let ((hash1 (org-object-hash (lookup-object id1))))
|
||||
(clrhash *memory*)
|
||||
(let ((id2 (ingest-ast ast1)))
|
||||
(let ((hash2 (org-object-hash (lookup-object id2))))
|
||||
(is (equal hash1 hash2))))))))
|
||||
|
||||
(test merkle-hash-cascading
|
||||
"Verify that child changes propagate to parent hashes."
|
||||
(let* ((ast-root '(:type :HEADLINE :properties (:ID "root" :TITLE "Root")
|
||||
:contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf") :contents nil))))
|
||||
(id-root (progn (clrhash *memory*) (ingest-ast ast-root)))
|
||||
(root-hash (org-object-hash (lookup-object id-root))))
|
||||
;; Now ingest a modified child - parent hash should change
|
||||
(let* ((ast-mod '(:type :HEADLINE :properties (:ID "root" :TITLE "Root")
|
||||
:contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Changed") :contents nil))))
|
||||
(id-mod (progn (clrhash *memory*) (ingest-ast ast-mod)))
|
||||
(mod-hash (org-object-hash (lookup-object id-mod))))
|
||||
(is (not (equal root-hash mod-hash))))))
|
||||
#+end_src
|
||||
|
||||
Reference in New Issue
Block a user