amr/passepartout
1
0
Fork 0
Code Issues 15 Pull Requests 1 Actions Packages Projects Releases Wiki Activity

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

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-28 17:39:51 -04:00
parent 10206860db
commit 6d3cfc7bdc
2 changed files with 10 additions and 5 deletions
Download Patch File Download Diff File Expand all files Collapse all files

7
harness/memory.org
View File

@@ -128,7 +128,12 @@ Because objects are stored immutably in the `*history-store*`, a snapshot is a l
(defun snapshot-memory () (defun snapshot-memory ()
"Creates a lightweight, Copy-on-Write snapshot using Merkle-Tree pointers." "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*) (push (list :timestamp (get-universal-time) :data snapshot) *object-store-snapshots*)
(when (> (length *object-store-snapshots*) 20) (when (> (length *object-store-snapshots*) 20)
(setf *object-store-snapshots* (subseq *object-store-snapshots* 0 20))) (setf *object-store-snapshots* (subseq *object-store-snapshots* 0 20)))

8
harness/tui-client.org
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) (defun enqueue-msg (msg)
"Thread-safe addition to incoming message queue." "Thread-safe addition to incoming message queue."
(bt:with-lock-held (*queue-lock*) (bt:with-lock-held (*queue-lock*)
(push msg *incoming-msgs*))) (setf *incoming-msgs* (append *incoming-msgs* (list msg)))))
#+end_src
#+begin_src lisp :tangle (expand-file-name "tui-client.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness")) #+begin_src lisp :tangle (expand-file-name "tui-client.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness"))
(defun dequeue-msgs () (defun dequeue-msgs ()
"Thread-safe retrieval of incoming messages." "Thread-safe retrieval of incoming messages."
(bt:with-lock-held (*queue-lock*) (bt:with-lock-held (*queue-lock*)
(let ((msgs (nreverse *incoming-msgs*))) (let ((msgs *incoming-msgs*))
(setf *incoming-msgs* nil) (setf *incoming-msgs* nil)
msgs))) msgs)))
#+end_src #+end_src
#+end_src
** Styling Engine ** Styling Engine
#+begin_src lisp :tangle (expand-file-name "tui-client.lisp" (concat (or (getenv "INSTALL_DIR") ".") "/harness")) #+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)))) :PAYLOAD (list :SENSOR :user-input :TEXT cmd))))
(finish-output stream)) (finish-output stream))
(error (c) (error (c)
(push "ERROR: Connection to daemon lost." *chat-history*) (enqueue-msg "ERROR: Connection to daemon lost.")
(setf *is-running* nil)))) (setf *is-running* nil))))
(when (string= cmd "/exit") (setf *is-running* nil)) (when (string= cmd "/exit") (setf *is-running* nil))
(when (string= cmd "/clear") (setf *chat-history* nil)))) (when (string= cmd "/clear") (setf *chat-history* nil))))