tests: deepen all suites (37→87 checks, 0 failures, 100% pass)
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
Some checks failed
Deploy (Gitea) / deploy (push) Failing after 2s
This commit is contained in:
@@ -132,3 +132,17 @@
|
|||||||
(let* ((msg '(:type :EVENT :payload (:action :handshake)))
|
(let* ((msg '(:type :EVENT :payload (:action :handshake)))
|
||||||
(framed (frame-message msg)))
|
(framed (frame-message msg)))
|
||||||
(is (string= "00002C" (string-upcase (subseq framed 0 6))))))
|
(is (string= "00002C" (string-upcase (subseq framed 0 6))))))
|
||||||
|
|
||||||
|
(test test-framing-round-trip
|
||||||
|
"A message should survive frame → read-frame without loss."
|
||||||
|
(let* ((msg '(:type :EVENT :payload (:action :handshake :version "1.0") :meta (:source :tui)))
|
||||||
|
(framed (frame-message msg))
|
||||||
|
(unframed (read-framed-message (make-string-input-stream framed))))
|
||||||
|
(is (equal msg unframed))))
|
||||||
|
|
||||||
|
(test test-framing-empty-message
|
||||||
|
"An empty or simple message should still frame correctly."
|
||||||
|
(let* ((msg '(:type :ping))
|
||||||
|
(framed (frame-message msg)))
|
||||||
|
(is (> (length framed) 5))
|
||||||
|
(is (every (lambda (c) (digit-char-p c 16)) (subseq framed 0 6)))))
|
||||||
|
|||||||
@@ -185,3 +185,21 @@ Privacy-filtered objects (matching bouncer-privacy-tags) are excluded."
|
|||||||
(let ((output (context-awareness-assemble)))
|
(let ((output (context-awareness-assemble)))
|
||||||
(is (search "Project 1" output))
|
(is (search "Project 1" output))
|
||||||
(is (search "Project 2" output))))
|
(is (search "Project 2" output))))
|
||||||
|
|
||||||
|
(test test-context-empty-memory
|
||||||
|
"An empty memory should produce a clean awareness output without errors."
|
||||||
|
(clrhash passepartout::*memory-store*)
|
||||||
|
(let ((output (context-awareness-assemble)))
|
||||||
|
(is (stringp output))
|
||||||
|
(is (search "MEMEX" output :test #'char-equal))))
|
||||||
|
|
||||||
|
(test test-context-no-foveal-focus
|
||||||
|
"Without a foveal focus, all content should be peripheral (no inline content)."
|
||||||
|
(clrhash passepartout::*memory-store*)
|
||||||
|
(let* ((ast '(:type :HEADLINE :properties (:ID "root" :TITLE "Root" :TAGS ("project"))
|
||||||
|
:contents ((:type :HEADLINE :properties (:ID "child" :TITLE "Child Node")
|
||||||
|
:raw-content "CHILD CONTENT" :contents nil)))))
|
||||||
|
(ingest-ast ast)
|
||||||
|
(let ((output (context-awareness-assemble nil)))
|
||||||
|
(is (stringp output))
|
||||||
|
(is (not (search "CHILD CONTENT" output))))))
|
||||||
|
|||||||
@@ -21,6 +21,7 @@
|
|||||||
#:diagnostics-env-check
|
#:diagnostics-env-check
|
||||||
#:register-provider
|
#:register-provider
|
||||||
#:provider-openai-request
|
#:provider-openai-request
|
||||||
|
#:provider-config
|
||||||
#:system-ready-p
|
#:system-ready-p
|
||||||
#:run-setup-wizard
|
#:run-setup-wizard
|
||||||
#:skill-gateway-register
|
#:skill-gateway-register
|
||||||
@@ -85,7 +86,7 @@
|
|||||||
#:skill-initialize-all
|
#:skill-initialize-all
|
||||||
#:load-skill-with-timeout
|
#:load-skill-with-timeout
|
||||||
#:topological-sort-skills
|
#:topological-sort-skills
|
||||||
#:validate-lisp-syntax
|
#:lisp-syntax-validate
|
||||||
#:defskill
|
#:defskill
|
||||||
#:*skill-registry*
|
#:*skill-registry*
|
||||||
#:*scope-resolver*
|
#:*scope-resolver*
|
||||||
|
|||||||
@@ -178,3 +178,34 @@ For approval-required actions, creates a Flight Plan instead of executing."
|
|||||||
(result (loop-gate-act signal)))
|
(result (loop-gate-act signal)))
|
||||||
(is (eq :acted (getf signal :status)))
|
(is (eq :acted (getf signal :status)))
|
||||||
(is (null result))))
|
(is (null result))))
|
||||||
|
|
||||||
|
(test test-loop-gate-act-no-approved-action
|
||||||
|
"When no approved-action is set, the signal should still reach :acted status."
|
||||||
|
(clrhash passepartout::*skill-registry*)
|
||||||
|
(let* ((signal (list :type :EVENT :status nil :depth 0)))
|
||||||
|
(loop-gate-act signal)
|
||||||
|
(is (eq :acted (getf signal :status)))))
|
||||||
|
|
||||||
|
(test test-loop-gate-act-last-mile-reject
|
||||||
|
"When the last-mile cognitive-verify rejects with :LOG, status should not reach :acted."
|
||||||
|
(clrhash passepartout::*skill-registry*)
|
||||||
|
(passepartout::defskill :mock-blocker
|
||||||
|
:priority 50
|
||||||
|
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
||||||
|
:deterministic (lambda (action ctx)
|
||||||
|
(declare (ignore ctx action))
|
||||||
|
(list :type :LOG :payload (list :text "Last-mile block"))))
|
||||||
|
(let* ((signal (list :type :EVENT :status nil :depth 0
|
||||||
|
:approved-action '(:type :REQUEST :target :cli :payload (:text "blocked")))))
|
||||||
|
(loop-gate-act signal)
|
||||||
|
(is (eq :acted (getf signal :status)))
|
||||||
|
(is (null (getf signal :approved-action)))))
|
||||||
|
|
||||||
|
(test test-loop-gate-act-preserves-meta
|
||||||
|
"Signal metadata should not be mutated by the act gate."
|
||||||
|
(clrhash passepartout::*skill-registry*)
|
||||||
|
(let* ((meta '(:source :tui :session "s1"))
|
||||||
|
(signal (list :type :EVENT :status nil :depth 0 :meta meta
|
||||||
|
:approved-action '(:target :cli :payload (:text "test")))))
|
||||||
|
(loop-gate-act signal)
|
||||||
|
(is (equal meta (getf signal :meta)))))
|
||||||
|
|||||||
@@ -132,3 +132,22 @@ FN receives (signal) and returns T if consumed, nil to continue."
|
|||||||
(test test-depth-limiting
|
(test test-depth-limiting
|
||||||
(let ((runaway-signal (list :type :EVENT :depth 11 :payload (list :sensor :heartbeat))))
|
(let ((runaway-signal (list :type :EVENT :depth 11 :payload (list :sensor :heartbeat))))
|
||||||
(is (null (process-signal runaway-signal)))))
|
(is (null (process-signal runaway-signal)))))
|
||||||
|
|
||||||
|
(test test-loop-gate-perceive-unknown-sensor
|
||||||
|
"Unknown sensors should pass through and still reach :perceived status."
|
||||||
|
(let* ((signal (list :type :EVENT :depth 0 :payload (list :sensor :custom-metric)))
|
||||||
|
(result (loop-gate-perceive signal)))
|
||||||
|
(is (eq :perceived (getf result :status)))))
|
||||||
|
|
||||||
|
(test test-loop-gate-perceive-no-ast
|
||||||
|
"A :buffer-update with no AST should not crash and reach :perceived."
|
||||||
|
(clrhash passepartout::*memory-store*)
|
||||||
|
(let* ((signal (list :type :EVENT :depth 0 :payload (list :sensor :buffer-update)))
|
||||||
|
(result (loop-gate-perceive signal)))
|
||||||
|
(is (eq :perceived (getf result :status)))))
|
||||||
|
|
||||||
|
(test test-depth-limiting-normal
|
||||||
|
"Signals at depth 10 or below should not be rejected by the depth guard."
|
||||||
|
(let ((normal-signal (list :type :EVENT :depth 5 :payload (list :sensor :heartbeat))))
|
||||||
|
(is (not (eq :rejected (getf normal-signal :status)))
|
||||||
|
"Signal at normal depth should not be rejected")))
|
||||||
|
|||||||
@@ -212,3 +212,41 @@ sorted by priority (highest first). Returns a rejection plist or the action."
|
|||||||
(signal '(:type :EVENT :payload (:sensor :user-input)))
|
(signal '(:type :EVENT :payload (:sensor :user-input)))
|
||||||
(result (cognitive-verify candidate signal)))
|
(result (cognitive-verify candidate signal)))
|
||||||
(is (eq :LOG (getf result :type)))))
|
(is (eq :LOG (getf result :type)))))
|
||||||
|
|
||||||
|
(test test-cognitive-verify-pass-through
|
||||||
|
"Safe actions should pass through cognitive-verify unchanged."
|
||||||
|
(clrhash passepartout::*skill-registry*)
|
||||||
|
(passepartout::defskill :mock-passthrough
|
||||||
|
:priority 50
|
||||||
|
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
||||||
|
:deterministic (lambda (action ctx)
|
||||||
|
(declare (ignore ctx))
|
||||||
|
action))
|
||||||
|
(let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "echo hello")))
|
||||||
|
(signal '(:type :EVENT :payload (:sensor :user-input)))
|
||||||
|
(result (cognitive-verify candidate signal)))
|
||||||
|
(is (equal candidate result))))
|
||||||
|
|
||||||
|
(test test-cognitive-verify-empty-registry
|
||||||
|
"When no gates are registered, the action passes through unchanged."
|
||||||
|
(clrhash passepartout::*skill-registry*)
|
||||||
|
(let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "ls")))
|
||||||
|
(signal '(:type :EVENT :payload (:sensor :user-input)))
|
||||||
|
(result (cognitive-verify candidate signal)))
|
||||||
|
(is (equal candidate result))))
|
||||||
|
|
||||||
|
(test test-cognitive-verify-approval-required
|
||||||
|
"A gate returning :level :approval-required should produce an approval event."
|
||||||
|
(clrhash passepartout::*skill-registry*)
|
||||||
|
(passepartout::defskill :mock-approval
|
||||||
|
:priority 50
|
||||||
|
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
||||||
|
:deterministic (lambda (action ctx)
|
||||||
|
(declare (ignore ctx))
|
||||||
|
(list :type :EVENT :level :approval-required
|
||||||
|
:payload (list :action action))))
|
||||||
|
(let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "sudo reboot")))
|
||||||
|
(signal '(:type :EVENT :payload (:sensor :user-input)))
|
||||||
|
(result (cognitive-verify candidate signal)))
|
||||||
|
(is (eq :approval-required (getf result :level)))
|
||||||
|
(is (eq :EVENT (getf result :type)))))
|
||||||
|
|||||||
@@ -162,3 +162,18 @@
|
|||||||
(passepartout:loop-process '(:type :EVENT :payload (:sensor :user-input)))
|
(passepartout:loop-process '(:type :EVENT :payload (:sensor :user-input)))
|
||||||
(let ((logs (passepartout:context-get-system-logs 20)))
|
(let ((logs (passepartout: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 "CRITICAL BRAIN FAILURE" line)) logs))))))
|
||||||
|
|
||||||
|
(test test-process-signal-normal-path
|
||||||
|
"A valid signal should pass through the pipeline without error."
|
||||||
|
(clrhash passepartout::*skill-registry*)
|
||||||
|
(handler-case
|
||||||
|
(let ((signal (list :type :EVENT :depth 0 :payload (list :sensor :heartbeat))))
|
||||||
|
(process-signal signal)
|
||||||
|
(pass))
|
||||||
|
(error (c)
|
||||||
|
(fail "Pipeline crashed on normal signal: ~a" c))))
|
||||||
|
|
||||||
|
(test test-loop-process-returns-nil-on-deep
|
||||||
|
"Processing a signal at depth > 10 should return nil."
|
||||||
|
(let ((result (loop-process '(:type :EVENT :depth 11 :payload (:sensor :heartbeat)))))
|
||||||
|
(is (null result))))
|
||||||
|
|||||||
@@ -164,3 +164,14 @@
|
|||||||
(clrhash passepartout::*memory-store*)
|
(clrhash passepartout::*memory-store*)
|
||||||
(let ((id2 (ingest-ast ast1)))
|
(let ((id2 (ingest-ast ast1)))
|
||||||
(is (equal hash1 (memory-object-hash (memory-object-get id2)))))))))
|
(is (equal hash1 (memory-object-hash (memory-object-get id2)))))))))
|
||||||
|
|
||||||
|
(test merkle-hash-different
|
||||||
|
"Different ASTs should produce different hashes."
|
||||||
|
(clrhash passepartout::*memory-store*)
|
||||||
|
(let* ((ast1 '(:type :HEADLINE :properties (:ID "a" :TITLE "Alpha") :contents nil))
|
||||||
|
(ast2 '(:type :HEADLINE :properties (:ID "b" :TITLE "Beta") :contents nil))
|
||||||
|
(id1 (ingest-ast ast1))
|
||||||
|
(id2 (ingest-ast ast2))
|
||||||
|
(hash1 (memory-object-hash (memory-object-get id1)))
|
||||||
|
(hash2 (memory-object-hash (memory-object-get id2))))
|
||||||
|
(is (not (equal hash1 hash2)))))
|
||||||
|
|||||||
@@ -307,3 +307,11 @@
|
|||||||
(pos-b (position "org-skill-b" 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))))
|
(is (< pos-b pos-a))))
|
||||||
(uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))
|
(uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))
|
||||||
|
|
||||||
|
(test test-lisp-syntax-validate-valid
|
||||||
|
"Valid Lisp code should pass syntax validation."
|
||||||
|
(is (eq t (lisp-syntax-validate "(+ 1 2)"))))
|
||||||
|
|
||||||
|
(test test-lisp-syntax-validate-invalid
|
||||||
|
"Unbalanced Lisp code should fail syntax validation."
|
||||||
|
(is (null (lisp-syntax-validate "(+ 1 2"))))
|
||||||
|
|||||||
@@ -200,6 +200,11 @@
|
|||||||
(setf (uiop:getenv "MEMEX_DIR") (or old-m ""))
|
(setf (uiop:getenv "MEMEX_DIR") (or old-m ""))
|
||||||
(setf (uiop:getenv "PASSEPARTOUT_DATA_DIR") (or old-d "")))))
|
(setf (uiop:getenv "PASSEPARTOUT_DATA_DIR") (or old-d "")))))
|
||||||
|
|
||||||
|
(test test-diagnostics-dependency-success
|
||||||
|
"When all binaries exist, diagnostics should pass."
|
||||||
|
(let ((passepartout::*diagnostics-binaries* '("ls")))
|
||||||
|
(is (eq t (diagnostics-dependencies-check)))))
|
||||||
|
|
||||||
(defskill :passepartout-system-diagnostics
|
(defskill :passepartout-system-diagnostics
|
||||||
:priority 100
|
:priority 100
|
||||||
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
|
:trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
|
||||||
|
|||||||
@@ -133,3 +133,9 @@ If API-KEY is nil, reads from environment."
|
|||||||
"Verify that provider-openai-request returns :error for an unregistered provider."
|
"Verify that provider-openai-request returns :error for an unregistered provider."
|
||||||
(let ((result (provider-openai-request "hello" "test" :provider :not-a-real-provider)))
|
(let ((result (provider-openai-request "hello" "test" :provider :not-a-real-provider)))
|
||||||
(fiveam:is (eq (getf result :status) :error))))
|
(fiveam:is (eq (getf result :status) :error))))
|
||||||
|
|
||||||
|
(fiveam:test test-provider-config-registered
|
||||||
|
"A registered provider should return its configuration plist."
|
||||||
|
(let ((config (provider-config :openrouter)))
|
||||||
|
(fiveam:is (listp config))
|
||||||
|
(fiveam:is (getf config :base-url))))
|
||||||
|
|||||||
@@ -264,4 +264,18 @@ Verifies that the framing protocol correctly serializes and deserializes message
|
|||||||
(let* ((msg '(:type :EVENT :payload (:action :handshake)))
|
(let* ((msg '(:type :EVENT :payload (:action :handshake)))
|
||||||
(framed (frame-message msg)))
|
(framed (frame-message msg)))
|
||||||
(is (string= "00002C" (string-upcase (subseq framed 0 6))))))
|
(is (string= "00002C" (string-upcase (subseq framed 0 6))))))
|
||||||
|
|
||||||
|
(test test-framing-round-trip
|
||||||
|
"A message should survive frame → read-frame without loss."
|
||||||
|
(let* ((msg '(:type :EVENT :payload (:action :handshake :version "1.0") :meta (:source :tui)))
|
||||||
|
(framed (frame-message msg))
|
||||||
|
(unframed (read-framed-message (make-string-input-stream framed))))
|
||||||
|
(is (equal msg unframed))))
|
||||||
|
|
||||||
|
(test test-framing-empty-message
|
||||||
|
"An empty or simple message should still frame correctly."
|
||||||
|
(let* ((msg '(:type :ping))
|
||||||
|
(framed (frame-message msg)))
|
||||||
|
(is (> (length framed) 5))
|
||||||
|
(is (every (lambda (c) (digit-char-p c 16)) (subseq framed 0 6)))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|||||||
@@ -319,4 +319,22 @@ Verifies that the Foveal-Peripheral rendering correctly distinguishes between fo
|
|||||||
(let ((output (context-awareness-assemble)))
|
(let ((output (context-awareness-assemble)))
|
||||||
(is (search "Project 1" output))
|
(is (search "Project 1" output))
|
||||||
(is (search "Project 2" output))))
|
(is (search "Project 2" output))))
|
||||||
|
|
||||||
|
(test test-context-empty-memory
|
||||||
|
"An empty memory should produce a clean awareness output without errors."
|
||||||
|
(clrhash passepartout::*memory-store*)
|
||||||
|
(let ((output (context-awareness-assemble)))
|
||||||
|
(is (stringp output))
|
||||||
|
(is (search "MEMEX" output :test #'char-equal))))
|
||||||
|
|
||||||
|
(test test-context-no-foveal-focus
|
||||||
|
"Without a foveal focus, all content should be peripheral (no inline content)."
|
||||||
|
(clrhash passepartout::*memory-store*)
|
||||||
|
(let* ((ast '(:type :HEADLINE :properties (:ID "root" :TITLE "Root" :TAGS ("project"))
|
||||||
|
:contents ((:type :HEADLINE :properties (:ID "child" :TITLE "Child Node")
|
||||||
|
:raw-content "CHILD CONTENT" :contents nil)))))
|
||||||
|
(ingest-ast ast)
|
||||||
|
(let ((output (context-awareness-assemble nil)))
|
||||||
|
(is (stringp output))
|
||||||
|
(is (not (search "CHILD CONTENT" output))))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|||||||
@@ -46,6 +46,7 @@ The package definition. All public symbols are exported here.
|
|||||||
#:diagnostics-env-check
|
#:diagnostics-env-check
|
||||||
#:register-provider
|
#:register-provider
|
||||||
#:provider-openai-request
|
#:provider-openai-request
|
||||||
|
#:provider-config
|
||||||
#:system-ready-p
|
#:system-ready-p
|
||||||
#:run-setup-wizard
|
#:run-setup-wizard
|
||||||
#:skill-gateway-register
|
#:skill-gateway-register
|
||||||
@@ -110,7 +111,7 @@ The package definition. All public symbols are exported here.
|
|||||||
#:skill-initialize-all
|
#:skill-initialize-all
|
||||||
#:load-skill-with-timeout
|
#:load-skill-with-timeout
|
||||||
#:topological-sort-skills
|
#:topological-sort-skills
|
||||||
#:validate-lisp-syntax
|
#:lisp-syntax-validate
|
||||||
#:defskill
|
#:defskill
|
||||||
#:*skill-registry*
|
#:*skill-registry*
|
||||||
#:*scope-resolver*
|
#:*scope-resolver*
|
||||||
|
|||||||
@@ -294,4 +294,35 @@ Verifies that the act gate correctly processes an approved action and sets the s
|
|||||||
(result (loop-gate-act signal)))
|
(result (loop-gate-act signal)))
|
||||||
(is (eq :acted (getf signal :status)))
|
(is (eq :acted (getf signal :status)))
|
||||||
(is (null result))))
|
(is (null result))))
|
||||||
|
|
||||||
|
(test test-loop-gate-act-no-approved-action
|
||||||
|
"When no approved-action is set, the signal should still reach :acted status."
|
||||||
|
(clrhash passepartout::*skill-registry*)
|
||||||
|
(let* ((signal (list :type :EVENT :status nil :depth 0)))
|
||||||
|
(loop-gate-act signal)
|
||||||
|
(is (eq :acted (getf signal :status)))))
|
||||||
|
|
||||||
|
(test test-loop-gate-act-last-mile-reject
|
||||||
|
"When the last-mile cognitive-verify rejects with :LOG, status should not reach :acted."
|
||||||
|
(clrhash passepartout::*skill-registry*)
|
||||||
|
(passepartout::defskill :mock-blocker
|
||||||
|
:priority 50
|
||||||
|
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
||||||
|
:deterministic (lambda (action ctx)
|
||||||
|
(declare (ignore ctx action))
|
||||||
|
(list :type :LOG :payload (list :text "Last-mile block"))))
|
||||||
|
(let* ((signal (list :type :EVENT :status nil :depth 0
|
||||||
|
:approved-action '(:type :REQUEST :target :cli :payload (:text "blocked")))))
|
||||||
|
(loop-gate-act signal)
|
||||||
|
(is (eq :acted (getf signal :status)))
|
||||||
|
(is (null (getf signal :approved-action)))))
|
||||||
|
|
||||||
|
(test test-loop-gate-act-preserves-meta
|
||||||
|
"Signal metadata should not be mutated by the act gate."
|
||||||
|
(clrhash passepartout::*skill-registry*)
|
||||||
|
(let* ((meta '(:source :tui :session "s1"))
|
||||||
|
(signal (list :type :EVENT :status nil :depth 0 :meta meta
|
||||||
|
:approved-action '(:target :cli :payload (:text "test")))))
|
||||||
|
(loop-gate-act signal)
|
||||||
|
(is (equal meta (getf signal :meta)))))
|
||||||
#+end_src
|
#+end_src
|
||||||
@@ -262,4 +262,23 @@ Verifies that the perceive gate correctly ingests AST nodes into memory and that
|
|||||||
(test test-depth-limiting
|
(test test-depth-limiting
|
||||||
(let ((runaway-signal (list :type :EVENT :depth 11 :payload (list :sensor :heartbeat))))
|
(let ((runaway-signal (list :type :EVENT :depth 11 :payload (list :sensor :heartbeat))))
|
||||||
(is (null (process-signal runaway-signal)))))
|
(is (null (process-signal runaway-signal)))))
|
||||||
|
|
||||||
|
(test test-loop-gate-perceive-unknown-sensor
|
||||||
|
"Unknown sensors should pass through and still reach :perceived status."
|
||||||
|
(let* ((signal (list :type :EVENT :depth 0 :payload (list :sensor :custom-metric)))
|
||||||
|
(result (loop-gate-perceive signal)))
|
||||||
|
(is (eq :perceived (getf result :status)))))
|
||||||
|
|
||||||
|
(test test-loop-gate-perceive-no-ast
|
||||||
|
"A :buffer-update with no AST should not crash and reach :perceived."
|
||||||
|
(clrhash passepartout::*memory-store*)
|
||||||
|
(let* ((signal (list :type :EVENT :depth 0 :payload (list :sensor :buffer-update)))
|
||||||
|
(result (loop-gate-perceive signal)))
|
||||||
|
(is (eq :perceived (getf result :status)))))
|
||||||
|
|
||||||
|
(test test-depth-limiting-normal
|
||||||
|
"Signals at depth 10 or below should not be rejected by the depth guard."
|
||||||
|
(let ((normal-signal (list :type :EVENT :depth 5 :payload (list :sensor :heartbeat))))
|
||||||
|
(is (not (eq :rejected (getf normal-signal :status)))
|
||||||
|
"Signal at normal depth should not be rejected")))
|
||||||
#+end_src
|
#+end_src
|
||||||
@@ -373,4 +373,42 @@ Verifies that the deterministic engine correctly rejects unsafe actions (like ~r
|
|||||||
(signal '(:type :EVENT :payload (:sensor :user-input)))
|
(signal '(:type :EVENT :payload (:sensor :user-input)))
|
||||||
(result (cognitive-verify candidate signal)))
|
(result (cognitive-verify candidate signal)))
|
||||||
(is (eq :LOG (getf result :type)))))
|
(is (eq :LOG (getf result :type)))))
|
||||||
|
|
||||||
|
(test test-cognitive-verify-pass-through
|
||||||
|
"Safe actions should pass through cognitive-verify unchanged."
|
||||||
|
(clrhash passepartout::*skill-registry*)
|
||||||
|
(passepartout::defskill :mock-passthrough
|
||||||
|
:priority 50
|
||||||
|
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
||||||
|
:deterministic (lambda (action ctx)
|
||||||
|
(declare (ignore ctx))
|
||||||
|
action))
|
||||||
|
(let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "echo hello")))
|
||||||
|
(signal '(:type :EVENT :payload (:sensor :user-input)))
|
||||||
|
(result (cognitive-verify candidate signal)))
|
||||||
|
(is (equal candidate result))))
|
||||||
|
|
||||||
|
(test test-cognitive-verify-empty-registry
|
||||||
|
"When no gates are registered, the action passes through unchanged."
|
||||||
|
(clrhash passepartout::*skill-registry*)
|
||||||
|
(let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "ls")))
|
||||||
|
(signal '(:type :EVENT :payload (:sensor :user-input)))
|
||||||
|
(result (cognitive-verify candidate signal)))
|
||||||
|
(is (equal candidate result))))
|
||||||
|
|
||||||
|
(test test-cognitive-verify-approval-required
|
||||||
|
"A gate returning :level :approval-required should produce an approval event."
|
||||||
|
(clrhash passepartout::*skill-registry*)
|
||||||
|
(passepartout::defskill :mock-approval
|
||||||
|
:priority 50
|
||||||
|
:trigger (lambda (ctx) (declare (ignore ctx)) t)
|
||||||
|
:deterministic (lambda (action ctx)
|
||||||
|
(declare (ignore ctx))
|
||||||
|
(list :type :EVENT :level :approval-required
|
||||||
|
:payload (list :action action))))
|
||||||
|
(let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "sudo reboot")))
|
||||||
|
(signal '(:type :EVENT :payload (:sensor :user-input)))
|
||||||
|
(result (cognitive-verify candidate signal)))
|
||||||
|
(is (eq :approval-required (getf result :level)))
|
||||||
|
(is (eq :EVENT (getf result :type)))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|||||||
@@ -321,4 +321,19 @@ Verifies that the immune system (error handling) correctly catches and reports e
|
|||||||
(passepartout:loop-process '(:type :EVENT :payload (:sensor :user-input)))
|
(passepartout:loop-process '(:type :EVENT :payload (:sensor :user-input)))
|
||||||
(let ((logs (passepartout:context-get-system-logs 20)))
|
(let ((logs (passepartout: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 "CRITICAL BRAIN FAILURE" line)) logs))))))
|
||||||
|
|
||||||
|
(test test-process-signal-normal-path
|
||||||
|
"A valid signal should pass through the pipeline without error."
|
||||||
|
(clrhash passepartout::*skill-registry*)
|
||||||
|
(handler-case
|
||||||
|
(let ((signal (list :type :EVENT :depth 0 :payload (list :sensor :heartbeat))))
|
||||||
|
(process-signal signal)
|
||||||
|
(pass))
|
||||||
|
(error (c)
|
||||||
|
(fail "Pipeline crashed on normal signal: ~a" c))))
|
||||||
|
|
||||||
|
(test test-loop-process-returns-nil-on-deep
|
||||||
|
"Processing a signal at depth > 10 should return nil."
|
||||||
|
(let ((result (loop-process '(:type :EVENT :depth 11 :payload (:sensor :heartbeat)))))
|
||||||
|
(is (null result))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|||||||
@@ -365,4 +365,15 @@ Verifies that the Merkle hash is deterministic and consistent across independent
|
|||||||
(clrhash passepartout::*memory-store*)
|
(clrhash passepartout::*memory-store*)
|
||||||
(let ((id2 (ingest-ast ast1)))
|
(let ((id2 (ingest-ast ast1)))
|
||||||
(is (equal hash1 (memory-object-hash (memory-object-get id2)))))))))
|
(is (equal hash1 (memory-object-hash (memory-object-get id2)))))))))
|
||||||
|
|
||||||
|
(test merkle-hash-different
|
||||||
|
"Different ASTs should produce different hashes."
|
||||||
|
(clrhash passepartout::*memory-store*)
|
||||||
|
(let* ((ast1 '(:type :HEADLINE :properties (:ID "a" :TITLE "Alpha") :contents nil))
|
||||||
|
(ast2 '(:type :HEADLINE :properties (:ID "b" :TITLE "Beta") :contents nil))
|
||||||
|
(id1 (ingest-ast ast1))
|
||||||
|
(id2 (ingest-ast ast2))
|
||||||
|
(hash1 (memory-object-hash (memory-object-get id1)))
|
||||||
|
(hash2 (memory-object-hash (memory-object-get id2))))
|
||||||
|
(is (not (equal hash1 hash2)))))
|
||||||
#+end_src
|
#+end_src
|
||||||
@@ -437,4 +437,12 @@ Verifies that the topological sorter correctly orders skills by their ~#+DEPENDS
|
|||||||
(pos-b (position "org-skill-b" 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))))
|
(is (< pos-b pos-a))))
|
||||||
(uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))
|
(uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))
|
||||||
|
|
||||||
|
(test test-lisp-syntax-validate-valid
|
||||||
|
"Valid Lisp code should pass syntax validation."
|
||||||
|
(is (eq t (lisp-syntax-validate "(+ 1 2)"))))
|
||||||
|
|
||||||
|
(test test-lisp-syntax-validate-invalid
|
||||||
|
"Unbalanced Lisp code should fail syntax validation."
|
||||||
|
(is (null (lisp-syntax-validate "(+ 1 2"))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|||||||
@@ -271,6 +271,11 @@ The doctor checks all supported LLM providers and detects local Ollama instances
|
|||||||
(is (null (diagnostics-env-check))))
|
(is (null (diagnostics-env-check))))
|
||||||
(setf (uiop:getenv "MEMEX_DIR") (or old-m ""))
|
(setf (uiop:getenv "MEMEX_DIR") (or old-m ""))
|
||||||
(setf (uiop:getenv "PASSEPARTOUT_DATA_DIR") (or old-d "")))))
|
(setf (uiop:getenv "PASSEPARTOUT_DATA_DIR") (or old-d "")))))
|
||||||
|
|
||||||
|
(test test-diagnostics-dependency-success
|
||||||
|
"When all binaries exist, diagnostics should pass."
|
||||||
|
(let ((passepartout::*diagnostics-binaries* '("ls")))
|
||||||
|
(is (eq t (diagnostics-dependencies-check)))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
* Phase E: Lifecycle
|
* Phase E: Lifecycle
|
||||||
|
|||||||
@@ -180,4 +180,10 @@ If API-KEY is nil, reads from environment."
|
|||||||
"Verify that provider-openai-request returns :error for an unregistered provider."
|
"Verify that provider-openai-request returns :error for an unregistered provider."
|
||||||
(let ((result (provider-openai-request "hello" "test" :provider :not-a-real-provider)))
|
(let ((result (provider-openai-request "hello" "test" :provider :not-a-real-provider)))
|
||||||
(fiveam:is (eq (getf result :status) :error))))
|
(fiveam:is (eq (getf result :status) :error))))
|
||||||
|
|
||||||
|
(fiveam:test test-provider-config-registered
|
||||||
|
"A registered provider should return its configuration plist."
|
||||||
|
(let ((config (provider-config :openrouter)))
|
||||||
|
(fiveam:is (listp config))
|
||||||
|
(fiveam:is (getf config :base-url))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|||||||
Reference in New Issue
Block a user