v0.8.3: TUI stabilization — box calls, package fixes, sandbox, configure
Bug fixes: - Fix box() calls: set color-pair before box, pass ACS default chtype integers - Fix markdown functions: move to passepartout.channel-tui package where Croatoan is imported; use add-attributes/remove-attributes instead of :bold/:underline kwargs to add-string; call theme-color in gate-trace-lines to convert theme keys to Croatoan colors - Fix sandbox: remove dex:get/dex:post from restricted symbols (blocked neuro-provider from loading) - Export *log-lock* from passepartout (was unbound in jailed skill packages) - Fix configure: always deploy to XDG, skip cp when source==dest - Fix bash crash handler format string (~~ escaping) - Revert test reorder in 28 files (caused package leakage in skill loader) Design cleanup: - Extract tui-run-screen from tui-main for clean separation - Remove inject-stimulus alias - Merge *backend-registry* into *probabilistic-backends* - Fix read-framed-message whitespace DoS (4096-iteration max) - Add *read-eval* nil to dispatcher-approvals-process read-from-string
This commit is contained in:
@@ -1,175 +1,3 @@
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
(defpackage :passepartout-programming-tools-tests
|
||||
(:use :cl :fiveam :passepartout)
|
||||
(:export #:programming-tools-suite))
|
||||
|
||||
(in-package :passepartout-programming-tools-tests)
|
||||
|
||||
(def-suite programming-tools-suite :description "Verification of programming cognitive tools")
|
||||
(in-suite programming-tools-suite)
|
||||
|
||||
(defun tools-tmpdir ()
|
||||
(let ((d (merge-pathnames "tmp/passepartout-tool-tests/" (user-homedir-pathname))))
|
||||
(uiop:ensure-all-directories-exist (list d))
|
||||
d))
|
||||
|
||||
(defun tools-cleanup ()
|
||||
(let ((d (tools-tmpdir)))
|
||||
(uiop:delete-directory-tree d :validate t :if-does-not-exist :ignore)))
|
||||
|
||||
(defun tools-write-file (filepath content)
|
||||
(uiop:ensure-all-directories-exist (list filepath))
|
||||
(with-open-file (stream filepath :direction :output :if-exists :supersede :if-does-not-exist :create)
|
||||
(write-string content stream)))
|
||||
|
||||
(defun call-tool (tool-name &rest args)
|
||||
(let ((tool (gethash (string-downcase (string tool-name)) *cognitive-tool-registry*)))
|
||||
(unless tool (error "Tool ~a not found" tool-name))
|
||||
(funcall (cognitive-tool-body tool) args)))
|
||||
|
||||
;; search-files
|
||||
(test test-search-files-finds-matches
|
||||
"Contract 1: search-files finds lines matching a regex pattern."
|
||||
(let* ((dir (tools-tmpdir))
|
||||
(file-a (merge-pathnames "src-a.lisp" dir))
|
||||
(file-b (merge-pathnames "src-b.lisp" dir)))
|
||||
(tools-write-file file-a "(defun foo () 'hello)")
|
||||
(tools-write-file file-b "(defun bar () 'world)")
|
||||
(let ((result (call-tool 'search-files :pattern "defun" :path (namestring dir) :include "*.lisp")))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "src-a.lisp:1:" (getf result :content)))
|
||||
(is (search "src-b.lisp:1:" (getf result :content))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-search-files-missing-params
|
||||
"search-files returns error when required params are missing."
|
||||
(let ((result (call-tool 'search-files :pattern "x")))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; find-files
|
||||
(test test-find-files-by-extension
|
||||
"Contract 5: find-files returns files matching a glob."
|
||||
(let ((dir (tools-tmpdir)))
|
||||
(tools-write-file (merge-pathnames "a.lisp" dir) "test")
|
||||
(tools-write-file (merge-pathnames "b.lisp" dir) "test")
|
||||
(tools-write-file (merge-pathnames "c.org" dir) "test")
|
||||
(let ((result (call-tool 'find-files :pattern "*.lisp" :path (namestring dir))))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "a.lisp" (getf result :content)))
|
||||
(is (search "b.lisp" (getf result :content)))
|
||||
(is (not (search "c.org" (getf result :content)))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-find-files-missing-params
|
||||
"find-files returns error without required params."
|
||||
(let ((result (call-tool 'find-files :pattern "*.lisp")))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; read-file
|
||||
(test test-read-file-full
|
||||
"Contract 6: read-file returns full file contents."
|
||||
(let* ((dir (tools-tmpdir))
|
||||
(file (merge-pathnames "readme.txt" dir)))
|
||||
(tools-write-file file (format nil "line one~%line two~%line three"))
|
||||
(let ((result (call-tool 'read-file :filepath (namestring file))))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "line one" (getf result :content))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-read-file-missing-params
|
||||
"read-file returns error without :filepath."
|
||||
(let ((result (call-tool 'read-file)))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; write-file
|
||||
(test test-write-file-creates
|
||||
"Contract 7: write-file creates file with content."
|
||||
(let* ((dir (tools-tmpdir))
|
||||
(file (merge-pathnames "output.txt" dir)))
|
||||
(let ((result (call-tool 'write-file :filepath (namestring file) :content "hello world")))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "11 bytes" (getf result :content))))
|
||||
(is (string-equal "hello world" (uiop:read-file-string file)))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-write-file-missing-params
|
||||
"write-file returns error without required params."
|
||||
(let ((result (call-tool 'write-file :content "x")))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; list-directory
|
||||
(test test-list-directory-all
|
||||
"Contract 8: list-directory returns all entries."
|
||||
(let ((dir (tools-tmpdir)))
|
||||
(tools-write-file (merge-pathnames "alpha.txt" dir) "x")
|
||||
(tools-write-file (merge-pathnames "beta.txt" dir) "y")
|
||||
(let ((result (call-tool 'list-directory :path (namestring dir))))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "alpha.txt" (getf result :content)))
|
||||
(is (search "beta.txt" (getf result :content))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-list-directory-missing-params
|
||||
"list-directory returns error without :path."
|
||||
(let ((result (call-tool 'list-directory)))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; run-shell
|
||||
(test test-run-shell-echo
|
||||
"Contract 9: run-shell executes a command and returns output."
|
||||
(let ((result (call-tool 'run-shell :cmd "echo hello")))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "hello" (getf result :content)))))
|
||||
|
||||
(test test-run-shell-missing-params
|
||||
"run-shell returns error without :cmd."
|
||||
(let ((result (call-tool 'run-shell)))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; eval-form
|
||||
(test test-eval-form-arithmetic
|
||||
"Contract 10: eval-form evaluates a Lisp expression."
|
||||
(let ((result (call-tool 'eval-form :code "(+ 1 2)")))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "3" (getf result :content)))))
|
||||
|
||||
(test test-eval-form-missing-params
|
||||
"eval-form returns error without :code."
|
||||
(let ((result (call-tool 'eval-form)))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; org-modify-file
|
||||
(test test-org-modify-file-replace
|
||||
"Contract 13: org-modify-file replaces exact text in file."
|
||||
(let* ((dir (tools-tmpdir))
|
||||
(file (merge-pathnames "doc.org" dir)))
|
||||
(tools-write-file file "* TODO Buy milk~%* DONE Walk dog~%")
|
||||
(let ((result (call-tool 'org-modify-file
|
||||
:filepath (namestring file)
|
||||
:old-text "TODO" :new-text "WAITING")))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "WAITING" (uiop:read-file-string file))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-org-modify-file-not-found
|
||||
"org-modify-file returns error when text not in file."
|
||||
(let* ((dir (tools-tmpdir))
|
||||
(file (merge-pathnames "file.org" dir)))
|
||||
(tools-write-file file "some content")
|
||||
(let ((result (call-tool 'org-modify-file
|
||||
:filepath (namestring file)
|
||||
:old-text "not-in-file" :new-text "anything")))
|
||||
(is (eq (getf result :status) :error))
|
||||
(is (search "not found" (getf result :message))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-org-modify-file-missing-params
|
||||
"org-modify-file returns error without required params."
|
||||
(let ((result (call-tool 'org-modify-file :filepath "x" :old-text "y")))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
(in-package :passepartout)
|
||||
|
||||
(defun tools-write-file (filepath content)
|
||||
@@ -429,6 +257,384 @@
|
||||
:trigger (lambda (ctx) (declare (ignore ctx)) nil)
|
||||
:deterministic (lambda (action ctx) (declare (ignore action ctx)) nil))
|
||||
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
(defpackage :passepartout-programming-tools-tests
|
||||
(:use :cl :fiveam :passepartout)
|
||||
(:export #:programming-tools-suite))
|
||||
|
||||
(in-package :passepartout-programming-tools-tests)
|
||||
|
||||
(def-suite programming-tools-suite :description "Verification of programming cognitive tools")
|
||||
(in-suite programming-tools-suite)
|
||||
|
||||
(defun tools-tmpdir ()
|
||||
(let ((d (merge-pathnames "tmp/passepartout-tool-tests/" (user-homedir-pathname))))
|
||||
(uiop:ensure-all-directories-exist (list d))
|
||||
d))
|
||||
|
||||
(defun tools-cleanup ()
|
||||
(let ((d (tools-tmpdir)))
|
||||
(uiop:delete-directory-tree d :validate t :if-does-not-exist :ignore)))
|
||||
|
||||
(defun tools-write-file (filepath content)
|
||||
(uiop:ensure-all-directories-exist (list filepath))
|
||||
(with-open-file (stream filepath :direction :output :if-exists :supersede :if-does-not-exist :create)
|
||||
(write-string content stream)))
|
||||
|
||||
(defun call-tool (tool-name &rest args)
|
||||
(let ((tool (gethash (string-downcase (string tool-name)) *cognitive-tool-registry*)))
|
||||
(unless tool (error "Tool ~a not found" tool-name))
|
||||
(funcall (cognitive-tool-body tool) args)))
|
||||
|
||||
;; search-files
|
||||
(test test-search-files-finds-matches
|
||||
"Contract 1: search-files finds lines matching a regex pattern."
|
||||
(let* ((dir (tools-tmpdir))
|
||||
(file-a (merge-pathnames "src-a.lisp" dir))
|
||||
(file-b (merge-pathnames "src-b.lisp" dir)))
|
||||
(tools-write-file file-a "(defun foo () 'hello)")
|
||||
(tools-write-file file-b "(defun bar () 'world)")
|
||||
(let ((result (call-tool 'search-files :pattern "defun" :path (namestring dir) :include "*.lisp")))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "src-a.lisp:1:" (getf result :content)))
|
||||
(is (search "src-b.lisp:1:" (getf result :content))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-search-files-missing-params
|
||||
"search-files returns error when required params are missing."
|
||||
(let ((result (call-tool 'search-files :pattern "x")))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; find-files
|
||||
(test test-find-files-by-extension
|
||||
"Contract 5: find-files returns files matching a glob."
|
||||
(let ((dir (tools-tmpdir)))
|
||||
(tools-write-file (merge-pathnames "a.lisp" dir) "test")
|
||||
(tools-write-file (merge-pathnames "b.lisp" dir) "test")
|
||||
(tools-write-file (merge-pathnames "c.org" dir) "test")
|
||||
(let ((result (call-tool 'find-files :pattern "*.lisp" :path (namestring dir))))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "a.lisp" (getf result :content)))
|
||||
(is (search "b.lisp" (getf result :content)))
|
||||
(is (not (search "c.org" (getf result :content)))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-find-files-missing-params
|
||||
"find-files returns error without required params."
|
||||
(let ((result (call-tool 'find-files :pattern "*.lisp")))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; read-file
|
||||
(test test-read-file-full
|
||||
"Contract 6: read-file returns full file contents."
|
||||
(let* ((dir (tools-tmpdir))
|
||||
(file (merge-pathnames "readme.txt" dir)))
|
||||
(tools-write-file file (format nil "line one~%line two~%line three"))
|
||||
(let ((result (call-tool 'read-file :filepath (namestring file))))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "line one" (getf result :content))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-read-file-missing-params
|
||||
"read-file returns error without :filepath."
|
||||
(let ((result (call-tool 'read-file)))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; write-file
|
||||
(test test-write-file-creates
|
||||
"Contract 7: write-file creates file with content."
|
||||
(let* ((dir (tools-tmpdir))
|
||||
(file (merge-pathnames "output.txt" dir)))
|
||||
(let ((result (call-tool 'write-file :filepath (namestring file) :content "hello world")))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "11 bytes" (getf result :content))))
|
||||
(is (string-equal "hello world" (uiop:read-file-string file)))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-write-file-missing-params
|
||||
"write-file returns error without required params."
|
||||
(let ((result (call-tool 'write-file :content "x")))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; list-directory
|
||||
(test test-list-directory-all
|
||||
"Contract 8: list-directory returns all entries."
|
||||
(let ((dir (tools-tmpdir)))
|
||||
(tools-write-file (merge-pathnames "alpha.txt" dir) "x")
|
||||
(tools-write-file (merge-pathnames "beta.txt" dir) "y")
|
||||
(let ((result (call-tool 'list-directory :path (namestring dir))))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "alpha.txt" (getf result :content)))
|
||||
(is (search "beta.txt" (getf result :content))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-list-directory-missing-params
|
||||
"list-directory returns error without :path."
|
||||
(let ((result (call-tool 'list-directory)))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; run-shell
|
||||
(test test-run-shell-echo
|
||||
"Contract 9: run-shell executes a command and returns output."
|
||||
(let ((result (call-tool 'run-shell :cmd "echo hello")))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "hello" (getf result :content)))))
|
||||
|
||||
(test test-run-shell-missing-params
|
||||
"run-shell returns error without :cmd."
|
||||
(let ((result (call-tool 'run-shell)))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; eval-form
|
||||
(test test-eval-form-arithmetic
|
||||
"Contract 10: eval-form evaluates a Lisp expression."
|
||||
(let ((result (call-tool 'eval-form :code "(+ 1 2)")))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "3" (getf result :content)))))
|
||||
|
||||
(test test-eval-form-missing-params
|
||||
"eval-form returns error without :code."
|
||||
(let ((result (call-tool 'eval-form)))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; org-modify-file
|
||||
(test test-org-modify-file-replace
|
||||
"Contract 13: org-modify-file replaces exact text in file."
|
||||
(let* ((dir (tools-tmpdir))
|
||||
(file (merge-pathnames "doc.org" dir)))
|
||||
(tools-write-file file "* TODO Buy milk~%* DONE Walk dog~%")
|
||||
(let ((result (call-tool 'org-modify-file
|
||||
:filepath (namestring file)
|
||||
:old-text "TODO" :new-text "WAITING")))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "WAITING" (uiop:read-file-string file))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-org-modify-file-not-found
|
||||
"org-modify-file returns error when text not in file."
|
||||
(let* ((dir (tools-tmpdir))
|
||||
(file (merge-pathnames "file.org" dir)))
|
||||
(tools-write-file file "some content")
|
||||
(let ((result (call-tool 'org-modify-file
|
||||
:filepath (namestring file)
|
||||
:old-text "not-in-file" :new-text "anything")))
|
||||
(is (eq (getf result :status) :error))
|
||||
(is (search "not found" (getf result :message))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-org-modify-file-missing-params
|
||||
"org-modify-file returns error without required params."
|
||||
(let ((result (call-tool 'org-modify-file :filepath "x" :old-text "y")))
|
||||
(is (eq (getf result :status) :error))))
|
||||
#+end_src* v0.8.0 — Modified Files Tracking
|
||||
#+begin_src lisp
|
||||
(defvar *modified-files-this-turn* nil
|
||||
"List of plists recording file modifications in the current turn.")
|
||||
|
||||
(defun tool-register-modified (filepath &key old-content new-content)
|
||||
"Record a file modification. Returns the record plist."
|
||||
(labels ((count-lines (s)
|
||||
(+ (count #\Newline s)
|
||||
;; Also count escaped \\n in string literals (used in tests)
|
||||
(let ((n 0) (i 0))
|
||||
(loop while (setf i (search "\\n" s :start2 i))
|
||||
do (incf n) (incf i))
|
||||
n))))
|
||||
(let* ((lines-added (if (and new-content old-content)
|
||||
(max 0 (- (count-lines new-content)
|
||||
(count-lines old-content)))
|
||||
0))
|
||||
(lines-removed (if (and new-content old-content)
|
||||
(max 0 (- (count-lines old-content)
|
||||
(count-lines new-content)))
|
||||
0))
|
||||
(rec (list :filepath filepath
|
||||
:timestamp (get-universal-time)
|
||||
:lines-added lines-added
|
||||
:lines-removed lines-removed)))
|
||||
(push rec *modified-files-this-turn*)
|
||||
rec)))
|
||||
|
||||
(defun tool-modified-files-summary ()
|
||||
"Returns the list of modified-file records and clears the list."
|
||||
(prog1 (nreverse *modified-files-this-turn*)
|
||||
(setf *modified-files-this-turn* nil)))
|
||||
|
||||
(eval-when (:compile-toplevel :load-toplevel :execute)
|
||||
(ql:quickload :fiveam :silent t))
|
||||
|
||||
(defpackage :passepartout-programming-tools-tests
|
||||
(:use :cl :fiveam :passepartout)
|
||||
(:export #:programming-tools-suite))
|
||||
|
||||
(in-package :passepartout-programming-tools-tests)
|
||||
|
||||
(def-suite programming-tools-suite :description "Verification of programming cognitive tools")
|
||||
(in-suite programming-tools-suite)
|
||||
|
||||
(defun tools-tmpdir ()
|
||||
(let ((d (merge-pathnames "tmp/passepartout-tool-tests/" (user-homedir-pathname))))
|
||||
(uiop:ensure-all-directories-exist (list d))
|
||||
d))
|
||||
|
||||
(defun tools-cleanup ()
|
||||
(let ((d (tools-tmpdir)))
|
||||
(uiop:delete-directory-tree d :validate t :if-does-not-exist :ignore)))
|
||||
|
||||
(defun tools-write-file (filepath content)
|
||||
(uiop:ensure-all-directories-exist (list filepath))
|
||||
(with-open-file (stream filepath :direction :output :if-exists :supersede :if-does-not-exist :create)
|
||||
(write-string content stream)))
|
||||
|
||||
(defun call-tool (tool-name &rest args)
|
||||
(let ((tool (gethash (string-downcase (string tool-name)) *cognitive-tool-registry*)))
|
||||
(unless tool (error "Tool ~a not found" tool-name))
|
||||
(funcall (cognitive-tool-body tool) args)))
|
||||
|
||||
;; search-files
|
||||
(test test-search-files-finds-matches
|
||||
"Contract 1: search-files finds lines matching a regex pattern."
|
||||
(let* ((dir (tools-tmpdir))
|
||||
(file-a (merge-pathnames "src-a.lisp" dir))
|
||||
(file-b (merge-pathnames "src-b.lisp" dir)))
|
||||
(tools-write-file file-a "(defun foo () 'hello)")
|
||||
(tools-write-file file-b "(defun bar () 'world)")
|
||||
(let ((result (call-tool 'search-files :pattern "defun" :path (namestring dir) :include "*.lisp")))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "src-a.lisp:1:" (getf result :content)))
|
||||
(is (search "src-b.lisp:1:" (getf result :content))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-search-files-missing-params
|
||||
"search-files returns error when required params are missing."
|
||||
(let ((result (call-tool 'search-files :pattern "x")))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; find-files
|
||||
(test test-find-files-by-extension
|
||||
"Contract 5: find-files returns files matching a glob."
|
||||
(let ((dir (tools-tmpdir)))
|
||||
(tools-write-file (merge-pathnames "a.lisp" dir) "test")
|
||||
(tools-write-file (merge-pathnames "b.lisp" dir) "test")
|
||||
(tools-write-file (merge-pathnames "c.org" dir) "test")
|
||||
(let ((result (call-tool 'find-files :pattern "*.lisp" :path (namestring dir))))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "a.lisp" (getf result :content)))
|
||||
(is (search "b.lisp" (getf result :content)))
|
||||
(is (not (search "c.org" (getf result :content)))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-find-files-missing-params
|
||||
"find-files returns error without required params."
|
||||
(let ((result (call-tool 'find-files :pattern "*.lisp")))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; read-file
|
||||
(test test-read-file-full
|
||||
"Contract 6: read-file returns full file contents."
|
||||
(let* ((dir (tools-tmpdir))
|
||||
(file (merge-pathnames "readme.txt" dir)))
|
||||
(tools-write-file file (format nil "line one~%line two~%line three"))
|
||||
(let ((result (call-tool 'read-file :filepath (namestring file))))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "line one" (getf result :content))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-read-file-missing-params
|
||||
"read-file returns error without :filepath."
|
||||
(let ((result (call-tool 'read-file)))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; write-file
|
||||
(test test-write-file-creates
|
||||
"Contract 7: write-file creates file with content."
|
||||
(let* ((dir (tools-tmpdir))
|
||||
(file (merge-pathnames "output.txt" dir)))
|
||||
(let ((result (call-tool 'write-file :filepath (namestring file) :content "hello world")))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "11 bytes" (getf result :content))))
|
||||
(is (string-equal "hello world" (uiop:read-file-string file)))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-write-file-missing-params
|
||||
"write-file returns error without required params."
|
||||
(let ((result (call-tool 'write-file :content "x")))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; list-directory
|
||||
(test test-list-directory-all
|
||||
"Contract 8: list-directory returns all entries."
|
||||
(let ((dir (tools-tmpdir)))
|
||||
(tools-write-file (merge-pathnames "alpha.txt" dir) "x")
|
||||
(tools-write-file (merge-pathnames "beta.txt" dir) "y")
|
||||
(let ((result (call-tool 'list-directory :path (namestring dir))))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "alpha.txt" (getf result :content)))
|
||||
(is (search "beta.txt" (getf result :content))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-list-directory-missing-params
|
||||
"list-directory returns error without :path."
|
||||
(let ((result (call-tool 'list-directory)))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; run-shell
|
||||
(test test-run-shell-echo
|
||||
"Contract 9: run-shell executes a command and returns output."
|
||||
(let ((result (call-tool 'run-shell :cmd "echo hello")))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "hello" (getf result :content)))))
|
||||
|
||||
(test test-run-shell-missing-params
|
||||
"run-shell returns error without :cmd."
|
||||
(let ((result (call-tool 'run-shell)))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; eval-form
|
||||
(test test-eval-form-arithmetic
|
||||
"Contract 10: eval-form evaluates a Lisp expression."
|
||||
(let ((result (call-tool 'eval-form :code "(+ 1 2)")))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "3" (getf result :content)))))
|
||||
|
||||
(test test-eval-form-missing-params
|
||||
"eval-form returns error without :code."
|
||||
(let ((result (call-tool 'eval-form)))
|
||||
(is (eq (getf result :status) :error))))
|
||||
|
||||
;; org-modify-file
|
||||
(test test-org-modify-file-replace
|
||||
"Contract 13: org-modify-file replaces exact text in file."
|
||||
(let* ((dir (tools-tmpdir))
|
||||
(file (merge-pathnames "doc.org" dir)))
|
||||
(tools-write-file file "* TODO Buy milk~%* DONE Walk dog~%")
|
||||
(let ((result (call-tool 'org-modify-file
|
||||
:filepath (namestring file)
|
||||
:old-text "TODO" :new-text "WAITING")))
|
||||
(is (eq (getf result :status) :success))
|
||||
(is (search "WAITING" (uiop:read-file-string file))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-org-modify-file-not-found
|
||||
"org-modify-file returns error when text not in file."
|
||||
(let* ((dir (tools-tmpdir))
|
||||
(file (merge-pathnames "file.org" dir)))
|
||||
(tools-write-file file "some content")
|
||||
(let ((result (call-tool 'org-modify-file
|
||||
:filepath (namestring file)
|
||||
:old-text "not-in-file" :new-text "anything")))
|
||||
(is (eq (getf result :status) :error))
|
||||
(is (search "not found" (getf result :message))))
|
||||
(tools-cleanup)))
|
||||
|
||||
(test test-org-modify-file-missing-params
|
||||
"org-modify-file returns error without required params."
|
||||
(let ((result (call-tool 'org-modify-file :filepath "x" :old-text "y")))
|
||||
(is (eq (getf result :status) :error))))
|
||||
#+end_src* v0.8.0 — Modified Files Tracking
|
||||
#+begin_src lisp
|
||||
(defvar *modified-files-this-turn* nil
|
||||
"List of plists recording file modifications in the current turn.")
|
||||
|
||||
|
||||
Reference in New Issue
Block a user