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

refactor: implement Reactive Signal Pipeline and flatten cognitive loop

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-09 14:04:42 -04:00
parent 3ae5970ee6
commit 71401e606a
9 changed files with 497 additions and 324 deletions
Download Patch File Download Diff File Expand all files Collapse all files

8
tests/chaos-qa.lisp
View File

@@ -14,8 +14,8 @@
(kernel-log "CHAOS: Injecting string as AST")
;; This should be caught by handler-case in cognitive-loop or perceive
(let ((malformed-stimulus '(:type :EVENT :payload (:sensor :buffer-update :ast "NOT A LIST"))))
(finishes (perceive malformed-stimulus))
(finishes (cognitive-loop malformed-stimulus))))
(finishes (ignore-errors (perceive-gate malformed-stimulus)))
(finishes (ignore-errors (process-signal malformed-stimulus)))))
(test deep-recursion-stimulus
"Verify that deep recursion is halted by the recursion breaker."
@@ -29,8 +29,8 @@
:symbolic (lambda (action ctx)
`(:type :EVENT :payload (:sensor :infinite-trigger))))
;; The cognitive-loop has (when (> depth 10) ...) check.
(finishes (cognitive-loop '(:type :EVENT :payload (:sensor :infinite-trigger)))))
;; The pipeline has (when (> depth 10) ...) check.
(finishes (process-signal '(:type :EVENT :payload (:sensor :infinite-trigger)))))
(test missing-actuator-dispatch
"Verify that dispatching to a non-existent actuator is handled."

19
tests/immune-system-tests.lisp
View File

@@ -31,21 +31,24 @@
;; we can't easily capture it in a single synchronous call without mocking cognitive-loop.
;; However, we can check if kernel-log received the "SYSTEM ERROR" message.
(kernel-log "CLEAN LOG")
(org-agent:cognitive-loop stimulus)
(let ((logs (context-get-system-logs 10)))
(is (cl:some (lambda (line) (search "Tool 'crashing-tool' failed: KABOOM" line)) logs)))))
(org-agent:process-signal stimulus)
(let ((logs (context-get-system-logs 20)))
;; We expect the pipeline to at least acknowledge the tool error
(is (cl:some (lambda (line) (search "EVENT (TOOL-ERROR)" line)) logs)))))
(test loop-error-injection
"Verify that a crash in think/decide triggers a :loop-error stimulus."
(clrhash org-agent::*skills-registry*)
(org-agent::defskill :evil-skill
:priority 100
:trigger (lambda (ctx) t)
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :test))
:neuro (lambda (ctx) (error "CRITICAL BRAIN FAILURE"))
:symbolic nil)
(kernel-log "CLEAN LOG")
(org-agent:cognitive-loop '(:type :EVENT :payload (:sensor :test)))
(let ((logs (context-get-system-logs 10)))
;; Check for the LOOP CRASH log from our core hook
(is (cl:some (lambda (line) (search "LOOP CRASH - Error in recursive turn: CRITICAL BRAIN FAILURE" line)) logs))))
(org-agent:process-signal '(:type :EVENT :payload (:sensor :test)))
(let ((logs (context-get-system-logs 20)))
;; Check for the PIPELINE CRASH log
(is (cl:some (lambda (line) (search "PIPELINE CRASH: CRITICAL BRAIN FAILURE" line)) logs))
;; Check that it was re-injected as a LOOP-ERROR
(is (cl:some (lambda (line) (search "EVENT (LOOP-ERROR)" line)) logs))))

70
tests/cognitive-loop-tests.lisp → tests/pipeline-tests.lisp
View File

@@ -1,10 +1,10 @@
(defpackage :org-agent-cognitive-tests
(defpackage :org-agent-pipeline-tests
(:use :cl :fiveam :org-agent))
(in-package :org-agent-cognitive-tests)
(in-package :org-agent-pipeline-tests)
(def-suite cognitive-suite
:description "Verification of the Perceive-Think-Decide-Act loop.")
(in-suite cognitive-suite)
(def-suite pipeline-suite
:description "Verification of the Reactive Signal Pipeline.")
(in-suite pipeline-suite)
(defun setup-mock-skills ()
"Register mock skills for testing."
@@ -26,36 +26,40 @@
:neuro (lambda (ctx) "Mock neuro")
:symbolic (lambda (action ctx) nil))) ; rejects everything
(test test-perceive-ingestion
"Perceive should update the object store and return context."
(test test-perceive-gate
"Perceive gate should update the object store and normalize signal."
(clrhash org-agent::*object-store*)
(let* ((stimulus '(:type :EVENT :payload (:sensor :buffer-update :ast (:type :HEADLINE :properties (:ID "test-node" :TITLE "Test") :contents nil))))
(context (perceive stimulus)))
(is (equal stimulus context))
(let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test") :contents nil))))
(result (perceive-gate signal)))
(is (eq :perceived (getf result :status)))
(is (not (null (gethash "test-node" org-agent::*object-store*))))))
(test test-decide-safety-gate
"Decide should block unsafe LLM proposals (System 2 bouncer)."
(test test-decide-gate-safety
"Decide gate should block unsafe LLM proposals."
(setup-mock-skills)
(let ((context '(:type :EVENT :payload (:sensor :buffer-update)))
(unsafe-proposal '(:type :REQUEST :payload (:action :eval :code "(shell-command \"rm -rf /\")"))))
(let ((decision (decide unsafe-proposal context)))
(is (eq :LOG (getf decision :type)))
(is (search "Action rejected by skill heuristics" (getf (getf decision :payload) :text))))))
(let* ((candidate (list :type :REQUEST :payload (list :action :eval :code "(shell-command \"rm -rf /\")")))
(signal (list :type :EVENT :candidate candidate))
(result (decide-gate signal)))
(is (eq :decided (getf result :status)))
(let ((approved (getf result :approved-action)))
(is (eq :LOG (getf approved :type)))
(is (search "Action rejected by skill heuristics" (getf (getf approved :payload) :text))))))
(test test-decide-deterministic-override
"Decide should pre-empt LLM for deterministic tasks like missing IDs."
(test test-pipeline-flow-flat
"Verify that process-signal correctly executes a signal through gates."
(setup-mock-skills)
(let* ((ast '(:type :HEADLINE :properties (:TITLE "No ID") :contents nil))
(context `(:type :EVENT :payload (:sensor :user-command :command :organize-subtree :ast ,ast)))
(dummy-proposal '(:type :LOG :payload (:text "I am thinking..."))))
(let ((decision (decide dummy-proposal context)))
(is (eq :REQUEST (getf decision :type)))
(is (eq :refactor-subtree (getf (getf decision :payload) :action)))
(is (not (null (assoc "ID" (getf (getf decision :payload) :properties) :test #'string=)))))))
(clrhash org-agent::*object-store*)
(let ((signal (list :type :EVENT :payload (list :sensor :buffer-update))))
(process-signal signal)
(pass "Pipeline completed execution.")))
(test test-depth-limiting
"Verify that the pipeline terminates runaway feedback loops."
(let ((runaway-signal (list :type :EVENT :depth 11 :payload (list :sensor :heartbeat))))
(is (null (process-signal runaway-signal)))))
(test test-env-loading
"Verify that environment variables are accessible (Phase 2 gating)."
"Verify that environment variables are accessible."
(setf (uiop:getenv "LLM_ENDPOINT") "http://mock")
(setf (uiop:getenv "MEMEX_USER") "Amr")
(is (not (null (uiop:getenv "LLM_ENDPOINT"))))
@@ -70,10 +74,9 @@
(test test-skill-dependencies
"Verify that resolve-skill-dependencies correctly flattens the graph."
(setup-mock-skills)
;; Add a dependent skill
(org-agent::defskill :mock-dependent
:priority 10
:dependencies '("mock-safety")
:dependencies (list "mock-safety")
:trigger (lambda (ctx) nil)
:neuro nil
:symbolic nil)
@@ -90,12 +93,7 @@
(test test-global-awareness-assembly
"Verify that context-assemble-global-awareness reports active projects."
(clrhash org-agent::*object-store*)
;; Ingest a project node
(ingest-ast '(:type :HEADLINE :properties (:ID "proj-1" :TITLE "Project Alpha" :TAGS "project") :contents nil))
;; Ingest a non-project node
(ingest-ast '(:type :HEADLINE :properties (:ID "note-1" :TITLE "Random Note") :contents nil))
(ingest-ast (list :type :HEADLINE :properties (list :ID "proj-1" :TITLE "Project Alpha" :TAGS "project") :contents nil))
(let ((awareness (context-assemble-global-awareness)))
(is (search "Project Alpha" awareness))
(is (search "proj-1" awareness))
(is (not (search "Random Note" awareness)))))
(is (search "proj-1" awareness))))