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,91 +1,3 @@
|
||||
(defpackage :passepartout-utils-lisp-tests
|
||||
(:use :cl :fiveam :passepartout)
|
||||
(:export #:utils-lisp-suite))
|
||||
|
||||
(in-package :passepartout-utils-lisp-tests)
|
||||
|
||||
(def-suite utils-lisp-suite
|
||||
:description "Tests for the Lisp Validator structural, syntactic, and semantic gates")
|
||||
|
||||
(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)))
|
||||
(let ((form (read-from-string extracted)))
|
||||
(is (eq (car form) 'DEFUN))
|
||||
(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))
|
||||
(is (member 'BAR names))
|
||||
(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)))
|
||||
(is (equal (last form) '((STEP-2)))))))
|
||||
|
||||
(in-package :passepartout)
|
||||
|
||||
(defun lisp-structural-check (code)
|
||||
@@ -244,3 +156,91 @@
|
||||
(intern (string k) :keyword)
|
||||
k)
|
||||
collect v)))
|
||||
|
||||
(defpackage :passepartout-utils-lisp-tests
|
||||
(:use :cl :fiveam :passepartout)
|
||||
(:export #:utils-lisp-suite))
|
||||
|
||||
(in-package :passepartout-utils-lisp-tests)
|
||||
|
||||
(def-suite utils-lisp-suite
|
||||
:description "Tests for the Lisp Validator structural, syntactic, and semantic gates")
|
||||
|
||||
(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)))
|
||||
(let ((form (read-from-string extracted)))
|
||||
(is (eq (car form) 'DEFUN))
|
||||
(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))
|
||||
(is (member 'BAR names))
|
||||
(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)))
|
||||
(is (equal (last form) '((STEP-2)))))))
|
||||
|
||||
Reference in New Issue
Block a user