chore: Delete redundant test files - now inline in Org files
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 3s
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 3s
Deleted duplicates: - library/communication-tests.lisp - tests/pipeline-*-tests.lisp (moved to inline in perceive/reason/act.org) - tests/boot-sequence-tests.lisp (inline in skills.org) - tests/memory-tests.lisp (inline in memory.org) - tests/immune-system-tests.lisp (inline in loop.org) - tests/communication-tests.lisp (inline in communication.org) - tests/pipeline-tests.lisp (split into perceive/reason/act)
This commit is contained in:
@@ -1,74 +0,0 @@
|
|||||||
(defpackage :opencortex-boot-tests
|
|
||||||
(:use :cl :fiveam :opencortex)
|
|
||||||
(:export #:boot-suite))
|
|
||||||
(in-package :opencortex-boot-tests)
|
|
||||||
|
|
||||||
(def-suite boot-suite :description "Verification of the Micro-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))
|
|
||||||
;; A depends on B
|
|
||||||
(with-open-file (out (merge-pathnames "org-skill-a.org" tmp-dir) :direction :output :if-exists :supersede)
|
|
||||||
(format out "#+DEPENDS_ON: id: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:~%"))
|
|
||||||
;; Add executive soul (required)
|
|
||||||
(with-open-file (out (merge-pathnames "org-skill-agent.org" tmp-dir) :direction :output :if-exists :supersede)
|
|
||||||
(format out "#+TITLE: Agent~%"))
|
|
||||||
|
|
||||||
(unwind-protect
|
|
||||||
(let ((sorted (opencortex::topological-sort-skills tmp-dir)))
|
|
||||||
;; B must appear before A
|
|
||||||
(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 (not (null pos-a)))
|
|
||||||
(is (not (null pos-b)))
|
|
||||||
(is (< pos-b pos-a))))
|
|
||||||
(uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))
|
|
||||||
|
|
||||||
(test test-topological-sort-circular
|
|
||||||
"Verify that circular dependencies raise an error."
|
|
||||||
(let ((tmp-dir "/tmp/opencortex-boot-test-circ/"))
|
|
||||||
(uiop:ensure-all-directories-exist (list tmp-dir))
|
|
||||||
;; A depends on B, B depends on A
|
|
||||||
(with-open-file (out (merge-pathnames "org-skill-a.org" tmp-dir) :direction :output :if-exists :supersede)
|
|
||||||
(format out "#+DEPENDS_ON: org-skill-b~%"))
|
|
||||||
(with-open-file (out (merge-pathnames "org-skill-b.org" tmp-dir) :direction :output :if-exists :supersede)
|
|
||||||
(format out "#+DEPENDS_ON: org-skill-a~%"))
|
|
||||||
|
|
||||||
(unwind-protect
|
|
||||||
(signals error (opencortex::topological-sort-skills tmp-dir))
|
|
||||||
(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 "#+begin_src lisp :tangle lib.lisp~%(defvar *jailed-var* 42)~%#+end_src"))
|
|
||||||
(unwind-protect
|
|
||||||
(progn
|
|
||||||
(opencortex::load-skill-from-org tmp-skill)
|
|
||||||
(let ((pkg (find-package :OPENCORTEX.SKILLS.ORG-SKILL-JAIL-TEST)))
|
|
||||||
(is (not (null pkg)))
|
|
||||||
(is (= 42 (symbol-value (find-symbol "*JAILED-VAR*" pkg))))))
|
|
||||||
(uiop:delete-file-if-exists tmp-skill))))
|
|
||||||
|
|
||||||
(test test-syntax-validation
|
|
||||||
"Verify that malformed Lisp is caught by the pre-flight check."
|
|
||||||
(is (nth-value 0 (opencortex::validate-lisp-syntax "(defun x () t)")))
|
|
||||||
(is (not (nth-value 0 (opencortex::validate-lisp-syntax "(defun x (")))))
|
|
||||||
@@ -1,38 +0,0 @@
|
|||||||
(defpackage :opencortex-tests
|
|
||||||
(:use :cl :fiveam :opencortex))
|
|
||||||
(in-package :opencortex-tests)
|
|
||||||
|
|
||||||
(def-suite communication-protocol-suite
|
|
||||||
:description "Test suite for opencortex Communication Protocol (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 (opencortex: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))
|
|
||||||
(opencortex:parse-message framed)))))
|
|
||||||
|
|
||||||
(test test-hello-handshake
|
|
||||||
"Verify the structure of the HELLO handshake message."
|
|
||||||
(let ((hello (opencortex: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 (opencortex::find-headline-missing-id ast)))
|
|
||||||
(is (not (null found)))
|
|
||||||
(is (string= "No ID Here" (getf (getf found :properties) :TITLE)))))
|
|
||||||
@@ -1,25 +0,0 @@
|
|||||||
(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))))
|
|
||||||
(is (not (null (find-if (lambda (line) (search "EVENT (LOOP-ERROR)" line)) logs))))))
|
|
||||||
@@ -1,91 +0,0 @@
|
|||||||
(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
|
|
||||||
(let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil))
|
|
||||||
(ast2 '(: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 ast2)))
|
|
||||||
(let ((hash2 (org-object-hash (lookup-object id2))))
|
|
||||||
(is (equal hash1 hash2))))))))
|
|
||||||
|
|
||||||
(test merkle-hash-cascading
|
|
||||||
(let* ((ast-leaf '(:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf") :contents nil))
|
|
||||||
(ast-root-full '(: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-full)))
|
|
||||||
(initial-root-hash (org-object-hash (lookup-object id-root))))
|
|
||||||
|
|
||||||
;; Now ingest a modified version (title change)
|
|
||||||
(let* ((ast-root-modified '(:type :HEADLINE :properties (:ID "root" :TITLE "Root")
|
|
||||||
:contents ((:type :HEADLINE :properties (:ID "leaf" :TITLE "Leaf Modified") :contents nil))))
|
|
||||||
(id-root-mod (progn (clrhash *memory*) (ingest-ast ast-root-modified)))
|
|
||||||
(modified-root-hash (org-object-hash (lookup-object id-root-mod))))
|
|
||||||
(is (not (equal initial-root-hash modified-root-hash))))))
|
|
||||||
|
|
||||||
(test history-store-immutability
|
|
||||||
"Verify that *history-store* retains old versions even after *memory* updates."
|
|
||||||
(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))
|
|
||||||
(obj-v2 (lookup-object id-v2))
|
|
||||||
(hash-v2 (org-object-hash obj-v2)))
|
|
||||||
|
|
||||||
;; The active pointer should be v2
|
|
||||||
(is (equal (org-object-hash (lookup-object "test-node")) hash-v2))
|
|
||||||
|
|
||||||
;; Both v1 and v2 should exist in the immutable history store
|
|
||||||
(is (not (null (gethash hash-v1 *history-store*))))
|
|
||||||
(is (not (null (gethash hash-v2 *history-store*))))
|
|
||||||
|
|
||||||
;; Modifying v2 should not affect v1 in the history store
|
|
||||||
(is (equal (org-object-content (gethash hash-v1 *history-store*)) "Version 1
|
|
||||||
"))
|
|
||||||
(is (equal (org-object-content (gethash hash-v2 *history-store*)) "Version 2
|
|
||||||
")))))
|
|
||||||
|
|
||||||
(test cow-snapshot-and-rollback
|
|
||||||
"Verify that lightweight snapshots can accurately restore previous pointer states."
|
|
||||||
(clrhash *memory*)
|
|
||||||
(clrhash *history-store*)
|
|
||||||
(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))))
|
|
||||||
|
|
||||||
;; Take a snapshot at State A
|
|
||||||
(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))))
|
|
||||||
|
|
||||||
;; Verify we are currently in State B
|
|
||||||
(is (equal (org-object-hash (lookup-object "cow-node")) hash-v2))
|
|
||||||
|
|
||||||
;; Rollback to State A (index 0 because we only took 1 snapshot)
|
|
||||||
(rollback-memory 0)
|
|
||||||
|
|
||||||
;; 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*)))))))
|
|
||||||
@@ -1,118 +0,0 @@
|
|||||||
(defpackage :opencortex-pipeline-tests
|
|
||||||
(:use :cl :fiveam :opencortex))
|
|
||||||
(in-package :opencortex-pipeline-tests)
|
|
||||||
|
|
||||||
(def-suite pipeline-suite
|
|
||||||
:description "Verification of the Reactive Signal Pipeline.")
|
|
||||||
(in-suite pipeline-suite)
|
|
||||||
|
|
||||||
(defun setup-mock-skills ()
|
|
||||||
"Register mock skills for testing."
|
|
||||||
(clrhash opencortex::*skills-registry*)
|
|
||||||
(opencortex::defskill :mock-refactor
|
|
||||||
:priority 100
|
|
||||||
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :command) :organize-subtree))
|
|
||||||
:probabilistic (lambda (ctx) "Mock probabilistic prompt")
|
|
||||||
:deterministic (lambda (action ctx)
|
|
||||||
`(:type :REQUEST :id 123
|
|
||||||
:payload (:action :refactor-subtree
|
|
||||||
:target-id nil
|
|
||||||
:properties (("ID" . "node-123"))))))
|
|
||||||
(opencortex::defskill :mock-safety
|
|
||||||
:priority 50
|
|
||||||
:trigger (lambda (ctx) t) ; always triggers
|
|
||||||
:probabilistic (lambda (ctx) "Mock probabilistic")
|
|
||||||
:deterministic (lambda (action ctx)
|
|
||||||
(declare (ignore action ctx))
|
|
||||||
(list :type :LOG :payload (list :text "Action rejected by skill heuristics"))))) ; rejects everything
|
|
||||||
|
|
||||||
(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-decide-gate-safety
|
|
||||||
"Decide gate should block unsafe LLM proposals."
|
|
||||||
(setup-mock-skills)
|
|
||||||
(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)))
|
|
||||||
|
|
||||||
(let ((approved result))
|
|
||||||
(is (eq :LOG (getf approved :type)))
|
|
||||||
(is (search "Action rejected by skill heuristics" (getf (getf approved :payload) :text))))))
|
|
||||||
|
|
||||||
(test test-pipeline-flow-flat
|
|
||||||
"Verify that process-signal correctly executes a signal through gates."
|
|
||||||
(setup-mock-skills)
|
|
||||||
(clrhash opencortex::*memory*)
|
|
||||||
(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."
|
|
||||||
(sb-posix:putenv "LLM_ENDPOINT=http://mock")
|
|
||||||
(sb-posix:putenv "MEMEX_USER=Amr")
|
|
||||||
(is (not (null (uiop:getenv "LLM_ENDPOINT"))))
|
|
||||||
(is (stringp (uiop:getenv "MEMEX_USER"))))
|
|
||||||
|
|
||||||
(test test-path-resolution
|
|
||||||
"Verify that context-resolve-path expands environment variables."
|
|
||||||
(sb-posix:putenv "MEMEX_USER=Amr")
|
|
||||||
(let ((path "$MEMEX_USER/test"))
|
|
||||||
(is (search "Amr/test" (context-resolve-path path)))))
|
|
||||||
|
|
||||||
(test test-skill-dependencies
|
|
||||||
"Verify that resolve-skill-dependencies correctly flattens the graph."
|
|
||||||
(setup-mock-skills)
|
|
||||||
(opencortex::defskill :mock-dependent
|
|
||||||
:priority 10
|
|
||||||
:dependencies (list "mock-safety")
|
|
||||||
:trigger (lambda (ctx) nil)
|
|
||||||
:probabilistic nil
|
|
||||||
:deterministic nil)
|
|
||||||
(let ((deps (opencortex::resolve-skill-dependencies "mock-dependent")))
|
|
||||||
(is (member "mock-safety" deps :test #'string-equal))
|
|
||||||
(is (member "mock-dependent" deps :test #'string-equal))))
|
|
||||||
|
|
||||||
(test test-log-buffering
|
|
||||||
"Verify that harness-log correctly populates the system logs."
|
|
||||||
(harness-log "Engineering TEST LOG")
|
|
||||||
(let ((logs (context-get-system-logs 5)))
|
|
||||||
(is (cl:some (lambda (line) (search "Engineering TEST LOG" line)) logs))))
|
|
||||||
|
|
||||||
(test test-global-awareness-assembly
|
|
||||||
"Verify that context-assemble-global-awareness reports active projects."
|
|
||||||
(clrhash opencortex::*memory*)
|
|
||||||
(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))))
|
|
||||||
|
|
||||||
(test test-micro-rollback
|
|
||||||
"Verify that a pipeline crash triggers an automatic Memory rollback."
|
|
||||||
(clrhash opencortex::*memory*)
|
|
||||||
(clrhash opencortex::*history-store*)
|
|
||||||
(setf opencortex::*object-store-snapshots* nil)
|
|
||||||
;; State A
|
|
||||||
(ingest-ast (list :type :HEADLINE :properties (list :ID "node-1" :TITLE "State A") :contents nil))
|
|
||||||
(setup-mock-skills)
|
|
||||||
(opencortex::defskill :crashing-skill
|
|
||||||
:priority 200
|
|
||||||
:trigger (lambda (ctx) t)
|
|
||||||
:probabilistic (lambda (ctx) (list :type :REQUEST :payload (list :action :eval :code "(error \"BOOM\")")))
|
|
||||||
:deterministic (lambda (action ctx) (error "CRASH IN DETERMINISTIC ENGINE")))
|
|
||||||
(process-signal (list :type :EVENT :payload (list :sensor :test)))
|
|
||||||
;; Verify that we are still in State A
|
|
||||||
(let ((obj (lookup-object "node-1")))
|
|
||||||
(is (not (null obj)))
|
|
||||||
(is (equal (getf (org-object-attributes obj) :TITLE) "State A"))))
|
|
||||||
Reference in New Issue
Block a user