tests: close 10 high-priority contract gaps (loop-gate-reason, backend-cascade-call, read-framed-message, snapshot/rollback, ingest-ast, memory-object-get)

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))))

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

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)))))

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"))))

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

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

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

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

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)))

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))))