v0.8.3: TUI stabilization — box calls, package fixes, sandbox, configure
Bug fixes: - Fix box() calls: set color-pair before box, pass ACS default chtype integers - Fix markdown functions: move to passepartout.channel-tui package where Croatoan is imported; use add-attributes/remove-attributes instead of :bold/:underline kwargs to add-string; call theme-color in gate-trace-lines to convert theme keys to Croatoan colors - Fix sandbox: remove dex:get/dex:post from restricted symbols (blocked neuro-provider from loading) - Export *log-lock* from passepartout (was unbound in jailed skill packages) - Fix configure: always deploy to XDG, skip cp when source==dest - Fix bash crash handler format string (~~ escaping) - Revert test reorder in 28 files (caused package leakage in skill loader) Design cleanup: - Extract tui-run-screen from tui-main for clean separation - Remove inject-stimulus alias - Merge *backend-registry* into *probabilistic-backends* - Fix read-framed-message whitespace DoS (4096-iteration max) - Add *read-eval* nil to dispatcher-approvals-process read-from-string
This commit is contained in:
@@ -46,142 +46,6 @@ The tradeoff is memory usage: each snapshot is a deep copy of every object in ac
|
||||
4. (snapshot-memory): deep-copies ~*memory-store*~ to ~*memory-snapshots*~.
|
||||
5. (rollback-memory snap-index): restores ~*memory-store*~ from a snapshot.
|
||||
|
||||
* Test Suite
|
||||
Verifies that the Merkle hash is deterministic and consistent across independent AST ingestions.
|
||||
#+begin_src lisp
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
(defpackage :passepartout-memory-tests
|
||||
(:use :cl :fiveam :passepartout)
|
||||
(:export #:memory-suite))
|
||||
|
||||
(in-package :passepartout-memory-tests)
|
||||
|
||||
(def-suite memory-suite :description "Tests for the Merkle-Tree Memory")
|
||||
(in-suite memory-suite)
|
||||
|
||||
(test merkle-hash-consistency
|
||||
"Contract 2: identical ASTs produce identical Merkle hashes."
|
||||
(let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(let ((id1 (ingest-ast ast1)))
|
||||
(let ((hash1 (memory-object-hash (memory-object-get id1))))
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(let ((id2 (ingest-ast ast1)))
|
||||
(is (equal hash1 (memory-object-hash (memory-object-get id2)))))))))
|
||||
|
||||
(test merkle-hash-different
|
||||
"Contract 2: distinct ASTs produce different Merkle hashes."
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(let* ((ast1 '(:type :HEADLINE :properties (:ID "a" :TITLE "Alpha") :contents nil))
|
||||
(ast2 '(:type :HEADLINE :properties (:ID "b" :TITLE "Beta") :contents nil))
|
||||
(id1 (ingest-ast ast1))
|
||||
(id2 (ingest-ast ast2))
|
||||
(hash1 (memory-object-hash (memory-object-get id1)))
|
||||
(hash2 (memory-object-hash (memory-object-get id2))))
|
||||
(is (not (equal hash1 hash2)))))
|
||||
|
||||
(test test-ingest-ast-returns-id
|
||||
"Contract 1: ingest-ast returns a string ID and stores the object."
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "ingest-test" :TITLE "Test Node") :contents nil))))
|
||||
(is (stringp id))
|
||||
(is (not (null id)))))
|
||||
|
||||
(test test-memory-object-get
|
||||
"Contract 3: memory-object-get retrieves an object by ID after ingest."
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "get-test" :TITLE "Retrieve Me") :contents nil))))
|
||||
(let ((obj (memory-object-get id)))
|
||||
(is (not (null obj)))
|
||||
(is (eq :HEADLINE (memory-object-type obj)))
|
||||
(is (string= "Retrieve Me" (getf (memory-object-attributes obj) :TITLE))))))
|
||||
|
||||
(test test-snapshot-and-rollback
|
||||
"Contract 4+5: snapshot-memory saves state; rollback-memory restores it."
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(setf passepartout::*memory-snapshots* nil)
|
||||
(ingest-ast '(:type :HEADLINE :properties (:ID "snap-a" :TITLE "Pre-snapshot") :contents nil))
|
||||
(snapshot-memory)
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(ingest-ast '(:type :HEADLINE :properties (:ID "snap-b" :TITLE "Post-snapshot") :contents nil))
|
||||
(rollback-memory 0)
|
||||
(is (not (null (memory-object-get "snap-a"))))
|
||||
(is (null (memory-object-get "snap-b"))))
|
||||
|
||||
(test test-undo-snapshot-restore
|
||||
"Contract v0.7.2: undo-snapshot captures state, undo restores."
|
||||
(let ((orig-store passepartout::*memory-store*)
|
||||
(orig-undo passepartout::*undo-stack*)
|
||||
(orig-redo passepartout::*redo-stack*))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setf passepartout::*memory-store* (make-hash-table :test 'equal)
|
||||
passepartout::*undo-stack* nil
|
||||
passepartout::*redo-stack* nil)
|
||||
(passepartout::undo-snapshot)
|
||||
(setf (gethash "x" passepartout::*memory-store*) "hello")
|
||||
(is (string= "hello" (gethash "x" passepartout::*memory-store*)))
|
||||
(is (passepartout::undo))
|
||||
(is (null (gethash "x" passepartout::*memory-store*))))
|
||||
(setf passepartout::*memory-store* orig-store
|
||||
passepartout::*undo-stack* orig-undo
|
||||
passepartout::*redo-stack* orig-redo))))
|
||||
|
||||
(test test-undo-redo-cycle
|
||||
"Contract v0.7.2: redo restores undone state."
|
||||
(let ((orig-store passepartout::*memory-store*)
|
||||
(orig-undo passepartout::*undo-stack*)
|
||||
(orig-redo passepartout::*redo-stack*))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setf passepartout::*memory-store* (make-hash-table :test 'equal)
|
||||
passepartout::*undo-stack* nil
|
||||
passepartout::*redo-stack* nil)
|
||||
(passepartout::undo-snapshot)
|
||||
(setf (gethash "y" passepartout::*memory-store*) "world")
|
||||
(is (passepartout::undo))
|
||||
(is (null (gethash "y" passepartout::*memory-store*)))
|
||||
(is (passepartout::redo))
|
||||
(is (string= "world" (gethash "y" passepartout::*memory-store*))))
|
||||
(setf passepartout::*memory-store* orig-store
|
||||
passepartout::*undo-stack* orig-undo
|
||||
passepartout::*redo-stack* orig-redo))))
|
||||
|
||||
(test test-undo-empty-stack-nil
|
||||
"Contract v0.7.2: undo returns nil on empty stack."
|
||||
(let ((orig-undo passepartout::*undo-stack*))
|
||||
(unwind-protect
|
||||
(progn (setf passepartout::*undo-stack* nil)
|
||||
(is (null (passepartout::undo))))
|
||||
(setf passepartout::*undo-stack* orig-undo))))
|
||||
|
||||
(test test-audit-node-found
|
||||
"Contract v0.7.2: audit-node returns info for existing object."
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(setf (gethash "audit-1" passepartout::*memory-store*)
|
||||
(passepartout::make-memory-object :id "audit-1" :type :HEADLINE
|
||||
:version 1 :hash "abc123" :scope :memex))
|
||||
(let ((info (passepartout::audit-node "audit-1")))
|
||||
(is (not (null info)))
|
||||
(is (eq :HEADLINE (getf info :type)))
|
||||
(is (string= "abc123" (getf info :hash)))))
|
||||
|
||||
(test test-audit-node-not-found
|
||||
"Contract v0.7.2: audit-node returns nil for nonexistent id."
|
||||
(is (null (passepartout::audit-node "nonexistent-xxxx"))))
|
||||
|
||||
(test test-audit-verify-hash
|
||||
"Contract v0.7.2: audit-verify-hash returns (total . missing)."
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(setf (gethash "a" passepartout::*memory-store*)
|
||||
(passepartout::make-memory-object :id "a" :type :HEADLINE :hash "abc"))
|
||||
(let ((result (passepartout::audit-verify-hash)))
|
||||
(is (= 1 (car result)))
|
||||
(is (= 0 (cdr result)))))
|
||||
#+end_src
|
||||
|
||||
* Implementation
|
||||
|
||||
** Package Context
|
||||
@@ -567,3 +431,138 @@ Returns (total . missing-hashes)."
|
||||
(cons total missing)))
|
||||
#+end_src
|
||||
|
||||
* Test Suite
|
||||
Verifies that the Merkle hash is deterministic and consistent across independent AST ingestions.
|
||||
#+begin_src lisp
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
(defpackage :passepartout-memory-tests
|
||||
(:use :cl :fiveam :passepartout)
|
||||
(:export #:memory-suite))
|
||||
|
||||
(in-package :passepartout-memory-tests)
|
||||
|
||||
(def-suite memory-suite :description "Tests for the Merkle-Tree Memory")
|
||||
(in-suite memory-suite)
|
||||
|
||||
(test merkle-hash-consistency
|
||||
"Contract 2: identical ASTs produce identical Merkle hashes."
|
||||
(let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(let ((id1 (ingest-ast ast1)))
|
||||
(let ((hash1 (memory-object-hash (memory-object-get id1))))
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(let ((id2 (ingest-ast ast1)))
|
||||
(is (equal hash1 (memory-object-hash (memory-object-get id2)))))))))
|
||||
|
||||
(test merkle-hash-different
|
||||
"Contract 2: distinct ASTs produce different Merkle hashes."
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(let* ((ast1 '(:type :HEADLINE :properties (:ID "a" :TITLE "Alpha") :contents nil))
|
||||
(ast2 '(:type :HEADLINE :properties (:ID "b" :TITLE "Beta") :contents nil))
|
||||
(id1 (ingest-ast ast1))
|
||||
(id2 (ingest-ast ast2))
|
||||
(hash1 (memory-object-hash (memory-object-get id1)))
|
||||
(hash2 (memory-object-hash (memory-object-get id2))))
|
||||
(is (not (equal hash1 hash2)))))
|
||||
|
||||
(test test-ingest-ast-returns-id
|
||||
"Contract 1: ingest-ast returns a string ID and stores the object."
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "ingest-test" :TITLE "Test Node") :contents nil))))
|
||||
(is (stringp id))
|
||||
(is (not (null id)))))
|
||||
|
||||
(test test-memory-object-get
|
||||
"Contract 3: memory-object-get retrieves an object by ID after ingest."
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "get-test" :TITLE "Retrieve Me") :contents nil))))
|
||||
(let ((obj (memory-object-get id)))
|
||||
(is (not (null obj)))
|
||||
(is (eq :HEADLINE (memory-object-type obj)))
|
||||
(is (string= "Retrieve Me" (getf (memory-object-attributes obj) :TITLE))))))
|
||||
|
||||
(test test-snapshot-and-rollback
|
||||
"Contract 4+5: snapshot-memory saves state; rollback-memory restores it."
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(setf passepartout::*memory-snapshots* nil)
|
||||
(ingest-ast '(:type :HEADLINE :properties (:ID "snap-a" :TITLE "Pre-snapshot") :contents nil))
|
||||
(snapshot-memory)
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(ingest-ast '(:type :HEADLINE :properties (:ID "snap-b" :TITLE "Post-snapshot") :contents nil))
|
||||
(rollback-memory 0)
|
||||
(is (not (null (memory-object-get "snap-a"))))
|
||||
(is (null (memory-object-get "snap-b"))))
|
||||
|
||||
(test test-undo-snapshot-restore
|
||||
"Contract v0.7.2: undo-snapshot captures state, undo restores."
|
||||
(let ((orig-store passepartout::*memory-store*)
|
||||
(orig-undo passepartout::*undo-stack*)
|
||||
(orig-redo passepartout::*redo-stack*))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setf passepartout::*memory-store* (make-hash-table :test 'equal)
|
||||
passepartout::*undo-stack* nil
|
||||
passepartout::*redo-stack* nil)
|
||||
(passepartout::undo-snapshot)
|
||||
(setf (gethash "x" passepartout::*memory-store*) "hello")
|
||||
(is (string= "hello" (gethash "x" passepartout::*memory-store*)))
|
||||
(is (passepartout::undo))
|
||||
(is (null (gethash "x" passepartout::*memory-store*))))
|
||||
(setf passepartout::*memory-store* orig-store
|
||||
passepartout::*undo-stack* orig-undo
|
||||
passepartout::*redo-stack* orig-redo))))
|
||||
|
||||
(test test-undo-redo-cycle
|
||||
"Contract v0.7.2: redo restores undone state."
|
||||
(let ((orig-store passepartout::*memory-store*)
|
||||
(orig-undo passepartout::*undo-stack*)
|
||||
(orig-redo passepartout::*redo-stack*))
|
||||
(unwind-protect
|
||||
(progn
|
||||
(setf passepartout::*memory-store* (make-hash-table :test 'equal)
|
||||
passepartout::*undo-stack* nil
|
||||
passepartout::*redo-stack* nil)
|
||||
(passepartout::undo-snapshot)
|
||||
(setf (gethash "y" passepartout::*memory-store*) "world")
|
||||
(is (passepartout::undo))
|
||||
(is (null (gethash "y" passepartout::*memory-store*)))
|
||||
(is (passepartout::redo))
|
||||
(is (string= "world" (gethash "y" passepartout::*memory-store*))))
|
||||
(setf passepartout::*memory-store* orig-store
|
||||
passepartout::*undo-stack* orig-undo
|
||||
passepartout::*redo-stack* orig-redo))))
|
||||
|
||||
(test test-undo-empty-stack-nil
|
||||
"Contract v0.7.2: undo returns nil on empty stack."
|
||||
(let ((orig-undo passepartout::*undo-stack*))
|
||||
(unwind-protect
|
||||
(progn (setf passepartout::*undo-stack* nil)
|
||||
(is (null (passepartout::undo))))
|
||||
(setf passepartout::*undo-stack* orig-undo))))
|
||||
|
||||
(test test-audit-node-found
|
||||
"Contract v0.7.2: audit-node returns info for existing object."
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(setf (gethash "audit-1" passepartout::*memory-store*)
|
||||
(passepartout::make-memory-object :id "audit-1" :type :HEADLINE
|
||||
:version 1 :hash "abc123" :scope :memex))
|
||||
(let ((info (passepartout::audit-node "audit-1")))
|
||||
(is (not (null info)))
|
||||
(is (eq :HEADLINE (getf info :type)))
|
||||
(is (string= "abc123" (getf info :hash)))))
|
||||
|
||||
(test test-audit-node-not-found
|
||||
"Contract v0.7.2: audit-node returns nil for nonexistent id."
|
||||
(is (null (passepartout::audit-node "nonexistent-xxxx"))))
|
||||
|
||||
(test test-audit-verify-hash
|
||||
"Contract v0.7.2: audit-verify-hash returns (total . missing)."
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(setf (gethash "a" passepartout::*memory-store*)
|
||||
(passepartout::make-memory-object :id "a" :type :HEADLINE :hash "abc"))
|
||||
(let ((result (passepartout::audit-verify-hash)))
|
||||
(is (= 1 (car result)))
|
||||
(is (= 0 (cdr result)))))
|
||||
#+end_src
|
||||
Reference in New Issue
Block a user