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