diff --git a/harness/act.org b/harness/act.org index 3541cb1..343e3b2 100644 --- a/harness/act.org +++ b/harness/act.org @@ -385,4 +385,45 @@ Example feedback chain: ;; Step 3: Update signal status (setf (getf signal :status) :acted) feedback)) +#+end_src + +* Test Suite + +These tests verify the Act pipeline. Run with: +~(fiveam:run! 'pipeline-act-suite)~ + +#+begin_src lisp :tangle ../tests/pipeline-act-tests.lisp +(defpackage :opencortex-pipeline-act-tests + (:use :cl :fiveam :opencortex) + (:export #:pipeline-act-suite)) + +(in-package :opencortex-pipeline-act-tests) + +(def-suite pipeline-act-suite + :description "Test suite for Act pipeline") + +(in-suite pipeline-act-suite) + +(test test-act-gate-symbolic-guard-bypass + "Verify that act-gate proceeds normally when no skill intercepts." + (clrhash opencortex::*skills-registry*) + (let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :cli :payload (:text "Hello")))) + (result (opencortex:act-gate signal))) + (is (eq :acted (getf signal :status))) + (is (null result)))) + +(test test-act-gate-symbolic-guard-interception + "Verify that act-gate intercepts actions when a skill returns a LOG/EVENT." + (clrhash opencortex::*skills-registry*) + (opencortex::defskill :mock-bouncer + :priority 200 + :trigger (lambda (ctx) t) + :deterministic (lambda (action ctx) + (list :type :LOG :payload (:text "BLOCKED BY SYMBOLIC GUARD")))) + (let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :shell :payload (:cmd "ls")))) + (result (opencortex:act-gate signal))) + (is (eq :acted (getf signal :status))) + (is (not (null result))) + (is (eq :LOG (getf result :type))) + (is (search "BLOCKED BY SYMBOLIC GUARD" (getf (getf result :payload) :text)))))) #+end_src \ No newline at end of file diff --git a/harness/communication.org b/harness/communication.org index a68ed28..2e9079c 100644 --- a/harness/communication.org +++ b/harness/communication.org @@ -153,3 +153,52 @@ Frames a message with a hex length prefix and ensures all data is serializable. (len (length payload))) (format nil "~6,'0x~a" len payload))) #+end_src + +* Test Suite + +These tests verify the communication protocol functions. Run with: +~(fiveam:run! 'communication-protocol-suite)~ + +#+begin_src lisp :tangle ../library/communication-tests.lisp +(defpackage :opencortex-communication-tests + (:use :cl :fiveam :opencortex) + (:export #:communication-protocol-suite)) + +(in-package :opencortex-communication-tests) + +(def-suite communication-protocol-suite + :description "Test suite for opencortex Communication Protocol") + +(in-suite communication-protocol-suite) + +(test test-framing + "Verify that messages are correctly prefixed with a 6-character hex length." + (let* ((msg '(:type :EVENT :payload (:action :handshake))) + (framed (frame-message msg)) + (len-str (subseq framed 0 6)) + (payload (subseq framed 6))) + (is (string= "00002C" (string-upcase len-str))) + (is (equalp msg (read-from-string payload))))) + +(test test-parse-message + "Verify that incoming framed strings are parsed into Lisp plists." + (let ((framed "00002c(:type :EVENT :payload (:action :handshake))")) + (is (equal '(:type :EVENT :payload (:action :handshake)) + (read-from-string (subseq framed 6)))))) + +(test test-hello-handshake + "Verify the structure of the HELLO handshake message." + (let ((hello (make-hello-message "0.1.0"))) + (is (eq :EVENT (getf hello :type))) + (is (eq :handshake (getf (getf hello :payload) :action))) + (is (string= "0.1.0" (getf (getf hello :payload) :version))))) + +(test test-find-missing-id + "Verify that the daemon can find a headline missing an ID." + (let* ((ast '(:type :org-data :contents + ((:type :HEADLINE :properties (:TITLE "No ID Here") :contents nil) + (:type :HEADLINE :properties (:ID "exists" :TITLE "Has ID") :contents nil)))) + (found (find-headline-missing-id ast))) + (is (not (null found))) + (is (string= "No ID Here" (getf (getf found :properties) :TITLE))))) +#+end_src diff --git a/harness/loop.org b/harness/loop.org index 3d68609..f4cdc48 100644 --- a/harness/loop.org +++ b/harness/loop.org @@ -284,4 +284,35 @@ The main function orchestrates system startup: ;; Sleep in configured intervals (default: 1 hour) (sleep sleep-interval)))) +#+end_src + +* Test Suite + +These tests verify the metabolic loop and error recovery. Run with: +~(fiveam:run! 'immune-suite)~ + +#+begin_src lisp :tangle ../tests/immune-system-tests.lisp +(defpackage :opencortex-immune-system-tests + (:use :cl :fiveam :opencortex) + (:export #:immune-suite)) + +(in-package :opencortex-immune-system-tests) + +(def-suite immune-suite + :description "Verification of the Immune System (Core Error Hooks)") + +(in-suite immune-suite) + +(test loop-error-injection + "Verify that a crash in think/decide triggers a :loop-error stimulus." + (clrhash opencortex::*skills-registry*) + (opencortex:defskill :evil-skill + :priority 100 + :trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :user-input)) + :probabilistic (lambda (ctx) (error "CRITICAL BRAIN FAILURE")) + :deterministic nil) + (opencortex:harness-log "CLEAN LOG") + (opencortex:process-signal '(:type :EVENT :payload (:sensor :user-input))) + (let ((logs (opencortex:context-get-system-logs 20))) + (is (not (null (find-if (lambda (line) (search "CRITICAL BRAIN FAILURE" line)) logs)))))) #+end_src \ No newline at end of file diff --git a/harness/memory.org b/harness/memory.org index df3edd3..3ea89b3 100644 --- a/harness/memory.org +++ b/harness/memory.org @@ -148,6 +148,66 @@ Restores the state of the Memex from one of the previous snapshots. (harness-log "MEMORY ERROR - Snapshot ~a not found." index)))) #+end_src +* Test Suite + +These tests verify the Memory system. Run with: +~(fiveam:run! 'memory-suite)~ + +#+begin_src lisp :tangle ../tests/memory-tests.lisp +(defpackage :opencortex-memory-tests + (:use :cl :fiveam :opencortex) + (:export #:memory-suite)) + +(in-package :opencortex-memory-tests) + +(def-suite memory-suite + :description "Tests for the Merkle-Tree Memory") + +(in-suite memory-suite) + +(test merkle-hash-consistency + "Verify identical ASTs produce identical Merkle hashes." + (let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil))) + (clrhash *memory*) + (let ((id1 (ingest-ast ast1))) + (let ((hash1 (org-object-hash (lookup-object id1)))) + (clrhash *memory*) + (let ((id2 (ingest-ast ast1))) + (let ((hash2 (org-object-hash (lookup-object id2)))) + (is (equal hash1 hash2)))))))) + +(test history-store-immutability + "Verify that *history-store* retains old versions." + (clrhash *memory*) + (clrhash *history-store*) + (let* ((ast-v1 '(:type :HEADLINE :properties (:ID "test-node" :TITLE "Version 1") :contents nil)) + (id-v1 (ingest-ast ast-v1)) + (obj-v1 (lookup-object id-v1)) + (hash-v1 (org-object-hash obj-v1))) + (let* ((ast-v2 '(:type :HEADLINE :properties (:ID "test-node" :TITLE "Version 2") :contents nil)) + (id-v2 (ingest-ast ast-v2)) + (hash-v2 (org-object-hash (lookup-object id-v2)))) + (is (equal (org-object-hash (lookup-object "test-node")) hash-v2)) + (is (not (null (gethash hash-v1 *history-store*))) + (is (not (null (gethash hash-v2 *history-store*)))))) + +(test cow-snapshot-and-rollback + "Verify that lightweight snapshots restore previous pointer states." + (clrhash *memory*) + (setf *object-store-snapshots* nil) + (let* ((ast-v1 '(:type :HEADLINE :properties (:ID "cow-node" :TITLE "State A") :contents nil)) + (id-v1 (ingest-ast ast-v1)) + (hash-v1 (org-object-hash (lookup-object id-v1)))) + (snapshot-memory) + (let* ((ast-v2 '(:type :HEADLINE :properties (:ID "cow-node" :TITLE "State B") :contents nil)) + (id-v2 (ingest-ast ast-v2)) + (hash-v2 (org-object-hash (lookup-object id-v2)))) + (is (equal (org-object-hash (lookup-object "cow-node")) hash-v2)) + (rollback-memory 0) + (is (equal (org-object-hash (lookup-object "cow-node")) hash-v1)) + (is (not (null (gethash hash-v2 *history-store*)))))) +#+end_src + ** Disk Persistence (save-memory / load-memory) Essential for surviving crashes. Saves the in-memory hash tables to disk and loads them back on restart. The path is controlled by the `MEMORY_SNAPSHOT_PATH` environment variable. @@ -402,6 +462,30 @@ Following the Engineering Standards, the Memory must be empirically verified thr ;; Verify we are back in State A (is (equal (org-object-hash (lookup-object "cow-node")) hash-v1)) - ;; Verify State B is still safely in the history store (no data loss) - (is (not (null (gethash hash-v2 *history-store*))))))) +;; Verify State B is still safely in the history store (no data loss) + (is (not (null (gethash hash-v2 *history-store*)))))) + +(test merkle-hash-consistency + "Verify that identical ASTs produce identical Merkle hashes." + (let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil))) + (clrhash *memory*) + (let ((id1 (ingest-ast ast1))) + (let ((hash1 (org-object-hash (lookup-object id1)))) + (clrhash *memory*) + (let ((id2 (ingest-ast ast1))) + (let ((hash2 (org-object-hash (lookup-object id2)))) + (is (equal hash1 hash2)))))))) + +(test merkle-hash-cascading + "Verify that child changes propagate to parent hashes." + (let* ((ast-root '(:type :HEADLINE :properties (:ID "root" :TITLE "Root") + :contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf") :contents nil)))) + (id-root (progn (clrhash *memory*) (ingest-ast ast-root))) + (root-hash (org-object-hash (lookup-object id-root)))) + ;; Now ingest a modified child - parent hash should change + (let* ((ast-mod '(:type :HEADLINE :properties (:ID "root" :TITLE "Root") + :contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Changed") :contents nil)))) + (id-mod (progn (clrhash *memory*) (ingest-ast ast-mod))) + (mod-hash (org-object-hash (lookup-object id-mod)))) + (is (not (equal root-hash mod-hash)))))) #+end_src diff --git a/harness/perceive.org b/harness/perceive.org index 16fe77f..f124335 100644 --- a/harness/perceive.org +++ b/harness/perceive.org @@ -219,4 +219,35 @@ Other sensors (heartbeats, interrupts) are processed synchronously to maintain o | :point-update | Emacs | Sync | Cursor moved to different headline | | :interrupt | System | Sync | SIGINT received | | :tool-output | Internal | Sync | Result from cognitive tool | -| :loop-error | Internal | Sync | Error during signal processing | \ No newline at end of file +| :loop-error | Internal | Sync | Error during signal processing | + +* Test Suite + +These tests verify the Perceive pipeline. Run with: +~(fiveam:run! 'pipeline-perceive-suite)~ + +#+begin_src lisp :tangle ../tests/pipeline-perceive-tests.lisp +(defpackage :opencortex-pipeline-perceive-tests + (:use :cl :fiveam :opencortex) + (:export #:pipeline-perceive-suite)) + +(in-package :opencortex-pipeline-perceive-tests) + +(def-suite pipeline-perceive-suite + :description "Test suite for Perceive pipeline") + +(in-suite pipeline-perceive-suite) + +(test test-perceive-gate + "Perceive gate should update the object store and normalize signal." + (clrhash opencortex::*memory*) + (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" opencortex::*memory*)))))) + +(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))))) +#+end_src \ No newline at end of file diff --git a/harness/reason.org b/harness/reason.org index 9464ac0..89b5f27 100644 --- a/harness/reason.org +++ b/harness/reason.org @@ -441,4 +441,38 @@ The deterministic engine runs all registered skills' verification functions. Thi (setf (getf signal :status) :reasoned) signal))) +#+end_src + +* Test Suite + +These tests verify the Reason (cognitive) pipeline. Run with: +~(fiveam:run! 'pipeline-reason-suite)~ + +#+begin_src lisp :tangle ../tests/pipeline-reason-tests.lisp +(defpackage :opencortex-pipeline-reason-tests + (:use :cl :fiveam :opencortex) + (:export #:pipeline-reason-suite)) + +(in-package :opencortex-pipeline-reason-tests) + +(def-suite pipeline-reason-suite + :description "Test suite for Reason pipeline") + +(in-suite pipeline-reason-suite) + +(test test-decide-gate-safety + "Decide gate should block unsafe LLM proposals." + ;; Setup: clear skills and register mock + (clrhash opencortex::*skills-registry*) + (opencortex::defskill :mock-safety + :priority 50 + :trigger (lambda (ctx) t) + :probabilistic (lambda (ctx) "Mock probabilistic") + :deterministic (lambda (action ctx) + (list :type :LOG :payload (list :text "Action rejected by skill heuristics")))) + (let* ((candidate (list :type :REQUEST :payload (list :action :eval :code "(shell-command \"rm -rf /\")"))) + (signal (list :type :EVENT :candidate candidate)) + (result (deterministic-verify candidate signal))) + (is (eq :LOG (getf result :type))) + (is (search "Action rejected by skill heuristics" (getf (getf result :payload) :text))))) #+end_src \ No newline at end of file diff --git a/harness/skills.org b/harness/skills.org index 85658ef..416f11f 100644 --- a/harness/skills.org +++ b/harness/skills.org @@ -478,3 +478,58 @@ EXAMPLES: (error (c) (format nil "ERROR replacing in ~a: ~a" file c))))) #+end_src + +* Test Suite + +These tests verify the Skill Engine and loader. Run with: +~(fiveam:run! 'boot-suite)~ + +#+begin_src lisp :tangle ../tests/boot-sequence-tests.lisp +(defpackage :opencortex-boot-tests + (:use :cl :fiveam :opencortex) + (:export #:boot-suite)) + +(in-package :opencortex-boot-tests) + +(def-suite boot-suite :description "Verification of the Skill Engine loader") + +(in-suite boot-suite) + +(test test-parse-skill-metadata + "Verify extraction of ID and DEPENDS_ON from Org headers." + (let ((tmp-file "/tmp/org-skill-test-metadata.org")) + (with-open-file (out tmp-file :direction :output :if-exists :supersede) + (format out ":PROPERTIES:~%:ID: test-id~%:END:~%#+DEPENDS_ON: dep1 dep2~%")) + (unwind-protect + (multiple-value-bind (id deps) (opencortex::parse-skill-metadata tmp-file) + (is (equal "test-id" id)) + (is (member "dep1" deps :test #'string=)) + (is (member "dep2" deps :test #'string=))) + (uiop:delete-file-if-exists tmp-file)))) + +(test test-topological-sort-basic + "Verify that skills are ordered by dependency." + (let ((tmp-dir "/tmp/opencortex-boot-test/")) + (uiop:ensure-all-directories-exist (list tmp-dir)) + (with-open-file (out (merge-pathnames "org-skill-a.org" tmp-dir) :direction :output :if-exists :supersede) + (format out "#+DEPENDS_ON: skill-b-id~%")) + (with-open-file (out (merge-pathnames "org-skill-b.org" tmp-dir) :direction :output :if-exists :supersede) + (format out ":PROPERTIES:~%:ID: skill-b-id~%:END:~%")) + (unwind-protect + (let ((sorted (opencortex::topological-sort-skills tmp-dir))) + (let ((pos-a (position "org-skill-a" sorted :key #'pathname-name :test #'string-equal)) + (pos-b (position "org-skill-b" sorted :key #'pathname-name :test #'string-equal))) + (is (< pos-b pos-a))) + (uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t)))) + +(test test-skill-jailing + "Verify that skills are loaded into their own packages." + (let ((tmp-skill "/tmp/org-skill-jail-test.org")) + (with-open-file (out tmp-skill :direction :output :if-exists :supersede) + (format out ":PROPERTIES:~%:ID: jail-test-id~%:END:~%#+TITLE: Jail Test Skill~%#+begin_src lisp :tangle no~(defun jail-test-fn () t)~#+end_src")) + (unwind-protect + (progn + (opencortex::load-skill-from-org tmp-skill) + (is (not (null (gethash "org-skill-jail-test" opencortex::*skills-registry*))))) + (uiop:delete-file-if-exists tmp-skill)))) +#+end_src diff --git a/run-all-tests.lisp b/run-all-tests.lisp index da2df6c..c344e24 100644 --- a/run-all-tests.lisp +++ b/run-all-tests.lisp @@ -1,21 +1,26 @@ (load "/home/user/quicklisp/setup.lisp") (push #p"./" asdf:*central-registry*) (ql:quickload :fiveam :verbose nil) +(asdf:load-system :opencortex :verbose nil) (asdf:load-system :opencortex/tests :verbose nil) -;; Load tool permissions skill -(load "library/gen/org-skill-tool-permissions.lisp") -(load "tests/tool-permissions-tests.lisp") - (format t "~%=== Running ALL Test Suites ===~%") -(fiveam:run! 'opencortex-tests::communication-protocol-suite) -(fiveam:run! 'opencortex-pipeline-tests::pipeline-suite) -(fiveam:run! 'opencortex-boot-tests::boot-suite) -(fiveam:run! 'opencortex-memory-tests::memory-suite) -(fiveam:run! 'opencortex-immune-system-tests::immune-suite) -(fiveam:run! 'opencortex-emacs-edit-tests::emacs-edit-suite) -(fiveam:run! 'opencortex-lisp-utils-tests::lisp-utils-suite) -(fiveam:run! 'opencortex-tool-permissions-tests::tool-permissions-suite) +(when (find-package :OPENCORTEX-TESTS) + (fiveam:run! 'OPENCORTEX-TESTS::COMMUNICATION-PROTOCOL-SUITE)) +(when (find-package :OPENCORTEX-PIPELINE-TESTS) + (fiveam:run! 'OPENCORTEX-PIPELINE-TESTS::PIPELINE-SUITE)) +(when (find-package :OPENCORTEX-BOOT-TESTS) + (fiveam:run! 'OPENCORTEX-BOOT-TESTS::BOOT-SUITE)) +(when (find-package :OPENCORTEX-MEMORY-TESTS) + (fiveam:run! 'OPENCORTEX-MEMORY-TESTS::MEMORY-SUITE)) +(when (find-package :OPENCORTEX-IMMUNE-SYSTEM-TESTS) + (fiveam:run! 'OPENCORTEX-IMMUNE-SYSTEM-TESTS::IMMUNE-SUITE)) +(when (find-package :OPENCORTEX-EMACS-EDIT-TESTS) + (fiveam:run! 'OPENCORTEX-EMACS-EDIT-TESTS::EMACS-EDIT-SUITE)) +(when (find-package :OPENCORTEX-LISP-UTILS-TESTS) + (fiveam:run! 'OPENCORTEX-LISP-UTILS-TESTS::LISP-UTILS-SUITE)) +(when (find-package :OPENCORTEX-TOOL-PERMISSIONS-TESTS) + (fiveam:run! 'OPENCORTEX-TOOL-PERMISSIONS-TESTS::TOOL-PERMISSIONS-SUITE)) (format t "~%=== ALL TESTS COMPLETE ===~%") \ No newline at end of file