v0.8.2: cleanup + prose + structure + decomposition + budget + errors
Phase 1 — dedup + hardening (~9 items): - Remove duplicate *skill-registry* defvar from core-skills - Merge *backend-registry* into *probabilistic-backends*, delete backend-register - Remove inject-stimulus alias, standardize on stimulus-inject - Add pre-eval sandbox (skill-source-scan) blocks restricted symbols before eval - Remove dead plist-get function; remove duplicate json-alist-to-plist export - Fix read-framed-message whitespace DoS (4096-iteration max) - Add *read-eval* nil to dispatcher-approvals-process read-from-string (RCE) - Add test-op to ASDF; update .asd version 0.4.3→0.7.2 Phase 2 — prose + contracts + reorder: - Split ROADMAP: 2623→1089 lines (TODO only), CHANGELOG: 260→1528 lines (full DONE history, 14 versions reverse chron) - Add Contracts + Overview to 6 channel files + embedding-native + programming-standards + symbolic-scope - Reorder 28 .org files: Contract → Test Suite → Implementation (TDD order) - Add 7-phase inline prose to think() in core-reason - Expand USER_MANUAL: 183→461 lines (10 new sections) Phase 3 — decomposition + export organization: - Decompose think() into think-assemble-prompt, think-call-llm, think-parse-response orchestrator - Organize 188 exports into 16 grouped sections by module Phase 4 — budget enforcement + error protocol: - Per-session budget enforcement (SESSION_BUDGET_USD env var, budget-exhausted-p, guard in think-call-llm) - Error condition hierarchy (6 conditions: pipeline-error, llm-error, gate-error, budget-error, protocol-error) - Restarts in loop-process: skip-signal, use-fallback, abort-pipeline
This commit is contained in:
@@ -1,3 +1,47 @@
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
(defpackage :passepartout-pipeline-perceive-tests
|
||||
(:use :cl :fiveam :passepartout)
|
||||
(:export #:pipeline-perceive-suite))
|
||||
|
||||
(in-package :passepartout-pipeline-perceive-tests)
|
||||
|
||||
(def-suite pipeline-perceive-suite :description "Test suite for Perceive pipeline")
|
||||
(in-suite pipeline-perceive-suite)
|
||||
|
||||
(test test-loop-gate-perceive
|
||||
"Contract 1: :buffer-update ingests AST and sets :perceived status."
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test") :contents nil))))
|
||||
(result (loop-gate-perceive signal)))
|
||||
(is (eq :perceived (getf result :status)))
|
||||
(is (not (null (gethash "test-node" passepartout::*memory-store*))))))
|
||||
|
||||
(test test-depth-limiting
|
||||
"Edge: depth 11 signals are rejected by the pipeline."
|
||||
(let ((runaway-signal (list :type :EVENT :depth 11 :payload (list :sensor :heartbeat))))
|
||||
(is (null (process-signal runaway-signal)))))
|
||||
|
||||
(test test-loop-gate-perceive-unknown-sensor
|
||||
"Contract 1: unknown sensors pass through and reach :perceived."
|
||||
(let* ((signal (list :type :EVENT :depth 0 :payload (list :sensor :custom-metric)))
|
||||
(result (loop-gate-perceive signal)))
|
||||
(is (eq :perceived (getf result :status)))))
|
||||
|
||||
(test test-loop-gate-perceive-no-ast
|
||||
"Contract 1: :buffer-update without AST doesn't crash, reaches :perceived."
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(let* ((signal (list :type :EVENT :depth 0 :payload (list :sensor :buffer-update)))
|
||||
(result (loop-gate-perceive signal)))
|
||||
(is (eq :perceived (getf result :status)))))
|
||||
|
||||
(test test-depth-limiting-normal
|
||||
"Contract 1: signals at normal depth pass through without rejection."
|
||||
(let ((normal-signal (list :type :EVENT :depth 5 :payload (list :sensor :heartbeat))))
|
||||
(is (not (eq :rejected (getf normal-signal :status)))
|
||||
"Signal at normal depth should not be rejected")))
|
||||
|
||||
(in-package :passepartout)
|
||||
|
||||
(defvar *loop-interrupt* nil)
|
||||
@@ -19,9 +63,6 @@
|
||||
FN receives (signal) and returns T if consumed, nil to continue."
|
||||
(setf (gethash sensor *pre-reason-handlers*) fn))
|
||||
|
||||
(defun inject-stimulus (raw-message &key stream (depth 0))
|
||||
(stimulus-inject raw-message :stream stream :depth depth))
|
||||
|
||||
(defun stimulus-inject (raw-message &key stream (depth 0))
|
||||
"Inject a raw message into the signal processing pipeline."
|
||||
(let* ((payload (getf raw-message :payload))
|
||||
@@ -116,47 +157,3 @@ FN receives (signal) and returns T if consumed, nil to continue."
|
||||
|
||||
(defun perceive-gate (signal)
|
||||
(loop-gate-perceive signal))
|
||||
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
(defpackage :passepartout-pipeline-perceive-tests
|
||||
(:use :cl :fiveam :passepartout)
|
||||
(:export #:pipeline-perceive-suite))
|
||||
|
||||
(in-package :passepartout-pipeline-perceive-tests)
|
||||
|
||||
(def-suite pipeline-perceive-suite :description "Test suite for Perceive pipeline")
|
||||
(in-suite pipeline-perceive-suite)
|
||||
|
||||
(test test-loop-gate-perceive
|
||||
"Contract 1: :buffer-update ingests AST and sets :perceived status."
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test") :contents nil))))
|
||||
(result (loop-gate-perceive signal)))
|
||||
(is (eq :perceived (getf result :status)))
|
||||
(is (not (null (gethash "test-node" passepartout::*memory-store*))))))
|
||||
|
||||
(test test-depth-limiting
|
||||
"Edge: depth 11 signals are rejected by the pipeline."
|
||||
(let ((runaway-signal (list :type :EVENT :depth 11 :payload (list :sensor :heartbeat))))
|
||||
(is (null (process-signal runaway-signal)))))
|
||||
|
||||
(test test-loop-gate-perceive-unknown-sensor
|
||||
"Contract 1: unknown sensors pass through and reach :perceived."
|
||||
(let* ((signal (list :type :EVENT :depth 0 :payload (list :sensor :custom-metric)))
|
||||
(result (loop-gate-perceive signal)))
|
||||
(is (eq :perceived (getf result :status)))))
|
||||
|
||||
(test test-loop-gate-perceive-no-ast
|
||||
"Contract 1: :buffer-update without AST doesn't crash, reaches :perceived."
|
||||
(clrhash passepartout::*memory-store*)
|
||||
(let* ((signal (list :type :EVENT :depth 0 :payload (list :sensor :buffer-update)))
|
||||
(result (loop-gate-perceive signal)))
|
||||
(is (eq :perceived (getf result :status)))))
|
||||
|
||||
(test test-depth-limiting-normal
|
||||
"Contract 1: signals at normal depth pass through without rejection."
|
||||
(let ((normal-signal (list :type :EVENT :depth 5 :payload (list :sensor :heartbeat))))
|
||||
(is (not (eq :rejected (getf normal-signal :status)))
|
||||
"Signal at normal depth should not be rejected")))
|
||||
|
||||
Reference in New Issue
Block a user