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

CHORE: Prepare for lisp-repair implementation

Browse Source
This commit is contained in:
Amr Gharbeia
2026-04-11 14:25:28 -04:00
parent 393c86c7cf
commit 7eff65505a
14 changed files with 585 additions and 92 deletions
Download Patch File Download Diff File Expand all files Collapse all files

34
tests/task-orchestrator-tests.lisp Normal file
View File

@@ -0,0 +1,34 @@
(defpackage :org-agent-task-orchestrator-tests
(:use :cl :fiveam :org-agent)
(:export #:task-orchestrator-suite))
(in-package :org-agent-task-orchestrator-tests)
(def-suite task-orchestrator-suite :description "Tests for Consolidation VI: Task Orchestrator.")
(in-suite task-orchestrator-suite)
(test test-consensus-gate-divergence
"Verify that consensus-gate handles diverging proposals by selecting the safest one."
(let* ((proposals '((:type :REQUEST :target :tool :action :call :tool "shell" :args (:cmd "rm -rf /"))
(:type :REQUEST :target :tool :action :call :tool "grep-search" :args (:pattern "sovereignty"))
(:type :REQUEST :target :tool :action :call :tool "grep-search" :args (:pattern "sovereignty"))))
(signal `(:type :EVENT :status :thought :proposals ,proposals))
(result (org-agent:consensus-gate signal)))
;; The judge should reject the 'rm -rf' and select the matching grep-search
(is (equal (getf (getf result :candidate) :tool) "grep-search"))
(is (eq :consensus (getf result :status)))))
(test test-task-integrity-parent-child
"Verify that task-integrity-check rejects closing a parent with active children."
;; Mocking some objects in the store
(clrhash org-agent::*object-store*)
(setf (gethash "parent-1" org-agent::*object-store*)
(org-agent::make-org-object :id "parent-1" :attributes '(:TITLE "Parent Task" :TODO "TODO")))
(setf (gethash "child-1" org-agent::*object-store*)
(org-agent::make-org-object :id "child-1" :attributes '(:TITLE "Child Task" :TODO "TODO" :PARENT "parent-1")))
(let* ((action '(:type :REQUEST :target :emacs :action :update-node :id "parent-1" :attributes (:TODO "DONE")))
(signal `(:type :EVENT :payload (:sensor :test) :candidate ,action))
(result (org-agent:decide-gate signal)))
;; Should be blocked by Task Integrity
(let ((approved (getf result :approved-action)))
(is (equal (getf (getf approved :payload) :text) "Blocked by Task Integrity: Active children exist.")))))