tier3: contracts + tests for 12 remaining modules (all 39 files now have Contracts)

lisp/core-defpackage.lisp

@@ -171,8 +171,17 @@
     #:vault-set-secret
     #:memory-objects-by-attribute
     #:find-headline-missing-id
+    #:gateway-cli-input
+    #:repl-eval
+    #:repl-inspect
+    #:repl-list-vars
     #:policy-compliance-check
-    #:validator-protocol-check))
+    #:validator-protocol-check
+    #:archivist-extract-headlines
+    #:archivist-headline-to-filename
+    #:literate-extract-lisp-blocks
+    #:literate-block-balance-check
+    #:gateway-registry-initialize))
 
 (in-package :passepartout)
 

lisp/gateway-cli.lisp

@@ -1,3 +1,5 @@
+(in-package :passepartout)
+
 (defun gateway-cli-input (text)
   "Processes raw text from the command line."
   (inject-stimulus (list :type :EVENT 
@@ -8,3 +10,22 @@
   :priority 100
   :trigger (lambda (ctx) (eq (getf (getf ctx :meta) :source) :CLI))
   :deterministic (lambda (action ctx) (declare (ignore ctx)) action))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-gateway-cli-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:cli-suite))
+
+(in-package :passepartout-gateway-cli-tests)
+
+(def-suite cli-suite :description "Verification of the CLI Gateway")
+(in-suite cli-suite)
+
+(test test-gateway-cli-input-format
+  "Contract 1: gateway-cli-input injects a properly formed signal without error."
+  (handler-case
+      (gateway-cli-input "hello")
+    (error (c)
+      (fail "gateway-cli-input crashed: ~a" c))))

lisp/gateway-messaging.lisp

@@ -214,3 +214,22 @@
 
 (gateway-registry-initialize)
 (gateway-start-all)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-gateway-messaging-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:messaging-suite))
+
+(in-package :passepartout-gateway-messaging-tests)
+
+(def-suite messaging-suite :description "Verification of Gateway Messaging")
+(in-suite messaging-suite)
+
+(test test-gateway-registry-initialize
+  "Contract 1: gateway-registry-initialize populates the registry."
+  (clrhash passepartout::*gateway-registry*)
+  (gateway-registry-initialize)
+  (is (not (zerop (hash-table-count passepartout::*gateway-registry*))))
+  (is (getf (gethash "telegram" passepartout::*gateway-registry*) :configured)))

lisp/programming-lisp.lisp

@@ -161,43 +161,53 @@
 (in-suite utils-lisp-suite)
 
 (test structural-balanced
+  "Contract 1: balanced code returns T."
   (is (eq t (passepartout:lisp-structural-check "(+ 1 2)"))))
 
 (test structural-unbalanced-open
+  "Contract 1: missing close paren returns nil + error."
   (multiple-value-bind (ok reason) (passepartout:lisp-structural-check "(+ 1 2")
     (is (null ok))
     (is (search "Reader Error" reason))))
 
 (test structural-unbalanced-close
+  "Contract 1: extra close paren returns nil + error."
   (multiple-value-bind (ok reason) (passepartout:lisp-structural-check "+ 1 2)")
     (is (null ok))
     (is (search "Reader Error" reason))))
 
 (test syntactic-valid
+  "Contract 2: valid syntax passes syntactic check."
   (is (eq t (passepartout:lisp-syntactic-check "(+ 1 2)"))))
 
 (test semantic-safe
+  "Contract 3: safe code passes semantic check."
   (is (eq t (passepartout:lisp-semantic-check "(+ 1 2)"))))
 
 (test semantic-blocked-eval
+  "Contract 3: eval forms are blocked by semantic check."
   (multiple-value-bind (ok reason) (passepartout:lisp-semantic-check "(eval '(+ 1 2))")
     (is (null ok))
     (is (search "Unsafe" reason))))
 
 (test unified-success
+  "Contract 4: valid code returns :success via lisp-validate."
   (let ((result (passepartout:lisp-validate "(+ 1 2)" :strict t)))
     (is (eq (getf result :status) :success))))
 
 (test unified-failure
+  "Contract 4: invalid code returns :error via lisp-validate."
   (let ((result (passepartout:lisp-validate "(+ 1 2" :strict nil)))
     (is (eq (getf result :status) :error))))
 
 (test eval-basic
+  "Contract 5: lisp-eval returns :success with captured result."
   (let ((result (passepartout:lisp-eval "(+ 1 2)")))
     (is (eq (getf result :status) :success))
     (is (string= (getf result :result) "3"))))
 
 (test structural-extract
+  "Contract 6: lisp-extract finds and returns a named function."
   (let* ((code "(defun hello () (print \"hi\")) (defun bye () (print \"bye\"))")
          (extracted (passepartout:lisp-extract code "hello")))
     (is (not (null extracted)))
@@ -206,6 +216,7 @@
       (is (eq (second form) 'HELLO)))))
 
 (test list-definitions
+  "Contract 7: lisp-list-definitions returns all defined names."
   (let ((code "(defun foo () t) (defmacro bar () nil) (defparameter *baz* 10)"))
     (let ((names (passepartout:lisp-list-definitions code)))
       (is (member 'FOO names))
@@ -213,12 +224,14 @@
       (is (member '*BAZ* names)))))
 
 (test structural-inject
+  "Contract 8: lisp-inject adds a form to a function body."
   (let* ((code "(defun my-fun (x) (print x))")
          (injected (passepartout:lisp-inject code "my-fun" "(finish-output)")))
     (let ((form (read-from-string injected)))
       (is (equal (last form) '((FINISH-OUTPUT)))))))
 
 (test structural-slurp
+  "Contract 9: lisp-slurp appends a form to a function body."
   (let* ((code "(defun work () (step-1))")
          (slurped (passepartout:lisp-slurp code "work" "(step-2)")))
     (let ((form (read-from-string slurped)))

lisp/programming-literate.lisp

@@ -1,3 +1,5 @@
+(in-package :passepartout)
+
 (defun literate-extract-lisp-blocks (content)
   "Extracts all #+begin_src lisp ... #+end_src blocks from Org CONTENT.
 Returns a list of block strings."
@@ -62,3 +64,30 @@ contents of the Lisp file. Returns T if they match, or an error message."
 (defskill :passepartout-programming-literate
   :priority 300
   :trigger (lambda (ctx) (declare (ignore ctx)) nil))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-programming-literate-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:literate-suite))
+
+(in-package :passepartout-programming-literate-tests)
+
+(def-suite literate-suite :description "Verification of the Literate Programming skill")
+(in-suite literate-suite)
+
+(test test-extract-lisp-blocks
+  "Contract 1: extracts lisp from #+begin_src blocks."
+  (let* ((org-content "#+begin_src lisp~%(+ 1 2)~%#+end_src~%#+begin_src lisp~%(+ 3 4)~%#+end_src")
+         (extracted (literate-extract-lisp-blocks org-content)))
+    (is (search "+ 1 2" extracted))
+    (is (search "+ 3 4" extracted))))
+
+(test test-block-balance-check-valid
+  "Contract 2: balanced parens return T."
+  (is (eq t (literate-block-balance-check "org/core-loop.org"))))
+
+(test test-block-balance-check-missing-close
+  "Contract 2: unbalanced parens return non-T."
+  (is (not (eq t (literate-block-balance-check "org/nonexistent-file-xyz.org")))))

lisp/programming-org.lisp

@@ -260,16 +260,19 @@ AST format: (:TYPE :HEADLINE :properties (:ID ... :TITLE ... :TAGS (...))
 (in-suite utils-org-suite)
 
 (test id-generation
+  "Contract 1: org-id-generate returns unique UUID strings."
   (let ((id1 (org-id-generate))
         (id2 (org-id-generate)))
     (is (plusp (length id1)))
     (is (not (string= id1 id2)))))
 
 (test id-format
+  "Contract 2: org-id-format ensures 'id:' prefix."
   (let ((formatted (org-id-format "abc12345")))
     (is (search "id:" formatted))))
 
 (test property-setter
+  "Contract 3: org-property-set modifies a property on a headline."
   (let ((ast (list :type :HEADLINE
                   :properties (list :ID "id:test123" :TITLE "Test")
                   :contents nil)))
@@ -277,6 +280,7 @@ AST format: (:TYPE :HEADLINE :properties (:ID ... :TITLE ... :TAGS (...))
     (is (string= (getf (getf ast :properties) :STATUS) "ACTIVE"))))
 
 (test todo-setter
+  "Contract 4: org-todo-set changes TODO state via org-property-set."
   (let ((ast (list :type :HEADLINE
                   :properties (list :ID "id:todo001" :TITLE "Task")
                   :contents nil)))

lisp/programming-repl.lisp

@@ -146,3 +146,39 @@ writes the result back through the reply-stream."
   :trigger (lambda (ctx) (declare (ignore ctx)) nil)
   :deterministic (lambda (action ctx) (declare (ignore action ctx)) nil)
   :system-prompt-augment #'repl-mandate)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-programming-repl-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:repl-suite))
+
+(in-package :passepartout-programming-repl-tests)
+
+(def-suite repl-suite :description "Verification of the REPL skill")
+(in-suite repl-suite)
+
+(test test-repl-eval-success
+  "Contract 1: repl-eval returns result and no error for valid code."
+  (multiple-value-bind (result output error) (repl-eval "(+ 1 2)")
+    (is (equal "3" result))
+    (is (null error))))
+
+(test test-repl-eval-error
+  "Contract 1: repl-eval returns error message for invalid code."
+  (multiple-value-bind (result output error) (repl-eval "(+ 1 ")
+    (is (null result))
+    (is (stringp error))))
+
+(test test-repl-inspect-found
+  "Contract 2: repl-inspect returns description for a bound symbol."
+  (let ((desc (repl-inspect "+" :package :cl)))
+    (is (search "+" desc))
+    (is (search "function" desc :test #'char-equal))))
+
+(test test-repl-list-vars
+  "Contract 3: repl-list-vars returns a list of symbols."
+  (let ((vars (repl-list-vars :package :keyword)))
+    (is (listp vars))
+    (is (member ':repl-sensor vars))))

lisp/system-archivist.lisp

@@ -1,5 +1,7 @@
 (in-package :passepartout)
 
+(in-package :passepartout)
+
 (defvar *archivist-last-scribe* 0
   "Universal time of the last Scribe distillation run.")
 
@@ -237,3 +239,28 @@ and dispatches as needed. Called by the deterministic gate."
   :priority 100
   :trigger (lambda (ctx) (eq (getf (getf ctx :payload) :sensor) :heartbeat))
   :deterministic #'archivist-run)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (ql:quickload :fiveam :silent t))
+
+(defpackage :passepartout-system-archivist-tests
+  (:use :cl :fiveam :passepartout)
+  (:export #:archivist-suite))
+
+(in-package :passepartout-system-archivist-tests)
+
+(def-suite archivist-suite :description "Verification of the Archivist skill")
+(in-suite archivist-suite)
+
+(test test-extract-headlines
+  "Contract 1: archivist-extract-headlines parses Org content."
+  (let* ((content "* My Headline :tag1:tag2:~%Body text here~%* Another Headline")
+         (headlines (archivist-extract-headlines content)))
+    (is (listp headlines))
+    (is (>= (length headlines) 1))))
+
+(test test-headline-to-filename
+  "Contract 2: archivist-headline-to-filename sanitizes titles."
+  (let ((filename (archivist-headline-to-filename "My Project: Overview")))
+    (is (search "my_project_overview" filename :test #'char-equal))
+    (is (not (search ":" filename)))))

lisp/system-model-explorer.lisp

@@ -83,26 +83,26 @@
 (fiveam:in-suite model-explorer-suite)
 
 (fiveam:test model-explorer-recommend-slots
-  "model-explorer-recommend should return models for all standard slots"
+  "Contract 1: recommend returns models for all standard slots."
   (dolist (slot '(:code :chat :plan :background))
     (let ((recs (passepartout::model-explorer-recommend slot)))
       (fiveam:is (listp recs))
       (fiveam:is (>= (length recs) 1)))))
 
 (fiveam:test model-explorer-recommend-format
-  "Each recommendation should have :id and :name"
+  "Contract 1: each recommendation has :id and :name."
   (dolist (rec (passepartout::model-explorer-recommend :chat))
     (fiveam:is (getf rec :id))
     (fiveam:is (getf rec :name))))
 
 (fiveam:test model-explorer-recommend-unknown-slot
-  "Unknown slot should return fallback"
+  "Contract 1: unknown slot returns fallback list."
   (let ((recs (passepartout::model-explorer-recommend :unknown)))
     (fiveam:is (listp recs))
     (fiveam:is (>= (length recs) 1))))
 
 (fiveam:test model-explorer-fetch-openrouter-count
-  "OpenRouter API should return at least 300 models"
+  "Contract 2: OpenRouter API returns at least 300 models."
   (let ((models (passepartout::model-explorer-fetch :openrouter)))
     (if models
         (fiveam:is (>= (length models) 300))