From ad8242fee678951ed208d9ae800cdf702a182ab9 Mon Sep 17 00:00:00 2001 From: Amr Gharbeia Date: Tue, 5 May 2026 13:52:59 -0400 Subject: [PATCH] tests: close remaining contract gaps (action-dispatch, org-headline-add/find-by-id, tangle-sync, create-note, messaging-link/unlink) --- lisp/core-defpackage.lisp | 5 +++++ lisp/core-loop-act.lisp | 7 ++++++ lisp/programming-literate.lisp | 6 +++++ lisp/programming-org.lisp | 20 +++++++++++++++++ lisp/system-archivist.lisp | 15 ++++++++++++- lisp/system-integration-tests.lisp | 29 ++++++++++++++++++------- org/core-defpackage.org | 5 +++++ org/core-loop-act.org | 7 ++++++ org/programming-literate.org | 6 +++++ org/programming-org.org | 22 ++++++++++++++++++- org/system-archivist.org | 15 ++++++++++++- org/system-integration-tests.org | 35 ++++++++++++++++++++---------- 12 files changed, 150 insertions(+), 22 deletions(-) diff --git a/lisp/core-defpackage.lisp b/lisp/core-defpackage.lisp index 8375241..91cca43 100644 --- a/lisp/core-defpackage.lisp +++ b/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 diff --git a/lisp/core-loop-act.lisp b/lisp/core-loop-act.lisp index 30f2775..3678d19 100644 --- a/lisp/core-loop-act.lisp +++ b/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"))) diff --git a/lisp/programming-literate.lisp b/lisp/programming-literate.lisp index af3f145..7f63b77 100644 --- a/lisp/programming-literate.lisp +++ b/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"))) diff --git a/lisp/programming-org.lisp b/lisp/programming-org.lisp index 46cbf68..07761cc 100644 --- a/lisp/programming-org.lisp +++ b/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")))) diff --git a/lisp/system-archivist.lisp b/lisp/system-archivist.lisp index 6d2e54b..a4e315b 100644 --- a/lisp/system-archivist.lisp +++ b/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)))) diff --git a/lisp/system-integration-tests.lisp b/lisp/system-integration-tests.lisp index 01de79f..98d2157 100644 --- a/lisp/system-integration-tests.lisp +++ b/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." diff --git a/org/core-defpackage.org b/org/core-defpackage.org index 843e461..4d60167 100644 --- a/org/core-defpackage.org +++ b/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 diff --git a/org/core-loop-act.org b/org/core-loop-act.org index 530ae40..73d59c0 100644 --- a/org/core-loop-act.org +++ b/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 \ No newline at end of file diff --git a/org/programming-literate.org b/org/programming-literate.org index 06b3d6f..206bd43 100644 --- a/org/programming-literate.org +++ b/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 \ No newline at end of file diff --git a/org/programming-org.org b/org/programming-org.org index 6bf209b..d7884a7 100644 --- a/org/programming-org.org +++ b/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 \ No newline at end of file diff --git a/org/system-archivist.org b/org/system-archivist.org index 98cc4fe..8e83c60 100644 --- a/org/system-archivist.org +++ b/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 \ No newline at end of file diff --git a/org/system-integration-tests.org b/org/system-integration-tests.org index 3b6a492..e12ba5c 100644 --- a/org/system-integration-tests.org +++ b/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