fix(chaos): harden Tier 2 tests with deep-copy snapshots and fixed TUI queue

This commit is contained in:
2026-04-28 17:39:51 -04:00
parent 10206860db
commit 6d3cfc7bdc
2 changed files with 10 additions and 5 deletions

View File

@@ -128,7 +128,12 @@ Because objects are stored immutably in the `*history-store*`, a snapshot is a l
(defun snapshot-memory ()
"Creates a lightweight, Copy-on-Write snapshot using Merkle-Tree pointers."
(let ((snapshot (copy-hash-table *memory*)))
;; To prevent live modification of objects from affecting snapshots,
;; we must copy the objects themselves when creating the snapshot.
(let ((snapshot (make-hash-table :test 'equal :size (hash-table-size *memory*))))
(maphash (lambda (k v)
(setf (gethash k snapshot) (copy-org-object v)))
*memory*)
(push (list :timestamp (get-universal-time) :data snapshot) *object-store-snapshots*)
(when (> (length *object-store-snapshots*) 20)
(setf *object-store-snapshots* (subseq *object-store-snapshots* 0 20)))

View File

@@ -129,17 +129,17 @@ A simple MVP console is insufficient for a Lisp Machine. To reach v0.2.0, the TU
(defun enqueue-msg (msg)
"Thread-safe addition to incoming message queue."
(bt:with-lock-held (*queue-lock*)
(push msg *incoming-msgs*)))
#+end_src
(setf *incoming-msgs* (append *incoming-msgs* (list msg)))))
#+begin_src lisp :tangle (expand-file-name "tui-client.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
(defun dequeue-msgs ()
"Thread-safe retrieval of incoming messages."
(bt:with-lock-held (*queue-lock*)
(let ((msgs (nreverse *incoming-msgs*)))
(let ((msgs *incoming-msgs*))
(setf *incoming-msgs* nil)
msgs)))
#+end_src
#+end_src
** Styling Engine
#+begin_src lisp :tangle (expand-file-name "tui-client.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
@@ -193,7 +193,7 @@ A simple MVP console is insufficient for a Lisp Machine. To reach v0.2.0, the TU
:PAYLOAD (list :SENSOR :user-input :TEXT cmd))))
(finish-output stream))
(error (c)
(push "ERROR: Connection to daemon lost." *chat-history*)
(enqueue-msg "ERROR: Connection to daemon lost.")
(setf *is-running* nil))))
(when (string= cmd "/exit") (setf *is-running* nil))
(when (string= cmd "/clear") (setf *chat-history* nil))))