Amr Gharbeia
8fd56dece3
Phase 1 — dedup + hardening (~9 items): - Remove duplicate *skill-registry* defvar from core-skills - Merge *backend-registry* into *probabilistic-backends*, delete backend-register - Remove inject-stimulus alias, standardize on stimulus-inject - Add pre-eval sandbox (skill-source-scan) blocks restricted symbols before eval - Remove dead plist-get function; remove duplicate json-alist-to-plist export - Fix read-framed-message whitespace DoS (4096-iteration max) - Add *read-eval* nil to dispatcher-approvals-process read-from-string (RCE) - Add test-op to ASDF; update .asd version 0.4.3→0.7.2 Phase 2 — prose + contracts + reorder: - Split ROADMAP: 2623→1089 lines (TODO only), CHANGELOG: 260→1528 lines (full DONE history, 14 versions reverse chron) - Add Contracts + Overview to 6 channel files + embedding-native + programming-standards + symbolic-scope - Reorder 28 .org files: Contract → Test Suite → Implementation (TDD order) - Add 7-phase inline prose to think() in core-reason - Expand USER_MANUAL: 183→461 lines (10 new sections) Phase 3 — decomposition + export organization: - Decompose think() into think-assemble-prompt, think-call-llm, think-parse-response orchestrator - Organize 188 exports into 16 grouped sections by module Phase 4 — budget enforcement + error protocol: - Per-session budget enforcement (SESSION_BUDGET_USD env var, budget-exhausted-p, guard in think-call-llm) - Error condition hierarchy (6 conditions: pipeline-error, llm-error, gate-error, budget-error, protocol-error) - Restarts in loop-process: skip-signal, use-fallback, abort-pipeline
104 lines
4.4 KiB
Common Lisp
104 lines
4.4 KiB
Common Lisp
(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 (format nil "#+begin_src lisp~%(+ 1 2)~%#+end_src~%#+begin_src lisp~%(+ 3 4)~%#+end_src"))
|
|
(extracted (literate-extract-lisp-blocks org-content)))
|
|
(let ((joined (format nil "~{~a~^~%~}" extracted)))
|
|
(is (search "(+ 1 2)" joined))
|
|
(is (search "(+ 3 4)" joined)))))
|
|
|
|
(test test-block-balance-check-valid
|
|
"Contract 2: balanced parens return T."
|
|
(is (eq t (literate-block-balance-check
|
|
(merge-pathnames "org/core-pipeline.org"
|
|
(uiop:ensure-directory-pathname
|
|
(uiop:getenv "PASSEPARTOUT_DATA_DIR")))))))
|
|
|
|
(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-pipeline.org" "lisp/core-pipeline.lisp")))
|
|
(is (or (eq t result) (stringp result))
|
|
"Should return T or a mismatch description")))
|
|
|
|
(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."
|
|
(let ((lines (uiop:split-string content :separator '(#\Newline)))
|
|
(blocks nil)
|
|
(in-block nil)
|
|
(current-block nil))
|
|
(dolist (line lines)
|
|
(let ((trimmed (string-trim '(#\Space) line)))
|
|
(cond
|
|
((uiop:string-prefix-p "#+begin_src lisp" trimmed)
|
|
(setf in-block t current-block nil))
|
|
((uiop:string-prefix-p "#+end_src" trimmed)
|
|
(when in-block
|
|
(push (format nil "~{~a~^~%~}" (nreverse current-block)) blocks)
|
|
(setf in-block nil current-block nil)))
|
|
(in-block
|
|
(push line current-block)))))
|
|
(nreverse blocks)))
|
|
|
|
(defun literate-block-balance-check (org-file)
|
|
"Verifies that all Lisp source blocks in an Org file have balanced parentheses.
|
|
Returns T if all blocks pass validation, or an error string listing failures."
|
|
(when (not (uiop:file-exists-p org-file))
|
|
(return-from literate-block-balance-check
|
|
(format nil "Org file not found: ~a" org-file)))
|
|
(let* ((content (uiop:read-file-string org-file))
|
|
(blocks (literate-extract-lisp-blocks content))
|
|
(failures nil))
|
|
(if (null blocks)
|
|
t
|
|
(progn
|
|
(loop for i from 0
|
|
for block in blocks
|
|
for (ok reason) = (multiple-value-list
|
|
(lisp-structural-check block))
|
|
unless ok
|
|
do (push (format nil "Block ~d: ~a" (1+ i) reason) failures))
|
|
(if failures
|
|
(format nil "Unbalanced blocks in ~a:~%~{~a~^~%~}" org-file failures)
|
|
t)))))
|
|
|
|
(defun literate-tangle-sync-check (org-file lisp-file)
|
|
"Verifies that the .lisp file matches the tangled output of the .org file.
|
|
Compares the concatenation of all lisp blocks from the Org file against the
|
|
contents of the Lisp file. Returns T if they match, or an error message."
|
|
(when (not (uiop:file-exists-p org-file))
|
|
(return-from literate-tangle-sync-check
|
|
(format nil "Org file not found: ~a" org-file)))
|
|
(when (not (uiop:file-exists-p lisp-file))
|
|
(return-from literate-tangle-sync-check
|
|
(format nil "Lisp file not found: ~a" lisp-file)))
|
|
(let* ((org-content (uiop:read-file-string org-file))
|
|
(org-blocks (literate-extract-lisp-blocks org-content))
|
|
(tangled (format nil "~{~a~^~%~%~}" org-blocks))
|
|
(lisp-content (uiop:read-file-string lisp-file)))
|
|
(if (string= (string-trim '(#\Space #\Newline) tangled)
|
|
(string-trim '(#\Space #\Newline) lisp-content))
|
|
t
|
|
(format nil "Tangle sync mismatch: ~a does not match ~a" org-file lisp-file))))
|
|
|
|
(defskill :passepartout-programming-literate
|
|
:priority 300
|
|
:trigger (lambda (ctx) (declare (ignore ctx)) nil))
|