docs: add Contract sections + tag tests to contract items (Tier 2 — 10 files)

lisp/core-communication.lisp

@@ -129,19 +129,20 @@
 (in-suite communication-protocol-suite)
 
 (test test-framing
+  "Contract 1: frame-message produces correct hex length prefix."
   (let* ((msg '(:type :EVENT :payload (:action :handshake)))
          (framed (frame-message msg)))
     (is (string= "00002C" (string-upcase (subseq framed 0 6))))))
 
 (test test-framing-round-trip
-  "A message should survive frame → read-frame without loss."
+  "Contract 3: frame → read-frame preserves message identity."
   (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."
+  "Contract 1: simple messages frame with valid hex length."
   (let* ((msg '(:type :ping))
          (framed (frame-message msg)))
     (is (> (length framed) 5))

lisp/core-context.lisp

@@ -166,6 +166,7 @@ Privacy-filtered objects (matching bouncer-privacy-tags) are excluded."
 (in-suite vision-suite)
 
 (test test-foveal-rendering
+  "Contract 1: foveal content inline, peripheral content title-only."
   (clrhash passepartout::*memory-store*)
   (let* ((ast '(:type :HEADLINE :properties (:ID "proj-root" :TITLE "Project" :TAGS ("project"))
                 :contents ((:type :HEADLINE :properties (:ID "node-foveal" :TITLE "Foveal Node")
@@ -179,6 +180,7 @@ Privacy-filtered objects (matching bouncer-privacy-tags) are excluded."
       (is (not (search "PERIPHERAL CONTENT" output))))))
 
 (test test-awareness-budget
+  "Contract 1: all active projects appear in awareness output."
   (clrhash passepartout::*memory-store*)
   (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))
@@ -187,14 +189,14 @@ Privacy-filtered objects (matching bouncer-privacy-tags) are excluded."
     (is (search "Project 2" output))))
 
 (test test-context-empty-memory
-  "An empty memory should produce a clean awareness output without errors."
+  "Contract 1: empty memory produces clean output without error."
   (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)."
+  "Contract 2: without foveal focus, no inline content appears."
   (clrhash passepartout::*memory-store*)
   (let* ((ast '(:type :HEADLINE :properties (:ID "root" :TITLE "Root" :TAGS ("project"))
                 :contents ((:type :HEADLINE :properties (:ID "child" :TITLE "Child Node")

lisp/core-loop-act.lisp

@@ -173,6 +173,7 @@ For approval-required actions, creates a Flight Plan instead of executing."
 (in-suite pipeline-act-suite)
 
 (test test-loop-gate-act-basic
+  "Contract 1: approved action reaches :acted status via loop-gate-act."
   (clrhash passepartout::*skill-registry*)
   (let* ((signal (list :type :EVENT :status nil :depth 0 :approved-action '(:target :cli :payload (:text "Hello"))))
           (result (loop-gate-act signal)))
@@ -180,14 +181,14 @@ For approval-required actions, creates a Flight Plan instead of executing."
     (is (null result))))
 
 (test test-loop-gate-act-no-approved-action
-  "When no approved-action is set, the signal should still reach :acted status."
+  "Contract 1: signal with no approved-action still reaches :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."
+  "Contract 1: last-mile cognitive-verify rejection blocks approved-action."
   (clrhash passepartout::*skill-registry*)
   (passepartout::defskill :mock-blocker
     :priority 50
@@ -202,7 +203,7 @@ For approval-required actions, creates a Flight Plan instead of executing."
     (is (null (getf signal :approved-action)))))
 
 (test test-loop-gate-act-preserves-meta
-  "Signal metadata should not be mutated by the act gate."
+  "Contract 1: signal metadata is not mutated by loop-gate-act."
   (clrhash passepartout::*skill-registry*)
   (let* ((meta '(:source :tui :session "s1"))
          (signal (list :type :EVENT :status nil :depth 0 :meta meta

lisp/core-loop-perceive.lisp

@@ -123,6 +123,7 @@ FN receives (signal) and returns T if consumed, nil to continue."
 (in-suite pipeline-perceive-suite)
 
 (test test-loop-gate-perceive
+  "Contract 1: :buffer-update ingests AST and sets :perceived status."
   (clrhash passepartout::*memory-store*)
   (let* ((signal (list :type :EVENT :payload (list :sensor :buffer-update :ast (list :type :HEADLINE :properties (list :ID "test-node" :TITLE "Test") :contents nil))))
          (result (loop-gate-perceive signal)))
@@ -130,24 +131,25 @@ FN receives (signal) and returns T if consumed, nil to continue."
     (is (not (null (gethash "test-node" passepartout::*memory-store*))))))
 
 (test test-depth-limiting
+  "Edge: depth 11 signals are rejected by the pipeline."
   (let ((runaway-signal (list :type :EVENT :depth 11 :payload (list :sensor :heartbeat))))
     (is (null (process-signal runaway-signal)))))
 
 (test test-loop-gate-perceive-unknown-sensor
-  "Unknown sensors should pass through and still reach :perceived status."
+  "Contract 1: unknown sensors pass through and reach :perceived."
   (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."
+  "Contract 1: :buffer-update without AST doesn't crash, reaches :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."
+  "Contract 1: signals at normal depth pass through without rejection."
   (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")))

lisp/core-loop-reason.lisp

@@ -199,6 +199,7 @@ sorted by priority (highest first). Returns a rejection plist or the action."
 (in-suite pipeline-reason-suite)
 
 (test test-decide-gate-safety
+  "Contract 1: cognitive-verify blocks unsafe actions with :LOG rejection."
   (clrhash passepartout::*skill-registry*)
   (passepartout::defskill :mock-safety
     :priority 50
@@ -214,7 +215,7 @@ sorted by priority (highest first). Returns a rejection plist or the action."
     (is (eq :LOG (getf result :type)))))
 
 (test test-cognitive-verify-pass-through
-  "Safe actions should pass through cognitive-verify unchanged."
+  "Contract 1: safe actions pass through cognitive-verify unchanged."
   (clrhash passepartout::*skill-registry*)
   (passepartout::defskill :mock-passthrough
     :priority 50
@@ -228,7 +229,7 @@ sorted by priority (highest first). Returns a rejection plist or the action."
     (is (equal candidate result))))
 
 (test test-cognitive-verify-empty-registry
-  "When no gates are registered, the action passes through unchanged."
+  "Contract 1: with no gates registered, action passes through unchanged."
   (clrhash passepartout::*skill-registry*)
   (let* ((candidate '(:type :REQUEST :payload (:action :shell :cmd "ls")))
          (signal '(:type :EVENT :payload (:sensor :user-input)))
@@ -236,7 +237,7 @@ sorted by priority (highest first). Returns a rejection plist or the action."
     (is (equal candidate result))))
 
 (test test-cognitive-verify-approval-required
-  "A gate returning :level :approval-required should produce an approval event."
+  "Contract 1: gate returning :approval-required produces an approval event."
   (clrhash passepartout::*skill-registry*)
   (passepartout::defskill :mock-approval
     :priority 50

lisp/core-loop.lisp

@@ -152,7 +152,7 @@
 (in-suite immune-suite)
 
 (test loop-error-injection
-  "Verify that a crash in think/decide triggers a :loop-error stimulus."
+  "Contract 1: a crash in think/decide triggers :loop-error stimulus."
   (clrhash passepartout::*skill-registry*)
   (passepartout:defskill :evil-skill
     :priority 100
@@ -164,7 +164,7 @@
     (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."
+  "Contract 1: a valid signal passes through the pipeline without crash."
   (clrhash passepartout::*skill-registry*)
   (handler-case
       (let ((signal (list :type :EVENT :depth 0 :payload (list :sensor :heartbeat))))
@@ -174,6 +174,6 @@
       (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."
+  "Contract 1: depth > 10 returns nil from loop-process."
   (let ((result (loop-process '(:type :EVENT :depth 11 :payload (:sensor :heartbeat)))))
     (is (null result))))

lisp/core-memory.lisp

@@ -157,6 +157,7 @@
 (in-suite memory-suite)
 
 (test merkle-hash-consistency
+  "Contract 2: identical ASTs produce identical Merkle hashes."
   (let* ((ast1 '(:type :HEADLINE :properties (:ID "test-1" :TITLE "Node 1") :contents nil)))
     (clrhash passepartout::*memory-store*)
     (let ((id1 (ingest-ast ast1)))
@@ -166,7 +167,7 @@
           (is (equal hash1 (memory-object-hash (memory-object-get id2)))))))))
 
 (test merkle-hash-different
-  "Different ASTs should produce different hashes."
+  "Contract 2: distinct ASTs produce different Merkle 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))

lisp/core-skills.lisp

@@ -295,6 +295,7 @@
 (in-suite boot-suite)
 
 (test test-topological-sort-basic
+  "Contract 2: dependency ordering puts dependencies before dependents."
   (let ((tmp-dir "/tmp/passepartout-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)
@@ -309,9 +310,9 @@
        (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."
+  "Contract 1: valid Lisp code passes syntax validation."
   (is (eq t (lisp-syntax-validate "(+ 1 2)"))))
 
 (test test-lisp-syntax-validate-invalid
-  "Unbalanced Lisp code should fail syntax validation."
+  "Contract 1: unbalanced Lisp code fails syntax validation."
   (is (null (lisp-syntax-validate "(+ 1 2"))))

lisp/system-diagnostics.lisp

@@ -185,12 +185,12 @@
 (in-suite diagnostics-suite)
 
 (test test-diagnostics-dependency-fail
-  "Verify that missing binaries are correctly identified as failures."
+  "Contract 1: missing binaries cause diagnostics-dependencies-check to return nil."
   (let ((passepartout::*diagnostics-binaries* '("non-existent-binary-123")))
     (is (null (diagnostics-dependencies-check)))))
 
 (test test-diagnostics-env-fail
-  "Verify that an invalid MEMEX_DIR triggers a critical failure."
+  "Contract 2: invalid MEMEX_DIR causes diagnostics-env-check to return nil."
   (let ((old-m (uiop:getenv "MEMEX_DIR"))
         (old-d (uiop:getenv "PASSEPARTOUT_DATA_DIR")))
     (unwind-protect
@@ -201,7 +201,7 @@
       (setf (uiop:getenv "PASSEPARTOUT_DATA_DIR") (or old-d "")))))
 
 (test test-diagnostics-dependency-success
-  "When all binaries exist, diagnostics should pass."
+  "Contract 1: all binaries present returns T."
   (let ((passepartout::*diagnostics-binaries* '("ls")))
     (is (eq t (diagnostics-dependencies-check)))))
 

lisp/system-model-provider.lisp

@@ -130,12 +130,12 @@ If API-KEY is nil, reads from environment."
 (fiveam:in-suite llm-gateway-suite)
 
 (fiveam:test test-provider-rejects-bad-keyword
-  "Verify that provider-openai-request returns :error for an unregistered provider."
+  "Edge: 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
-  "A registered provider should return its configuration plist."
+  "Contract: provider-config returns configuration plist for registered provider."
   (let ((config (provider-config :openrouter)))
     (fiveam:is (listp config))
     (fiveam:is (getf config :base-url))))