tests: close remaining contract gaps (action-dispatch, org-headline-add/find-by-id, tangle-sync, create-note, messaging-link/unlink)

lisp/core-defpackage.lisp

@@ -89,6 +89,7 @@
     #:wildcard-match
     #:actuator-initialize
    #:dispatch-action
+   #:action-dispatch
    #:register-actuator
    #:load-skill-from-org
     #:skill-initialize-all
@@ -123,6 +124,10 @@
     #:org-read-file
     #:org-write-file
     #:org-headline-add
+    #:org-headline-find-by-id
+    #:literate-tangle-sync-check
+    #:archivist-create-note
+    #:gateway-start
     #:org-property-set
     #:org-todo-set
     #:org-find-headline-by-id

lisp/core-loop-act.lisp

@@ -210,3 +210,10 @@ For approval-required actions, creates a Flight Plan instead of executing."
                         :approved-action '(:target :cli :payload (:text "test")))))
     (loop-gate-act signal)
     (is (equal meta (getf signal :meta)))))
+
+(test test-action-dispatch-routes
+  "Contract 3: action-dispatch routes to registered actuators without crashing."
+  (actuator-initialize)
+  (let ((result (action-dispatch '(:type :REQUEST :target :system :payload (:action :eval :code "(+ 1 2)"))
+                                  '(:type :EVENT :depth 0))))
+    (is (numberp result) "eval should return a number")))

lisp/programming-literate.lisp

@@ -91,3 +91,9 @@ contents of the Lisp file. Returns T if they match, or an error message."
 (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")))))
+
+(test test-tangle-sync-check
+  "Contract 3: literate-tangle-sync-check verifies org matches tangled lisp."
+  (let ((result (literate-tangle-sync-check "org/core-loop.org" "lisp/core-loop.lisp")))
+    (is (or (eq t result) (stringp result))
+        "Should return T or a mismatch description")))

lisp/programming-org.lisp

@@ -286,3 +286,23 @@ AST format: (:TYPE :HEADLINE :properties (:ID ... :TITLE ... :TAGS (...))
                   :contents nil)))
     (org-todo-set ast "id:todo001" "DONE")
     (is (string= (getf (getf ast :properties) :TODO) "DONE"))))
+
+(test test-org-headline-add
+  "Contract 5: org-headline-add inserts a child headline."
+  (let* ((ast (list :type :HEADLINE
+                   :properties (list :ID "root" :TITLE "Root")
+                   :contents nil)))
+    (is (eq t (org-headline-add ast "root" "New Child")))
+    (is (= 1 (length (getf ast :contents))))
+    (is (string= "New Child" (getf (getf (first (getf ast :contents)) :properties) :TITLE)))))
+
+(test test-org-headline-find-by-id
+  "Contract 6: org-headline-find-by-id finds a headline by ID."
+  (let ((ast (list :type :HEADLINE :properties (list :ID "root" :TITLE "Root")
+                   :contents (list (list :type :HEADLINE :properties (list :ID "child1" :TITLE "Child"))
+                                  (list :type :HEADLINE :properties (list :ID "child2" :TITLE "Child 2")))))))
+    (let ((found (org-headline-find-by-id ast "child2")))
+      (is (not (null found)))
+      (is (string= "Child 2" (getf (getf found :properties) :TITLE))))
+    (let ((missing (org-headline-find-by-id ast "nonexistent")))
+      (is (null missing) "Missing ID should return nil"))))

lisp/system-archivist.lisp

@@ -263,4 +263,17 @@ and dispatches as needed. Called by the deterministic gate."
   "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)))))
+    (is (not (search ":" filename))))
+
+(test test-archivist-create-note
+  "Contract 3: archivist-create-note writes a Zettelkasten note to disk."
+  (let* ((tmp-dir "/tmp/passepartout-archivist-test/")
+         (headline (list :title "Test Note" :content "Some content" :tags '("test" "atomic"))))
+    (uiop:ensure-all-directories-exist (list tmp-dir))
+    (unwind-protect
+         (progn
+           (is (eq t (archivist-create-note headline tmp-dir "/tmp/source.org"))
+               "Expected note creation to return T")
+           (is (uiop:file-exists-p (merge-pathnames "test_note.org" tmp-dir))
+               "Expected file test_note.org to exist"))
+      (uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))

lisp/system-integration-tests.lisp

@@ -179,14 +179,27 @@
       (let ((result (backend-cascade-call "Say hello" :system-prompt "Be brief.")))
         (is (stringp result) "Expected string response, got: ~a" result)))))
 
-(test test-messaging-link
-  "Contract Phase2: messaging-link stores token and gateway-configured-p returns T."
-  (skip-unless "TELEGRAM_BOT_TOKEN"
-    (with-daemon ()
-      (messaging-link :telegram :token (uiop:getenv "TELEGRAM_BOT_TOKEN"))
-      (sleep 1)
-      (is (gateway-configured-p :telegram)
-          "Expected telegram to be configured after linking."))))
+(test test-messaging-link-unlink
+  "Contract Phase2: messaging-link stores token, configured-p returns T, unlink removes it."
+  (with-daemon ()
+    (messaging-link :test-platform :token "fake-token-123")
+    (is (gateway-configured-p :test-platform)
+        "Expected test-platform to be configured after linking")
+    (messaging-unlink :test-platform)
+    (is (not (gateway-configured-p :test-platform))
+        "Expected test-platform to be unconfigured after unlinking")))
+
+(test test-gateway-configured-p-false
+  "Contract Phase2: gateway-configured-p returns nil for unknown platform."
+  (with-daemon ()
+    (is (not (gateway-configured-p :nonexistent-platform-xyz)))))
+
+(test test-gateway-start-messaging
+  "Contract Phase2: gateway registry initializes with expected platforms."
+  (with-daemon ()
+    (gateway-registry-initialize)
+    (is (hash-table-p passepartout::*gateway-registry*))
+    (is (>= (hash-table-count passepartout::*gateway-registry*) 1))))
 
 (test test-flight-plan-message-format
   "Contract Phase3: dispatcher-flight-plan-create returns valid message."

org/core-defpackage.org

@@ -114,6 +114,7 @@ The package definition. All public symbols are exported here.
     #:wildcard-match
     #:actuator-initialize
    #:dispatch-action
+   #:action-dispatch
    #:register-actuator
    #:load-skill-from-org
     #:skill-initialize-all
@@ -148,6 +149,10 @@ The package definition. All public symbols are exported here.
     #:org-read-file
     #:org-write-file
     #:org-headline-add
+    #:org-headline-find-by-id
+    #:literate-tangle-sync-check
+    #:archivist-create-note
+    #:gateway-start
     #:org-property-set
     #:org-todo-set
     #:org-find-headline-by-id

org/core-loop-act.org

@@ -336,4 +336,11 @@ Verifies that the act gate correctly processes an approved action and sets the s
                         :approved-action '(:target :cli :payload (:text "test")))))
     (loop-gate-act signal)
     (is (equal meta (getf signal :meta)))))
+
+(test test-action-dispatch-routes
+  "Contract 3: action-dispatch routes to registered actuators without crashing."
+  (actuator-initialize)
+  (let ((result (action-dispatch '(:type :REQUEST :target :system :payload (:action :eval :code "(+ 1 2)"))
+                                  '(:type :EVENT :depth 0))))
+    (is (numberp result) "eval should return a number")))
 #+end_src

org/programming-literate.org

@@ -132,4 +132,10 @@ contents of the Lisp file. Returns T if they match, or an error message."
 (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")))))
+
+(test test-tangle-sync-check
+  "Contract 3: literate-tangle-sync-check verifies org matches tangled lisp."
+  (let ((result (literate-tangle-sync-check "org/core-loop.org" "lisp/core-loop.lisp")))
+    (is (or (eq t result) (stringp result))
+        "Should return T or a mismatch description")))
 #+end_src

org/programming-org.org

@@ -15,7 +15,7 @@ Structural manipulation tools for Org-mode files. This skill handles reading, wr
 4. (org-todo-set ast target-id status): sets TODO status via
    org-property-set.
 5. (org-headline-add ast parent-id title): adds a new child headline.
-6. (org-find-headline-by-id ast id): returns the subtree for a matching
+6. (org-headline-find-by-id ast id): returns the subtree for a matching
    headline ID.
 
 * Implementation
@@ -390,4 +390,24 @@ Verification of the structural manipulation for Org-mode files and their AST rep
                   :contents nil)))
     (org-todo-set ast "id:todo001" "DONE")
     (is (string= (getf (getf ast :properties) :TODO) "DONE"))))
+
+(test test-org-headline-add
+  "Contract 5: org-headline-add inserts a child headline."
+  (let* ((ast (list :type :HEADLINE
+                   :properties (list :ID "root" :TITLE "Root")
+                   :contents nil)))
+    (is (eq t (org-headline-add ast "root" "New Child")))
+    (is (= 1 (length (getf ast :contents))))
+    (is (string= "New Child" (getf (getf (first (getf ast :contents)) :properties) :TITLE)))))
+
+(test test-org-headline-find-by-id
+  "Contract 6: org-headline-find-by-id finds a headline by ID."
+  (let ((ast (list :type :HEADLINE :properties (list :ID "root" :TITLE "Root")
+                   :contents (list (list :type :HEADLINE :properties (list :ID "child1" :TITLE "Child"))
+                                  (list :type :HEADLINE :properties (list :ID "child2" :TITLE "Child 2")))))))
+    (let ((found (org-headline-find-by-id ast "child2")))
+      (is (not (null found)))
+      (is (string= "Child 2" (getf (getf found :properties) :TITLE))))
+    (let ((missing (org-headline-find-by-id ast "nonexistent")))
+      (is (null missing) "Missing ID should return nil"))))
 #+end_src

org/system-archivist.org

@@ -364,5 +364,18 @@ and dispatches as needed. Called by the deterministic gate."
   "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)))))
+    (is (not (search ":" filename))))
+
+(test test-archivist-create-note
+  "Contract 3: archivist-create-note writes a Zettelkasten note to disk."
+  (let* ((tmp-dir "/tmp/passepartout-archivist-test/")
+         (headline (list :title "Test Note" :content "Some content" :tags '("test" "atomic"))))
+    (uiop:ensure-all-directories-exist (list tmp-dir))
+    (unwind-protect
+         (progn
+           (is (eq t (archivist-create-note headline tmp-dir "/tmp/source.org"))
+               "Expected note creation to return T")
+           (is (uiop:file-exists-p (merge-pathnames "test_note.org" tmp-dir))
+               "Expected file test_note.org to exist"))
+      (uiop:delete-directory-tree (uiop:ensure-directory-pathname tmp-dir) :validate t))))
 #+end_src

org/system-integration-tests.org

@@ -272,19 +272,32 @@ credentials. Skipped silently if OPENROUTER_API_KEY is unset.
 
 * Messaging Link/Unlink
 
-Verifies messaging-link stores a token in the vault, and
-gateway-configured-p returns the correct status. Gated on
-TELEGRAM_BOT_TOKEN.
+Verifies messaging-link stores a token in the vault, gateway-configured-p
+returns the correct status, and messaging-unlink removes it. No real
+API credentials needed — these are management functions.
 
 #+begin_src lisp
-(test test-messaging-link
-  "Contract Phase2: messaging-link stores token and gateway-configured-p returns T."
-  (skip-unless "TELEGRAM_BOT_TOKEN"
-    (with-daemon ()
-      (messaging-link :telegram :token (uiop:getenv "TELEGRAM_BOT_TOKEN"))
-      (sleep 1)
-      (is (gateway-configured-p :telegram)
-          "Expected telegram to be configured after linking."))))
+(test test-messaging-link-unlink
+  "Contract Phase2: messaging-link stores token, configured-p returns T, unlink removes it."
+  (with-daemon ()
+    (messaging-link :test-platform :token "fake-token-123")
+    (is (gateway-configured-p :test-platform)
+        "Expected test-platform to be configured after linking")
+    (messaging-unlink :test-platform)
+    (is (not (gateway-configured-p :test-platform))
+        "Expected test-platform to be unconfigured after unlinking")))
+
+(test test-gateway-configured-p-false
+  "Contract Phase2: gateway-configured-p returns nil for unknown platform."
+  (with-daemon ()
+    (is (not (gateway-configured-p :nonexistent-platform-xyz)))))
+
+(test test-gateway-start-messaging
+  "Contract Phase2: gateway registry initializes with expected platforms."
+  (with-daemon ()
+    (gateway-registry-initialize)
+    (is (hash-table-p passepartout::*gateway-registry*))
+    (is (>= (hash-table-count passepartout::*gateway-registry*) 1))))
 #+end_src
 
 * TUI Integration Shell Script