diff --git a/lisp/core-communication.lisp b/lisp/core-communication.lisp index bf03342..9adab0c 100644 --- a/lisp/core-communication.lisp +++ b/lisp/core-communication.lisp @@ -147,3 +147,15 @@ (framed (frame-message msg))) (is (> (length framed) 5)) (is (every (lambda (c) (digit-char-p c 16)) (subseq framed 0 6))))) + +(test test-read-framed-message + "Contract 2: read-framed-message decodes a framed message correctly." + (let* ((original '(:type :EVENT :payload (:text "decoded" :id 42))) + (framed (frame-message original)) + (decoded (read-framed-message (make-string-input-stream framed)))) + (is (equal original decoded)))) + +(test test-read-framed-message-eof + "Contract 2: read-framed-message returns :eof on incomplete stream." + (let ((decoded (read-framed-message (make-string-input-stream "000")))) + (is (eq :eof decoded)))) diff --git a/lisp/core-defpackage.lisp b/lisp/core-defpackage.lisp index ebc35b2..9113c2d 100644 --- a/lisp/core-defpackage.lisp +++ b/lisp/core-defpackage.lisp @@ -72,6 +72,7 @@ #:reason-gate #:loop-gate-reason #:cognitive-verify + #:backend-cascade-call #:dispatch-gate #:register-pre-reason-handler #:inject-stimulus diff --git a/lisp/core-loop-reason.lisp b/lisp/core-loop-reason.lisp index 96a923a..ca9fc0d 100644 --- a/lisp/core-loop-reason.lisp +++ b/lisp/core-loop-reason.lisp @@ -251,3 +251,32 @@ sorted by priority (highest first). Returns a rejection plist or the action." (result (cognitive-verify candidate signal))) (is (eq :approval-required (getf result :level))) (is (eq :EVENT (getf result :type))))) + +(test test-loop-gate-reason-passthrough + "Contract 2: non-user-input sensors pass through loop-gate-reason unchanged." + (let* ((signal '(:type :EVENT :payload (:sensor :heartbeat) :meta (:source :system))) + (result (loop-gate-reason signal))) + (is (not (null result))))) + +(test test-loop-gate-reason-sets-status + "Contract 2: loop-gate-reason sets :status on :user-input signals." + (clrhash passepartout::*skill-registry*) + (let* ((signal (list :type :EVENT :payload (list :sensor :user-input :text "test"))) + (result (loop-gate-reason signal))) + (is (member (getf result :status) '(:reasoned :requires-approval))))) + +(test test-backend-cascade-no-backends + "Contract 4: empty cascade returns :LOG failure." + (let ((result (backend-cascade-call "test" :cascade '()))) + (is (eq :LOG (getf result :type))) + (is (search "exhausted" (getf (getf result :payload) :text) :test #'char-equal)))) + +(test test-backend-cascade-with-mock + "Contract 4: backend-cascade-call returns content from first successful backend." + (let ((passepartout::*backend-registry* (make-hash-table :test 'equal))) + (setf (gethash :mock-backend passepartout::*backend-registry*) + (lambda (prompt sp &key model) + (declare (ignore prompt sp model)) + (list :status :success :content "mock-response"))) + (let ((result (backend-cascade-call "hello" :cascade '(:mock-backend)))) + (is (string= "mock-response" result))))) diff --git a/lisp/core-memory.lisp b/lisp/core-memory.lisp index c6a9aca..0acea25 100644 --- a/lisp/core-memory.lisp +++ b/lisp/core-memory.lisp @@ -176,3 +176,31 @@ (hash1 (memory-object-hash (memory-object-get id1))) (hash2 (memory-object-hash (memory-object-get id2)))) (is (not (equal hash1 hash2))))) + +(test test-ingest-ast-returns-id + "Contract 1: ingest-ast returns a string ID and stores the object." + (clrhash passepartout::*memory-store*) + (let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "ingest-test" :TITLE "Test Node") :contents nil)))) + (is (stringp id)) + (is (not (null id))))) + +(test test-memory-object-get + "Contract 3: memory-object-get retrieves an object by ID after ingest." + (clrhash passepartout::*memory-store*) + (let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "get-test" :TITLE "Retrieve Me") :contents nil)))) + (let ((obj (memory-object-get id))) + (is (not (null obj))) + (is (eq :HEADLINE (memory-object-type obj))) + (is (string= "Retrieve Me" (getf (memory-object-attributes obj) :TITLE)))))) + +(test test-snapshot-and-rollback + "Contract 4+5: snapshot-memory saves state; rollback-memory restores it." + (clrhash passepartout::*memory-store*) + (setf passepartout::*memory-snapshots* nil) + (ingest-ast '(:type :HEADLINE :properties (:ID "snap-a" :TITLE "Pre-snapshot") :contents nil)) + (snapshot-memory) + (clrhash passepartout::*memory-store*) + (ingest-ast '(:type :HEADLINE :properties (:ID "snap-b" :TITLE "Post-snapshot") :contents nil)) + (rollback-memory 0) + (is (not (null (memory-object-get "snap-a")))) + (is (null (memory-object-get "snap-b")))) diff --git a/org/core-communication.org b/org/core-communication.org index 2176184..2178971 100644 --- a/org/core-communication.org +++ b/org/core-communication.org @@ -289,4 +289,16 @@ Verifies that the framing protocol correctly serializes and deserializes message (framed (frame-message msg))) (is (> (length framed) 5)) (is (every (lambda (c) (digit-char-p c 16)) (subseq framed 0 6))))) + +(test test-read-framed-message + "Contract 2: read-framed-message decodes a framed message correctly." + (let* ((original '(:type :EVENT :payload (:text "decoded" :id 42))) + (framed (frame-message original)) + (decoded (read-framed-message (make-string-input-stream framed)))) + (is (equal original decoded)))) + +(test test-read-framed-message-eof + "Contract 2: read-framed-message returns :eof on incomplete stream." + (let ((decoded (read-framed-message (make-string-input-stream "000")))) + (is (eq :eof decoded)))) #+end_src diff --git a/org/core-defpackage.org b/org/core-defpackage.org index e116df4..a2320ea 100644 --- a/org/core-defpackage.org +++ b/org/core-defpackage.org @@ -97,6 +97,7 @@ The package definition. All public symbols are exported here. #:reason-gate #:loop-gate-reason #:cognitive-verify + #:backend-cascade-call #:dispatch-gate #:register-pre-reason-handler #:inject-stimulus diff --git a/org/core-loop-reason.org b/org/core-loop-reason.org index bcf63cf..d096984 100644 --- a/org/core-loop-reason.org +++ b/org/core-loop-reason.org @@ -428,4 +428,33 @@ Verifies that the deterministic engine correctly rejects unsafe actions (like ~r (result (cognitive-verify candidate signal))) (is (eq :approval-required (getf result :level))) (is (eq :EVENT (getf result :type))))) + +(test test-loop-gate-reason-passthrough + "Contract 2: non-user-input sensors pass through loop-gate-reason unchanged." + (let* ((signal '(:type :EVENT :payload (:sensor :heartbeat) :meta (:source :system))) + (result (loop-gate-reason signal))) + (is (not (null result))))) + +(test test-loop-gate-reason-sets-status + "Contract 2: loop-gate-reason sets :status on :user-input signals." + (clrhash passepartout::*skill-registry*) + (let* ((signal (list :type :EVENT :payload (list :sensor :user-input :text "test"))) + (result (loop-gate-reason signal))) + (is (member (getf result :status) '(:reasoned :requires-approval))))) + +(test test-backend-cascade-no-backends + "Contract 4: empty cascade returns :LOG failure." + (let ((result (backend-cascade-call "test" :cascade '()))) + (is (eq :LOG (getf result :type))) + (is (search "exhausted" (getf (getf result :payload) :text) :test #'char-equal)))) + +(test test-backend-cascade-with-mock + "Contract 4: backend-cascade-call returns content from first successful backend." + (let ((passepartout::*backend-registry* (make-hash-table :test 'equal))) + (setf (gethash :mock-backend passepartout::*backend-registry*) + (lambda (prompt sp &key model) + (declare (ignore prompt sp model)) + (list :status :success :content "mock-response"))) + (let ((result (backend-cascade-call "hello" :cascade '(:mock-backend)))) + (is (string= "mock-response" result))))) #+end_src diff --git a/org/core-memory.org b/org/core-memory.org index 5f8bf88..b538dd7 100644 --- a/org/core-memory.org +++ b/org/core-memory.org @@ -388,4 +388,32 @@ Verifies that the Merkle hash is deterministic and consistent across independent (hash1 (memory-object-hash (memory-object-get id1))) (hash2 (memory-object-hash (memory-object-get id2)))) (is (not (equal hash1 hash2))))) + +(test test-ingest-ast-returns-id + "Contract 1: ingest-ast returns a string ID and stores the object." + (clrhash passepartout::*memory-store*) + (let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "ingest-test" :TITLE "Test Node") :contents nil)))) + (is (stringp id)) + (is (not (null id))))) + +(test test-memory-object-get + "Contract 3: memory-object-get retrieves an object by ID after ingest." + (clrhash passepartout::*memory-store*) + (let ((id (ingest-ast '(:type :HEADLINE :properties (:ID "get-test" :TITLE "Retrieve Me") :contents nil)))) + (let ((obj (memory-object-get id))) + (is (not (null obj))) + (is (eq :HEADLINE (memory-object-type obj))) + (is (string= "Retrieve Me" (getf (memory-object-attributes obj) :TITLE)))))) + +(test test-snapshot-and-rollback + "Contract 4+5: snapshot-memory saves state; rollback-memory restores it." + (clrhash passepartout::*memory-store*) + (setf passepartout::*memory-snapshots* nil) + (ingest-ast '(:type :HEADLINE :properties (:ID "snap-a" :TITLE "Pre-snapshot") :contents nil)) + (snapshot-memory) + (clrhash passepartout::*memory-store*) + (ingest-ast '(:type :HEADLINE :properties (:ID "snap-b" :TITLE "Post-snapshot") :contents nil)) + (rollback-memory 0) + (is (not (null (memory-object-get "snap-a")))) + (is (null (memory-object-get "snap-b")))) #+end_src \ No newline at end of file diff --git a/org/gateway-tui-main.org b/org/gateway-tui-main.org index e740f5a..044b5f9 100644 --- a/org/gateway-tui-main.org +++ b/org/gateway-tui-main.org @@ -213,7 +213,7 @@ Event handlers + daemon I/O + main loop. (fiveam:in-suite tui-suite) (fiveam:test test-tui-connection-drop - "Tier 2 Chaos: Verify that handle-return degrades gracefully when the daemon connection is lost." + "Contract 4: handle-return enqueues error on connection loss." (let ((passepartout.gateway-tui::*incoming-msgs* nil) (passepartout.gateway-tui::*input-buffer* (make-array 5 :element-type 'character :initial-contents "hello" :fill-pointer 5 :adjustable t)) (mock-stream (make-string-output-stream))) diff --git a/org/system-model-provider.org b/org/system-model-provider.org index b91ff37..02153f2 100644 --- a/org/system-model-provider.org +++ b/org/system-model-provider.org @@ -189,12 +189,12 @@ If API-KEY is nil, reads from environment." (fiveam:in-suite llm-gateway-suite) (fiveam:test test-provider-rejects-bad-keyword - "Edge: provider-openai-request returns :error for unregistered provider." + "Contract 3: provider-openai-request returns :error for unregistered provider." (let ((result (provider-openai-request "hello" "test" :provider :not-a-real-provider))) (fiveam:is (eq (getf result :status) :error)))) (fiveam:test test-provider-config-registered - "Contract: provider-config returns configuration plist for registered provider." + "Contract 1: provider-config returns configuration plist for registered provider." (let ((config (provider-config :openrouter))) (fiveam:is (listp config)) (fiveam:is (getf config :base-url))))