build: embed test scripts into org files and purge tests directory
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
- Embedded run-all-tests.lisp into harness/package.org. - Deleted the tests/ directory and orphaned Python test scripts, as all other test files are correctly tangled from their parent org files.
This commit is contained in:
@@ -1,47 +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 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))))
|
||||
@@ -1,34 +0,0 @@
|
||||
(defpackage :opencortex-emacs-edit-tests
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:emacs-edit-suite))
|
||||
|
||||
(in-package :opencortex-emacs-edit-tests)
|
||||
|
||||
(def-suite emacs-edit-suite
|
||||
:description "Tests for Emacs Edit skill.")
|
||||
|
||||
(in-suite emacs-edit-suite)
|
||||
|
||||
(test id-generation
|
||||
(let ((id1 (emacs-edit-generate-id))
|
||||
(id2 (emacs-edit-generate-id)))
|
||||
(is (plusp (length id1)))
|
||||
(is (not (string= id1 id2))))) ;; Likely unique
|
||||
|
||||
(test id-format
|
||||
(let ((formatted (emacs-edit-id-format "abc12345")))
|
||||
(is (search "id:" formatted))))
|
||||
|
||||
(test property-setter
|
||||
(let ((ast (list :type :headline
|
||||
:properties (list :ID "id:test123" :TITLE "Test")
|
||||
:contents nil)))
|
||||
(emacs-edit-set-property ast "id:test123" :STATUS "ACTIVE")
|
||||
(is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
|
||||
|
||||
(test todo-setter
|
||||
(let ((ast (list :type :headline
|
||||
:properties (list :ID "id:todo001" :TITLE "Task")
|
||||
:contents nil)))
|
||||
(emacs-edit-set-todo ast "id:todo001" "DONE")
|
||||
(is (string= (getf (getf ast :properties) :TODO) "DONE"))))
|
||||
@@ -1,62 +0,0 @@
|
||||
(defpackage :opencortex-engineering-standards-tests
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:engineering-standards-suite))
|
||||
|
||||
(in-package :opencortex-engineering-standards-tests)
|
||||
|
||||
(def-suite engineering-standards-suite
|
||||
:description "Tests for Engineering Standards enforcement")
|
||||
|
||||
(in-suite engineering-standards-suite)
|
||||
|
||||
(test git-clean-check-clean
|
||||
"verify-git-clean-p returns T when git tree is clean."
|
||||
(let ((tmp-dir "/tmp/eng-std-test-clean/"))
|
||||
(uiop:ensure-all-directories-exist (list tmp-dir))
|
||||
(uiop:run-program (list "git" "init" tmp-dir) :output nil)
|
||||
(is (eq t (opencortex::verify-git-clean-p (uiop:ensure-directory-pathname tmp-dir))))
|
||||
(uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t)))
|
||||
|
||||
(test git-clean-check-dirty
|
||||
"verify-git-clean-p returns NIL when git tree has uncommitted changes."
|
||||
(let ((tmp-dir "/tmp/eng-std-test-dirty/"))
|
||||
(uiop:ensure-all-directories-exist (list tmp-dir))
|
||||
(uiop:run-program (list "git" "init" tmp-dir) :output nil)
|
||||
(with-open-file (f (merge-pathnames "test.txt" tmp-dir) :direction :output)
|
||||
(write-line "test" f))
|
||||
(is (null (opencortex::verify-git-clean-p (uiop:ensure-directory-pathname tmp-dir))))
|
||||
(uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t)))
|
||||
|
||||
(test violation-struct
|
||||
"engineering-violation struct is properly constructed."
|
||||
(let ((v (opencortex::make-engineering-violation
|
||||
:phase :pre-task
|
||||
:rule :git-clean
|
||||
:message "Test violation"
|
||||
:severity :blocker)))
|
||||
(is (eq :pre-task (opencortex::engineering-violation-phase v)))
|
||||
(is (eq :git-clean (opencortex::engineering-violation-rule v)))
|
||||
(is (string= "Test violation" (opencortex::engineering-violation-message v)))
|
||||
(is (eq :blocker (opencortex::engineering-violation-severity v)))))
|
||||
|
||||
(test gate-blocks-dirty-tree
|
||||
"engineering-standards-gate blocks when git is dirty."
|
||||
(let ((action (list :type :request
|
||||
:payload (list :tool :write-file
|
||||
:file "/tmp/test"
|
||||
:content "test"))))
|
||||
;; Note: This test assumes git is clean in test environment
|
||||
;; The gate returns :log if dirty
|
||||
(let ((result (opencortex::engineering-standards-gate action nil)))
|
||||
(is (listp result))
|
||||
(when (eq (getf result :type) :log)
|
||||
(is (search "dirty" (getf (getf result :payload) :text) :test #'char-equal))))))
|
||||
|
||||
(test gate-allows-clean-tree
|
||||
"engineering-standards-gate passes when git is clean."
|
||||
(let ((action (list :type :request
|
||||
:payload (list :tool :read-file
|
||||
:file "/tmp/test"))))
|
||||
(let ((result (opencortex::engineering-standards-gate action nil)))
|
||||
(is (listp result))
|
||||
(is (eq :request (getf result :type))))))
|
||||
@@ -1,23 +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))))))
|
||||
@@ -1,96 +0,0 @@
|
||||
(defpackage :opencortex-lisp-utils-tests
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:lisp-utils-suite))
|
||||
|
||||
(in-package :opencortex-lisp-utils-tests)
|
||||
|
||||
(def-suite lisp-utils-suite
|
||||
:description "Tests for the Lisp Utils skill.")
|
||||
|
||||
(in-suite lisp-utils-suite)
|
||||
|
||||
;; Character utilities
|
||||
;; Character utilities
|
||||
(test count-char-balanced
|
||||
(is (= (opencortex::count-char #\( "(+ 1 2)") 1))
|
||||
(is (= (opencortex::count-char #\) "(+ 1 2)") 1)))
|
||||
|
||||
(test count-char-unbalanced
|
||||
(is (= (opencortex::count-char #\( "(+ 1 2") 1))
|
||||
(is (= (opencortex::count-char #\) "(+ 1 2") 0)))
|
||||
|
||||
(test count-char-empty
|
||||
(is (= (opencortex::count-char #\( "") 0)))
|
||||
|
||||
;; Deterministic repair
|
||||
(test deterministic-repair-balanced
|
||||
(is (string= (opencortex::deterministic-repair "(+ 1 2)") "(+ 1 2)")))
|
||||
|
||||
(test deterministic-repair-unbalanced-open
|
||||
(is (string= (opencortex::deterministic-repair "(+ 1 2") "(+ 1 2)")))
|
||||
|
||||
(test deterministic-repair-unbalanced-close
|
||||
(is (string= (opencortex::deterministic-repair "(+ 1 2))") "(+ 1 2))")))
|
||||
|
||||
(test deterministic-repair-empty
|
||||
(is (string= (opencortex::deterministic-repair "") "")))
|
||||
|
||||
;; Structural check
|
||||
(test structural-valid
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-structural "(+ 1 2)")
|
||||
(is (eq ok t))))
|
||||
|
||||
(test structural-unbalanced
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-structural "(+ 1 2")
|
||||
(is (not ok))
|
||||
(is (search "Unbalanced" reason))))
|
||||
|
||||
(test structural-mismatched
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-structural "[)")
|
||||
(is (not ok))
|
||||
(is (search "Mismatched" reason))))
|
||||
|
||||
;; Syntactic check
|
||||
(test syntactic-valid
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-syntactic "(+ 1 2)")
|
||||
(is (eq ok t))))
|
||||
|
||||
(test syntactic-invalid
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-syntactic "(1+ 2 #\")")
|
||||
(is (not ok))))
|
||||
|
||||
;; Semantic check
|
||||
(test semantic-whitelist-safe
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-semantic "(+ 1 2)")
|
||||
(is (eq ok t))))
|
||||
|
||||
(test semantic-blocked-eval
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-semantic "(eval '(+ 1 2))")
|
||||
(is (not ok))))
|
||||
|
||||
(test semantic-blocked-delete
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-utils-check-semantic "(delete-file \"x.txt\")")
|
||||
(is (not ok))))
|
||||
|
||||
;; Unified validation
|
||||
(test unified-success
|
||||
(let ((result (opencortex::lisp-utils-validate "(+ 1 2)" :strict t)))
|
||||
(is (eq (getf result :status) :success))))
|
||||
|
||||
(test unified-structural-fail
|
||||
(let ((result (opencortex::lisp-utils-validate "(+ 1 2" :strict nil)))
|
||||
(is (eq (getf result :status) :error))
|
||||
(is (eq (getf result :failed) :structural))))
|
||||
|
||||
(test unified-semantic-fail
|
||||
(let ((result (opencortex::lisp-utils-validate "(delete-file \"x.txt\")" :strict t)))
|
||||
(is (eq (getf result :status) :error))
|
||||
(is (eq (getf result :failed) :semantic))))
|
||||
@@ -1,54 +0,0 @@
|
||||
(defpackage :opencortex-lisp-validator-tests
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:lisp-validator-suite))
|
||||
|
||||
(in-package :opencortex-lisp-validator-tests)
|
||||
|
||||
(def-suite lisp-validator-suite
|
||||
:description "Tests for the Lisp Validator structural, syntactic, and semantic gates")
|
||||
|
||||
(in-suite lisp-validator-suite)
|
||||
|
||||
(test structural-balanced
|
||||
(let ((result (opencortex::lisp-validator-check-structural "(+ 1 2)")))
|
||||
(is (eq result t))))
|
||||
|
||||
(test structural-unbalanced-open
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-structural "(+ 1 2")
|
||||
(is (null ok))
|
||||
(is (search "Unbalanced" reason))))
|
||||
|
||||
(test structural-unbalanced-close
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-structural "+ 1 2)")
|
||||
(is (null ok))
|
||||
(is (search "Unbalanced" reason))))
|
||||
|
||||
(test syntactic-valid
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-syntactic "(+ 1 2)")
|
||||
(is (eq ok t))))
|
||||
|
||||
(test syntactic-invalid-reader
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-syntactic "(1+ 2 #\")")
|
||||
(is (not ok))))
|
||||
|
||||
(test semantic-safe
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-semantic "(+ 1 2)")
|
||||
(is (eq ok t))))
|
||||
|
||||
(test semantic-blocked-eval
|
||||
(multiple-value-bind (ok reason line col)
|
||||
(opencortex::lisp-validator-check-semantic "(eval '(+ 1 2))")
|
||||
(is (not ok))))
|
||||
|
||||
(test unified-success
|
||||
(let ((result (opencortex::lisp-validator-validate "(+ 1 2)" :strict t)))
|
||||
(is (eq (getf result :status) :success))))
|
||||
|
||||
(test unified-failure
|
||||
(let ((result (opencortex::lisp-validator-validate "(+ 1 2" :strict nil)))
|
||||
(is (eq (getf result :status) :error))))
|
||||
@@ -1,73 +0,0 @@
|
||||
(defpackage :opencortex-literate-programming-tests
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:literate-programming-suite))
|
||||
|
||||
(in-package :opencortex-literate-programming-tests)
|
||||
|
||||
(def-suite literate-programming-suite
|
||||
:description "Tests for Literate Programming enforcement")
|
||||
|
||||
(in-suite literate-programming-suite)
|
||||
|
||||
(test tangle-sync-detects-stale-lisp
|
||||
"check-tangle-sync returns violation when .lisp is newer than .org"
|
||||
(let* ((root (uiop:ensure-directory-pathname "/tmp/lp-test/"))
|
||||
(tmp-org (merge-pathnames "skills/test-skill.org" root))
|
||||
(tmp-lisp (merge-pathnames "library/gen/test-skill.lisp" root)))
|
||||
(uiop:ensure-all-directories-exist (list (directory-namestring tmp-org) (directory-namestring tmp-lisp)))
|
||||
(with-open-file (f tmp-org :direction :output) (write-line "* Test" f))
|
||||
(sleep 1)
|
||||
(with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f))
|
||||
(let ((orig-targets opencortex::*tangle-targets*))
|
||||
(setf opencortex::*tangle-targets*
|
||||
(cons '("skills/test-skill.org" . "library/gen/test-skill.lisp") orig-targets))
|
||||
(unwind-protect
|
||||
(let ((result (opencortex::check-tangle-sync root)))
|
||||
(is (listp result))
|
||||
(is (eq :log (getf result :type)))
|
||||
(is (search "LITERATE PROGRAMMING VIOLATION" (getf (getf result :payload) :text))))
|
||||
(setf opencortex::*tangle-targets* orig-targets)))
|
||||
(uiop:delete-file-if-exists tmp-org)
|
||||
(uiop:delete-file-if-exists tmp-lisp)))
|
||||
|
||||
(test tangle-sync-passes-when-synced
|
||||
"check-tangle-sync returns nil when .org is newer than .lisp"
|
||||
(let* ((root (uiop:ensure-directory-pathname "/tmp/lp-test2/"))
|
||||
(tmp-org (merge-pathnames "skills/test-skill2.org" root))
|
||||
(tmp-lisp (merge-pathnames "library/gen/test-skill2.lisp" root)))
|
||||
(uiop:ensure-all-directories-exist (list (directory-namestring tmp-org) (directory-namestring tmp-lisp)))
|
||||
(with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f))
|
||||
(sleep 1)
|
||||
(with-open-file (f tmp-org :direction :output) (write-line "* Test" f))
|
||||
(let ((orig-targets opencortex::*tangle-targets*))
|
||||
(setf opencortex::*tangle-targets*
|
||||
(cons '("skills/test-skill2.org" . "library/gen/test-skill2.lisp") orig-targets))
|
||||
(unwind-protect
|
||||
(let ((result (opencortex::check-tangle-sync root)))
|
||||
(is (null result)))
|
||||
(setf opencortex::*tangle-targets* orig-targets)))
|
||||
(uiop:delete-file-if-exists tmp-org)
|
||||
(uiop:delete-file-if-exists tmp-lisp)))
|
||||
|
||||
(test tangle-sync-passes-when-synced
|
||||
"check-tangle-sync returns nil when .org is newer than .lisp"
|
||||
(let ((tmp-org "/tmp/test-skill2.org")
|
||||
(tmp-lisp "/tmp/test-skill2.lisp"))
|
||||
(with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f))
|
||||
(sleep 1)
|
||||
(with-open-file (f tmp-org :direction :output) (write-line "* Test" f))
|
||||
(let* ((root (uiop:ensure-directory-pathname "/tmp/"))
|
||||
(result (opencortex::check-tangle-sync root)))
|
||||
(is (null result)))
|
||||
(uiop:delete-file-if-exists tmp-org)
|
||||
(uiop:delete-file-if-exists tmp-lisp)))
|
||||
|
||||
(test block-balance-valid
|
||||
"literate-check-block-balance returns T for balanced code"
|
||||
(is (eq t (opencortex::literate-check-block-balance "(defun test () t)"))))
|
||||
|
||||
(test block-balance-invalid
|
||||
"literate-check-block-balance returns NIL for unbalanced code"
|
||||
(multiple-value-bind (ok reason) (opencortex::literate-check-block-balance "(defun test ()")
|
||||
(is (null ok))
|
||||
(is (stringp reason))))
|
||||
@@ -1,115 +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*)))))))
|
||||
|
||||
(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))))))
|
||||
@@ -1,73 +0,0 @@
|
||||
;;; opencortex-test.el --- Tests for the opencortex Emacs stub
|
||||
|
||||
(require 'ert)
|
||||
(require 'cl-lib)
|
||||
(require 'opencortex "/home/amr/.openclaw/workspace/memex/5_projects/opencortex/src/opencortex.el")
|
||||
|
||||
(ert-deftest test-opencortex-framing ()
|
||||
"Verify that opencortex-send correctly frames a plist."
|
||||
(let ((captured-framed nil))
|
||||
(cl-letf (((symbol-function 'process-send-string)
|
||||
(lambda (proc string) (setq captured-framed string)))
|
||||
((symbol-function 'process-live-p) (lambda (proc) t))
|
||||
(opencortex--process t))
|
||||
(opencortex-send '(:type :EVENT :id 1))
|
||||
(should (string= "000014(:type :EVENT :id 1)" captured-framed)))))
|
||||
|
||||
(ert-deftest test-opencortex-parsing ()
|
||||
"Verify that the filter correctly parses communication protocol framed messages."
|
||||
(let ((mock-buffer (generate-new-buffer " *opencortex-test*"))
|
||||
(received-plist nil))
|
||||
(cl-letf (((symbol-function 'opencortex--handle-message)
|
||||
(lambda (proc plist) (setq received-plist plist))))
|
||||
(with-current-buffer mock-buffer
|
||||
(insert "000014(:type :EVENT :id 1)")
|
||||
(opencortex--process-buffer mock-buffer)
|
||||
(should (equal '(:type :EVENT :id 1) received-plist))
|
||||
(should (= (buffer-size) 0))))))
|
||||
|
||||
(ert-deftest test-opencortex-actuator-message ()
|
||||
"Verify that the :message actuator works."
|
||||
(let ((opencortex--process nil)
|
||||
(captured-response nil))
|
||||
(cl-letf (((symbol-function 'opencortex-send)
|
||||
(lambda (plist) (setq captured-response plist))))
|
||||
(opencortex--execute-request nil 101 '(:action :message :text "Hello from Daemon"))
|
||||
;; Check that we sent a success response back
|
||||
(should (eq :RESPONSE (plist-get captured-response :type)))
|
||||
(should (eq :success (plist-get (plist-get captured-response :payload) :status))))))
|
||||
|
||||
(ert-deftest test-opencortex-run-command ()
|
||||
"Verify that opencortex-run-command sends the correct event."
|
||||
(let ((captured-framed nil))
|
||||
(cl-letf (((symbol-function 'process-send-string)
|
||||
(lambda (proc string) (setq captured-framed string)))
|
||||
((symbol-function 'process-live-p) (lambda (proc) t))
|
||||
(opencortex--process t))
|
||||
(opencortex-run-command :test-cmd)
|
||||
(should (string-match-p ":sensor :user-command" captured-framed))
|
||||
(should (string-match-p ":command :test-cmd" captured-framed)))))
|
||||
|
||||
(ert-deftest test-opencortex-ast-cleaning ()
|
||||
"Verify that opencortex--clean-element produces a pure plist."
|
||||
(let* ((org-text "* Hello\nWorld")
|
||||
(ast (with-temp-buffer
|
||||
(org-mode)
|
||||
(insert org-text)
|
||||
(org-element-parse-buffer)))
|
||||
(cleaned (opencortex--clean-element ast)))
|
||||
(should (plist-get cleaned :type))
|
||||
(should (eq 'org-data (plist-get cleaned :type)))
|
||||
;; Check that children exist
|
||||
(should (plist-get (car (plist-get cleaned :contents)) :type))
|
||||
;; Check that we didn't leak buffer objects
|
||||
(should-not (plist-get (plist-get cleaned :properties) :buffer))))
|
||||
|
||||
(ert-deftest test-opencortex-actuator-eval ()
|
||||
"Verify that the :eval actuator can execute elisp."
|
||||
(let ((opencortex--process nil)
|
||||
(captured-response nil))
|
||||
(cl-letf (((symbol-function 'opencortex-send)
|
||||
(lambda (plist) (setq captured-response plist))))
|
||||
(opencortex--execute-request nil 102 '(:action :eval :code "(+ 1 2)"))
|
||||
(should (equal "3" (plist-get (plist-get captured-response :payload) :result))))))
|
||||
@@ -1,32 +0,0 @@
|
||||
(defpackage :opencortex-peripheral-vision-tests
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:vision-suite))
|
||||
(in-package :opencortex-peripheral-vision-tests)
|
||||
|
||||
(def-suite vision-suite
|
||||
:description "Verification of Foveal-Peripheral context model.")
|
||||
(in-suite vision-suite)
|
||||
|
||||
(test test-foveal-rendering
|
||||
"Verify that the foveal target is rendered with content, while siblings are skeletal."
|
||||
(clrhash opencortex::*memory*)
|
||||
(let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS "project")
|
||||
:contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node")
|
||||
:raw-content "FOVEAL CONTENT" :contents nil)
|
||||
(:type :HEADLINE :properties (:ID "node-peripheral" :TITLE "Peripheral Node")
|
||||
:raw-content "PERIPHERAL CONTENT" :contents nil)))))
|
||||
(ingest-ast ast)
|
||||
;; Test both foveal focus in signal top-level and in payload (legacy)
|
||||
(let ((output (context-assemble-global-awareness (list :foveal-focus "node-foveal"))))
|
||||
(is (search "FOVEAL CONTENT" output))
|
||||
(is (search "* Peripheral Node" output))
|
||||
(is (not (search "PERIPHERAL CONTENT" output))))))
|
||||
|
||||
(test test-awareness-budget
|
||||
"Verify that context-assemble-global-awareness handles multiple projects."
|
||||
(clrhash opencortex::*memory*)
|
||||
(ingest-ast '(:type :HEADLINE :properties (:ID "p1" :TITLE "Project 1" :TAGS "project") :contents nil))
|
||||
(ingest-ast '(:type :HEADLINE :properties (:ID "p2" :TITLE "Project 2" :TAGS "project") :contents nil))
|
||||
(let ((output (context-assemble-global-awareness)))
|
||||
(is (search "Project 1" output))
|
||||
(is (search "Project 2" output))))
|
||||
@@ -1,33 +0,0 @@
|
||||
(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))))))
|
||||
@@ -1,23 +0,0 @@
|
||||
(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)))))
|
||||
@@ -1,26 +0,0 @@
|
||||
(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)))))
|
||||
@@ -1,50 +0,0 @@
|
||||
(load "~/quicklisp/setup.lisp")
|
||||
|
||||
(push #p"./" asdf:*central-registry*)
|
||||
|
||||
(ql:quickload '(:usocket :bordeaux-threads :cl-postgres :split-sequence
|
||||
:dexador :jonathan :cl-dotenv :hunchentoot
|
||||
:trivial-garbage :s-sql :str :uuid :cl-json :uiop :fiveam))
|
||||
|
||||
(asdf:load-system :opencortex)
|
||||
(asdf:load-system :opencortex/tests)
|
||||
|
||||
(format t "~%=== Running ALL Test Suites ===~%")
|
||||
|
||||
;; Engineering Standards tests
|
||||
(when (find-package :OPENCORTEX-ENGINEERING-STANDARDS-TESTS)
|
||||
(fiveam:run! 'OPENCORTEX-ENGINEERING-STANDARDS-TESTS::ENGINEERING-STANDARDS-SUITE))
|
||||
|
||||
;; Literate Programming tests
|
||||
(when (find-package :OPENCORTEX-LITERATE-PROGRAMMING-TESTS)
|
||||
(fiveam:run! 'OPENCORTEX-LITERATE-PROGRAMMING-TESTS::LITERATE-PROGRAMMING-SUITE))
|
||||
|
||||
;; Communication tests
|
||||
(when (find-package :OPENCORTEX-TESTS)
|
||||
(fiveam:run! 'OPENCORTEX-TESTS::COMMUNICATION-PROTOCOL-SUITE))
|
||||
|
||||
;; Pipeline tests
|
||||
(when (find-package :OPENCORTEX-PIPELINE-TESTS)
|
||||
(fiveam:run! 'OPENCORTEX-PIPELINE-TESTS::PIPELINE-SUITE))
|
||||
|
||||
;; Boot sequence tests
|
||||
(when (find-package :OPENCORTEX-BOOT-TESTS)
|
||||
(fiveam:run! 'OPENCORTEX-BOOT-TESTS::BOOT-SUITE))
|
||||
|
||||
;; Memory tests
|
||||
(when (find-package :OPENCORTEX-MEMORY-TESTS)
|
||||
(fiveam:run! 'OPENCORTEX-MEMORY-TESTS::MEMORY-SUITE))
|
||||
|
||||
;; Immune system tests
|
||||
(when (find-package :OPENCORTEX-IMMUNE-SYSTEM-TESTS)
|
||||
(fiveam:run! 'OPENCORTEX-IMMUNE-SYSTEM-TESTS::IMMUNE-SUITE))
|
||||
|
||||
;; Emacs edit tests
|
||||
(when (find-package :OPENCORTEX-EMACS-EDIT-TESTS)
|
||||
(fiveam:run! 'OPENCORTEX-EMACS-EDIT-TESTS::EMACS-EDIT-SUITE))
|
||||
|
||||
;; Lisp utils tests
|
||||
(when (find-package :OPENCORTEX-LISP-UTILS-TESTS)
|
||||
(fiveam:run! 'OPENCORTEX-LISP-UTILS-TESTS::LISP-UTILS-SUITE))
|
||||
|
||||
(format t "~%=== ALL TESTS COMPLETE ===~%")
|
||||
@@ -1,34 +0,0 @@
|
||||
(defpackage :opencortex-self-edit-tests
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:self-edit-suite))
|
||||
|
||||
(in-package :opencortex-self-edit-tests)
|
||||
|
||||
(def-suite self-edit-suite
|
||||
:description "Tests for Self-Edit skill.")
|
||||
|
||||
(in-suite self-edit-suite)
|
||||
|
||||
(test balance-parens-balanced
|
||||
(let ((result (opencortex::self-edit-balance-parens "(+ 1 2)")))
|
||||
(is (string= result "(+ 1 2)"))
|
||||
(is (not (null (read-from-string result))))))
|
||||
|
||||
(test balance-parens-missing-open
|
||||
(let ((result (opencortex::self-edit-balance-parens "+ 1 2)")))
|
||||
(is (string= result "(+ 1 2)"))
|
||||
(is (not (null (read-from-string result))))))
|
||||
|
||||
(test balance-parens-missing-close
|
||||
(let ((result (opencortex::self-edit-balance-parens "(+ 1 2")))
|
||||
(is (string= result "(+ 1 2)"))
|
||||
(is (not (null (read-from-string result))))))
|
||||
|
||||
(test balance-parens-deep
|
||||
(let ((result (opencortex::self-edit-balance-parens "((lambda (x) (if x (+ 1 2) 3))")))
|
||||
(is (string= result "((lambda (x) (if x (+ 1 2) 3)))"))
|
||||
(is (not (null (read-from-string result))))))
|
||||
|
||||
(test balance-parens-empty
|
||||
(let ((result (opencortex::self-edit-balance-parens "")))
|
||||
(is (string= result ""))))
|
||||
@@ -1,46 +0,0 @@
|
||||
import socket
|
||||
import struct
|
||||
|
||||
def frame_message(msg_string):
|
||||
payload = msg_string.encode('utf-8')
|
||||
return f"{len(payload):06x}".encode('ascii') + payload
|
||||
|
||||
def read_framed(sock):
|
||||
header = b''
|
||||
while len(header) < 6:
|
||||
chunk = sock.recv(6 - len(header))
|
||||
if not chunk:
|
||||
return None
|
||||
header += chunk
|
||||
length = int(header, 16)
|
||||
data = b''
|
||||
while len(data) < length:
|
||||
chunk = sock.recv(length - len(data))
|
||||
if not chunk:
|
||||
return None
|
||||
data += chunk
|
||||
return data.decode('utf-8')
|
||||
|
||||
msg = '(:TYPE :REQUEST :PAYLOAD (:ACTION :MESSAGE :TEXT "hello") :META (:SOURCE :CLI :SESSION-ID "test1"))'
|
||||
|
||||
sock = socket.socket(socket.AF_INET, socket.SOCK_STREAM)
|
||||
sock.connect(('127.0.0.1', 9105))
|
||||
sock.settimeout(10.0)
|
||||
|
||||
# Read handshake
|
||||
handshake = read_framed(sock)
|
||||
print("HANDSHAKE:", handshake)
|
||||
|
||||
# Read status
|
||||
status = read_framed(sock)
|
||||
print("STATUS:", status)
|
||||
|
||||
# Send message
|
||||
sock.sendall(frame_message(msg))
|
||||
print("SENT:", msg)
|
||||
|
||||
# Read response
|
||||
response = read_framed(sock)
|
||||
print("RESPONSE:", response)
|
||||
|
||||
sock.close()
|
||||
@@ -1,34 +0,0 @@
|
||||
(defpackage :opencortex-tool-permissions-tests
|
||||
(:use :cl :fiveam :opencortex)
|
||||
(:export #:tool-permissions-suite))
|
||||
|
||||
(in-package :opencortex-tool-permissions-tests)
|
||||
|
||||
(def-suite tool-permissions-suite
|
||||
:description "Tests for Tool Permissions skill")
|
||||
|
||||
(in-suite tool-permissions-suite)
|
||||
|
||||
(test default-permission-is-allow
|
||||
"Verify default permission is :allow."
|
||||
(is (eq (get-tool-permission "unknown-tool") :allow)))
|
||||
|
||||
(test set-and-get-permission
|
||||
"Verify setting and getting permissions."
|
||||
(set-tool-permission "test-tool-abc" :deny)
|
||||
(is (eq (get-tool-permission "test-tool-abc") :deny)))
|
||||
|
||||
(test permission-gate-allow
|
||||
"Verify :allow tier passes through."
|
||||
(set-tool-permission "gate-allow-tool" :allow)
|
||||
(is (eq (check-tool-permission-gate "gate-allow-tool" nil) :allow)))
|
||||
|
||||
(test permission-gate-deny
|
||||
"Verify :deny tier blocks."
|
||||
(set-tool-permission "gate-deny-tool" :deny)
|
||||
(is (eq (check-tool-permission-gate "gate-deny-tool" nil) :deny)))
|
||||
|
||||
(test permission-gate-ask
|
||||
"Verify :ask tier returns ask list."
|
||||
(set-tool-permission "gate-ask-tool" :ask)
|
||||
(is (listp (check-tool-permission-gate "gate-ask-tool" nil))))
|
||||
@@ -1,85 +0,0 @@
|
||||
import pty
|
||||
import os
|
||||
import sys
|
||||
import time
|
||||
import select
|
||||
import re
|
||||
|
||||
class VirtualTerminal:
|
||||
def __init__(self, rows=24, cols=80):
|
||||
self.rows = rows
|
||||
self.cols = cols
|
||||
self.buffer = [[' ' for _ in range(cols)] for _ in range(rows)]
|
||||
self.cursor_y = 0
|
||||
self.cursor_x = 0
|
||||
|
||||
def _strip_ansi(self, text):
|
||||
# Very basic ANSI parser for cursor moves and clears
|
||||
# CSI n ; m H (cursor move)
|
||||
# CSI J (clear screen)
|
||||
# CSI K (clear line)
|
||||
|
||||
# This is a simplified state machine
|
||||
parts = re.split(r'(\x1b\[[0-9;?]*[a-zA-Z])', text)
|
||||
for part in parts:
|
||||
if part.startswith('\x1b['):
|
||||
cmd = part[-1]
|
||||
params = part[2:-1].split(';')
|
||||
if cmd == 'H' or cmd == 'f': # Move cursor
|
||||
self.cursor_y = int(params[0]) - 1 if params[0] else 0
|
||||
self.cursor_x = int(params[1]) - 1 if (len(params) > 1 and params[1]) else 0
|
||||
elif cmd == 'J': # Clear
|
||||
mode = int(params[0]) if params[0] else 0
|
||||
if mode == 2: # Full clear
|
||||
self.buffer = [[' ' for _ in range(self.cols)] for _ in range(self.rows)]
|
||||
elif cmd == 'm': # Attributes - ignore for now
|
||||
pass
|
||||
else:
|
||||
for char in part:
|
||||
if char == '\n':
|
||||
self.cursor_y += 1
|
||||
self.cursor_x = 0
|
||||
elif char == '\r':
|
||||
self.cursor_x = 0
|
||||
elif 0 <= self.cursor_y < self.rows and 0 <= self.cursor_x < self.cols:
|
||||
self.buffer[self.cursor_y][self.cursor_x] = char
|
||||
self.cursor_x += 1
|
||||
|
||||
def get_screen(self):
|
||||
return "\n".join(["".join(row) for row in self.buffer])
|
||||
|
||||
def run_test(command, input_sequence, wait_time=5):
|
||||
pid, fd = pty.fork()
|
||||
if pid == 0:
|
||||
os.environ["TERM"] = "xterm"
|
||||
os.environ["COLUMNS"] = "80"
|
||||
os.environ["LINES"] = "24"
|
||||
os.execvp(command[0], command)
|
||||
else:
|
||||
vt = VirtualTerminal()
|
||||
start_time = time.time()
|
||||
input_sent = False
|
||||
|
||||
while time.time() - start_time < wait_time:
|
||||
r, w, e = select.select([fd], [], [], 0.1)
|
||||
if fd in r:
|
||||
try:
|
||||
data = os.read(fd, 8192).decode(errors='ignore')
|
||||
vt._strip_ansi(data)
|
||||
except OSError:
|
||||
break
|
||||
|
||||
if not input_sent and time.time() - start_time > 2:
|
||||
os.write(fd, input_sequence.encode())
|
||||
input_sent = True
|
||||
|
||||
os.kill(pid, 9)
|
||||
os.waitpid(pid, 0)
|
||||
return vt
|
||||
|
||||
if __name__ == "__main__":
|
||||
# Example usage: python3 ui_driver.py sbcl --eval ...
|
||||
vt = run_test(sys.argv[1:], "Hi\r", wait_time=10)
|
||||
print("--- VIRTUAL SCREEN SNAPSHOT ---")
|
||||
print(vt.get_screen())
|
||||
print(f"--- CURSOR POSITION: ({vt.cursor_y}, {vt.cursor_x}) ---")
|
||||
@@ -1,67 +0,0 @@
|
||||
import sys
|
||||
import os
|
||||
import time
|
||||
|
||||
# Add scripts directory to path to import ui_driver
|
||||
sys.path.append(os.path.join(os.getcwd(), 'scripts'))
|
||||
from ui_driver import run_test
|
||||
|
||||
|
||||
def wait_for_brain():
|
||||
print("[UI TEST] Waiting for Brain to wake up...")
|
||||
for i in range(60):
|
||||
if os.path.exists('brain.log'):
|
||||
with open('brain.log', 'r') as f:
|
||||
if 'Boot Complete' in f.read():
|
||||
print("[UI TEST] Brain is Green. Waiting for TCP listener...")
|
||||
time.sleep(5)
|
||||
return True
|
||||
time.sleep(2)
|
||||
return False
|
||||
|
||||
def test_tui_boot_and_input():
|
||||
if not wait_for_brain():
|
||||
print("FAIL: Brain failed to boot within timeout.")
|
||||
return
|
||||
|
||||
print("[UI TEST] Launching TUI and sending 'Hi'...")
|
||||
|
||||
# We run the TUI script via bash
|
||||
|
||||
# Direct SBCL launch to bypass shell script noise
|
||||
command = ["sbcl", "--disable-debugger",
|
||||
"--eval", "(load (merge-pathnames \"quicklisp/setup.lisp\" (user-homedir-pathname)))",
|
||||
"--eval", "(push (truename \"\") asdf:*central-registry*)",
|
||||
"--eval", "(ql:quickload :opencortex/tui)",
|
||||
"--eval", "(opencortex.tui:main)"]
|
||||
|
||||
vt = run_test(command, "Hi\r", wait_time=15)
|
||||
|
||||
screen = vt.get_screen()
|
||||
|
||||
# 1. Verify Prompt
|
||||
if "> Hi" in screen:
|
||||
print("PASS: Local Echo found in chat history.")
|
||||
elif ">" in screen:
|
||||
print("PASS: Input prompt found.")
|
||||
else:
|
||||
print("FAIL: No input prompt found.")
|
||||
|
||||
# 2. Verify Status Bar
|
||||
if "[Scribe:" in screen and "Gardener:" in screen:
|
||||
print("PASS: Status bar rendered correctly.")
|
||||
else:
|
||||
print("FAIL: Status bar missing.")
|
||||
|
||||
# 3. Verify Cursor Position (should be at the end of the empty prompt after Enter)
|
||||
# The prompt is line 23 (h-1), col 2 (after "> ")
|
||||
if vt.cursor_y == 23 and vt.cursor_x == 2:
|
||||
print(f"PASS: Cursor is correctly pinned to prompt at ({vt.cursor_y}, {vt.cursor_x}).")
|
||||
else:
|
||||
print(f"WARN: Cursor at unexpected position ({vt.cursor_y}, {vt.cursor_x}).")
|
||||
|
||||
print("\n--- FINAL SCREEN SNAPSHOT ---")
|
||||
print(screen)
|
||||
|
||||
if __name__ == "__main__":
|
||||
test_tui_boot_and_input()
|
||||
Reference in New Issue
Block a user