Move check-tangle-sync from Engineering Standards to Literate Programming
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 2s
Some checks failed
Deploy-Agent-V15-Stdin / JOB-V15-STDIN (push) Failing after 2s
Engineering Standards now focuses on lifecycle phases (0, A, B, D, E). Literate Programming now owns LP structural invariants including tangle-sync. Changes: - Removed check-tangle-sync and *enforcement-rules* from org-skill-engineering-standards.org - Added check-tangle-sync, *tangle-targets*, *lp-project-root* to org-skill-literate-programming.org - Updated LP skill to check tangle-sync on file modification actions - Added literate-programming-tests.lisp with tangle-sync and block-balance tests - Removed tangle-sync tests from engineering-standards-tests.lisp
This commit is contained in:
@@ -15,8 +15,7 @@
|
|||||||
(defvar *enforcement-rules*
|
(defvar *enforcement-rules*
|
||||||
'((:pre-task
|
'((:pre-task
|
||||||
(:git-clean "Working tree must be clean before modifications")
|
(:git-clean "Working tree must be clean before modifications")
|
||||||
(:skill-queried "Skill catalog should be queried before analysis")
|
(:skill-queried "Skill catalog should be queried before analysis"))
|
||||||
(:tangle-synced "Tangled .lisp files must match Org source"))
|
|
||||||
(:during-task
|
(:during-task
|
||||||
(:org-only "Only .org files may be edited; .lisp is generated")
|
(:org-only "Only .org files may be edited; .lisp is generated")
|
||||||
(:one-per-block "One definition per src block")
|
(:one-per-block "One definition per src block")
|
||||||
@@ -42,37 +41,6 @@
|
|||||||
:message "ENGINEERING STANDARDS VIOLATION: Working tree is dirty. Commit changes before modifying files."
|
:message "ENGINEERING STANDARDS VIOLATION: Working tree is dirty. Commit changes before modifying files."
|
||||||
:severity :blocker)))
|
:severity :blocker)))
|
||||||
|
|
||||||
(defvar *tangle-targets*
|
|
||||||
'(("skills/org-skill-engineering-standards.org" . "library/gen/org-skill-engineering-standards.lisp")
|
|
||||||
("skills/org-skill-literate-programming.org" . "library/gen/org-skill-literate-programming.lisp")
|
|
||||||
("harness/memory.org" . "library/memory.lisp")
|
|
||||||
("harness/loop.org" . "library/loop.lisp")
|
|
||||||
("harness/perceive.org" . "library/perceive.lisp")
|
|
||||||
("harness/reason.org" . "library/reason.lisp")
|
|
||||||
("harness/act.org" . "library/act.lisp")
|
|
||||||
("harness/skills.org" . "library/skills.lisp")
|
|
||||||
("harness/communication.org" . "library/communication.lisp")))
|
|
||||||
|
|
||||||
(defun check-tangle-sync (&optional (root *engineering-std-*project-root*))
|
|
||||||
"Returns violation if any tangled .lisp file is newer than its Org source.
|
|
||||||
|
|
||||||
This detects direct .lisp edits (which violate the LP workflow)."
|
|
||||||
(when root
|
|
||||||
(dolist (pair *tangle-targets*)
|
|
||||||
(let* ((org-file (merge-pathnames (car pair) root))
|
|
||||||
(lisp-file (merge-pathnames (cdr pair) root))
|
|
||||||
(org-time (ignore-errors (file-write-date org-file)))
|
|
||||||
(lisp-time (ignore-errors (file-write-date lisp-file))))
|
|
||||||
(when (and org-time lisp-time (> lisp-time org-time))
|
|
||||||
(return-from check-tangle-sync
|
|
||||||
(make-engineering-violation
|
|
||||||
:phase :pre-task
|
|
||||||
:rule :tangle-synced
|
|
||||||
:message (format nil "ENGINEERING STANDARDS VIOLATION: ~a is newer than ~a. Edit Org source, not .lisp directly."
|
|
||||||
(file-namestring lisp-file) (file-namestring org-file))
|
|
||||||
:severity :blocker))))))
|
|
||||||
nil)
|
|
||||||
|
|
||||||
(defun engineering-standards-gate (action context)
|
(defun engineering-standards-gate (action context)
|
||||||
"The deterministic HARD BLOCK gate for Engineering Standards.
|
"The deterministic HARD BLOCK gate for Engineering Standards.
|
||||||
|
|
||||||
@@ -96,15 +64,7 @@ This detects direct .lisp edits (which violate the LP workflow)."
|
|||||||
(harness-log "~a" (engineering-violation-message git-check))
|
(harness-log "~a" (engineering-violation-message git-check))
|
||||||
(return-from engineering-standards-gate
|
(return-from engineering-standards-gate
|
||||||
(list :type :log
|
(list :type :log
|
||||||
:payload (list :text (engineering-violation-message git-check))))))
|
:payload (list :text (engineering-violation-message git-check)))))))
|
||||||
|
|
||||||
;; BLOCKING: Tangle sync check - .lisp must not be newer than .org
|
|
||||||
(let ((tangle-check (check-tangle-sync *engineering-std-*project-root*)))
|
|
||||||
(when tangle-check
|
|
||||||
(harness-log "~a" (engineering-violation-message tangle-check))
|
|
||||||
(return-from engineering-standards-gate
|
|
||||||
(list :type :log
|
|
||||||
:payload (list :text (engineering-violation-message tangle-check))))))))
|
|
||||||
|
|
||||||
action)
|
action)
|
||||||
|
|
||||||
|
|||||||
@@ -71,16 +71,57 @@
|
|||||||
reports))))
|
reports))))
|
||||||
(setf idx (+ end-pos 9))))))))))
|
(setf idx (+ end-pos 9))))))))))
|
||||||
|
|
||||||
|
(defvar *tangle-targets*
|
||||||
|
'(("skills/org-skill-engineering-standards.org" . "library/gen/org-skill-engineering-standards.lisp")
|
||||||
|
("skills/org-skill-literate-programming.org" . "library/gen/org-skill-literate-programming.lisp")
|
||||||
|
("harness/memory.org" . "library/memory.lisp")
|
||||||
|
("harness/loop.org" . "library/loop.lisp")
|
||||||
|
("harness/perceive.org" . "library/perceive.lisp")
|
||||||
|
("harness/reason.org" . "library/reason.lisp")
|
||||||
|
("harness/act.org" . "library/act.lisp")
|
||||||
|
("harness/skills.org" . "library/skills.lisp")
|
||||||
|
("harness/communication.org" . "library/communication.lisp")))
|
||||||
|
|
||||||
|
(defvar *lp-project-root* nil)
|
||||||
|
|
||||||
|
(defun lp-set-project-root (path)
|
||||||
|
(setf *lp-project-root* (uiop:ensure-directory-pathname path)))
|
||||||
|
|
||||||
|
(defun check-tangle-sync (&optional (root *lp-project-root*))
|
||||||
|
"Returns violation if any tangled .lisp file is newer than its Org source.
|
||||||
|
|
||||||
|
This detects direct .lisp edits (which violate the LP workflow)."
|
||||||
|
(when root
|
||||||
|
(dolist (pair *tangle-targets*)
|
||||||
|
(let* ((org-file (merge-pathnames (car pair) root))
|
||||||
|
(lisp-file (merge-pathnames (cdr pair) root))
|
||||||
|
(org-time (ignore-errors (file-write-date org-file)))
|
||||||
|
(lisp-time (ignore-errors (file-write-date lisp-file))))
|
||||||
|
(when (and org-time lisp-time (> lisp-time org-time))
|
||||||
|
(return-from check-tangle-sync
|
||||||
|
(list :type :log
|
||||||
|
:payload (list :text (format nil "LITERATE PROGRAMMING VIOLATION: ~a is newer than ~a. Edit Org source, not .lisp directly."
|
||||||
|
(file-namestring lisp-file) (file-namestring org-file)))))))))
|
||||||
|
nil)
|
||||||
|
|
||||||
(defskill :skill-literate-programming
|
(defskill :skill-literate-programming
|
||||||
:priority 1100
|
:priority 1100
|
||||||
:trigger (lambda (ctx)
|
:trigger (lambda (ctx)
|
||||||
(declare (ignore ctx))
|
(declare (ignore ctx))
|
||||||
;; Trigger on any skill-related action
|
|
||||||
t)
|
t)
|
||||||
:probabilistic nil
|
:probabilistic nil
|
||||||
:deterministic (lambda (action context)
|
:deterministic (lambda (action context)
|
||||||
(declare (ignore context))
|
(declare (ignore context))
|
||||||
;; Audit the action's target file if it's an org skill
|
;; Check tangle sync before any file modification
|
||||||
|
(let ((file (and (listp action) (getf action :payload) (getf (getf action :payload) :file))))
|
||||||
|
(when file
|
||||||
|
(let ((tangle-check (check-tangle-sync *lp-project-root*)))
|
||||||
|
(when tangle-check
|
||||||
|
(return-from skill-literate-programming deterministic
|
||||||
|
(progn
|
||||||
|
(harness-log "~a" (getf (getf tangle-check :payload) :text))
|
||||||
|
tangle-check))))))
|
||||||
|
;; Audit org files for structural balance
|
||||||
(when (and (listp action)
|
(when (and (listp action)
|
||||||
(stringp (getf action :file)))
|
(stringp (getf action :file)))
|
||||||
(let ((file (getf action :file)))
|
(let ((file (getf action :file)))
|
||||||
@@ -91,3 +132,18 @@
|
|||||||
(harness-log "LITERATE PROGRAMMING: Structural issues found in ~a: ~a"
|
(harness-log "LITERATE PROGRAMMING: Structural issues found in ~a: ~a"
|
||||||
file issues))))))
|
file issues))))))
|
||||||
action))
|
action))
|
||||||
|
|
||||||
|
(defvar *lp-initialized* nil)
|
||||||
|
|
||||||
|
(defun lp-init ()
|
||||||
|
"Initialize the LP system with project root."
|
||||||
|
(unless *lp-initialized*
|
||||||
|
(let ((env-root (or (uiop:getenv "OPENCORTEX_ROOT")
|
||||||
|
(uiop:getenv "MEMEX_DIR")
|
||||||
|
"/home/user/memex/projects/opencortex")))
|
||||||
|
(lp-set-project-root env-root)
|
||||||
|
(setf *lp-initialized* t)
|
||||||
|
(harness-log "LITERATE PROGRAMMING: Initialized with root ~a" *lp-project-root*))))
|
||||||
|
|
||||||
|
;; Auto-initialize on load
|
||||||
|
(lp-init)
|
||||||
|
|||||||
@@ -125,8 +125,7 @@ The engineering standards skill is a HARD BLOCK gate. Violations are rejected, n
|
|||||||
(defvar *enforcement-rules*
|
(defvar *enforcement-rules*
|
||||||
'((:pre-task
|
'((:pre-task
|
||||||
(:git-clean "Working tree must be clean before modifications")
|
(:git-clean "Working tree must be clean before modifications")
|
||||||
(:skill-queried "Skill catalog should be queried before analysis")
|
(:skill-queried "Skill catalog should be queried before analysis"))
|
||||||
(:tangle-synced "Tangled .lisp files must match Org source"))
|
|
||||||
(:during-task
|
(:during-task
|
||||||
(:org-only "Only .org files may be edited; .lisp is generated")
|
(:org-only "Only .org files may be edited; .lisp is generated")
|
||||||
(:one-per-block "One definition per src block")
|
(:one-per-block "One definition per src block")
|
||||||
@@ -157,43 +156,6 @@ The engineering standards skill is a HARD BLOCK gate. Violations are rejected, n
|
|||||||
:severity :blocker)))
|
:severity :blocker)))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Tangle Sync Check (Blocking)
|
|
||||||
|
|
||||||
This check verifies that tangled .lisp files are in sync with their Org source. Violation: edited .lisp directly instead of through Org.
|
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../library/gen/org-skill-engineering-standards.lisp
|
|
||||||
(defvar *tangle-targets*
|
|
||||||
'(("skills/org-skill-engineering-standards.org" . "library/gen/org-skill-engineering-standards.lisp")
|
|
||||||
("skills/org-skill-literate-programming.org" . "library/gen/org-skill-literate-programming.lisp")
|
|
||||||
("harness/memory.org" . "library/memory.lisp")
|
|
||||||
("harness/loop.org" . "library/loop.lisp")
|
|
||||||
("harness/perceive.org" . "library/perceive.lisp")
|
|
||||||
("harness/reason.org" . "library/reason.lisp")
|
|
||||||
("harness/act.org" . "library/act.lisp")
|
|
||||||
("harness/skills.org" . "library/skills.lisp")
|
|
||||||
("harness/communication.org" . "library/communication.lisp")))
|
|
||||||
|
|
||||||
(defun check-tangle-sync (&optional (root *engineering-std-*project-root*))
|
|
||||||
"Returns violation if any tangled .lisp file is newer than its Org source.
|
|
||||||
|
|
||||||
This detects direct .lisp edits (which violate the LP workflow)."
|
|
||||||
(when root
|
|
||||||
(dolist (pair *tangle-targets*)
|
|
||||||
(let* ((org-file (merge-pathnames (car pair) root))
|
|
||||||
(lisp-file (merge-pathnames (cdr pair) root))
|
|
||||||
(org-time (ignore-errors (file-write-date org-file)))
|
|
||||||
(lisp-time (ignore-errors (file-write-date lisp-file))))
|
|
||||||
(when (and org-time lisp-time (> lisp-time org-time))
|
|
||||||
(return-from check-tangle-sync
|
|
||||||
(make-engineering-violation
|
|
||||||
:phase :pre-task
|
|
||||||
:rule :tangle-synced
|
|
||||||
:message (format nil "ENGINEERING STANDARDS VIOLATION: ~a is newer than ~a. Edit Org source, not .lisp directly."
|
|
||||||
(file-namestring lisp-file) (file-namestring org-file))
|
|
||||||
:severity :blocker))))))
|
|
||||||
nil)
|
|
||||||
#+end_src
|
|
||||||
|
|
||||||
** Test Suite
|
** Test Suite
|
||||||
|
|
||||||
These tests verify the enforcement logic. Run with:
|
These tests verify the enforcement logic. Run with:
|
||||||
@@ -262,33 +224,6 @@ These tests verify the enforcement logic. Run with:
|
|||||||
(let ((result (opencortex::engineering-standards-gate action nil)))
|
(let ((result (opencortex::engineering-standards-gate action nil)))
|
||||||
(is (listp result))
|
(is (listp result))
|
||||||
(is (eq :request (getf result :type))))))
|
(is (eq :request (getf result :type))))))
|
||||||
|
|
||||||
(test tangle-sync-detects-stale-lisp
|
|
||||||
"check-tangle-sync returns violation when .lisp is newer than .org"
|
|
||||||
(let ((tmp-org "/tmp/test-skill.org")
|
|
||||||
(tmp-lisp "/tmp/test-skill.lisp"))
|
|
||||||
(with-open-file (f tmp-org :direction :output) (write-line "* Test" f))
|
|
||||||
(sleep 1)
|
|
||||||
(with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f))
|
|
||||||
(let* ((root (uiop:ensure-directory-pathname "/tmp/"))
|
|
||||||
(result (opencortex::check-tangle-sync root)))
|
|
||||||
(when result
|
|
||||||
(is (eq :tangle-synced (opencortex::engineering-violation-rule result))))
|
|
||||||
(uiop:delete-file-if-exists tmp-org)
|
|
||||||
(uiop:delete-file-if-exists tmp-lisp)))
|
|
||||||
|
|
||||||
(test tangle-sync-passes-when-synced
|
|
||||||
"check-tangle-sync returns nil when .org is newer than .lisp"
|
|
||||||
(let ((tmp-org "/tmp/test-skill2.org")
|
|
||||||
(tmp-lisp "/tmp/test-skill2.lisp"))
|
|
||||||
(with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f))
|
|
||||||
(sleep 1)
|
|
||||||
(with-open-file (f tmp-org :direction :output) (write-line "* Test" f))
|
|
||||||
(let* ((root (uiop:ensure-directory-pathname "/tmp/"))
|
|
||||||
(result (opencortex::check-tangle-sync root)))
|
|
||||||
(is (null result)))
|
|
||||||
(uiop:delete-file-if-exists tmp-org)
|
|
||||||
(uiop:delete-file-if-exists tmp-lisp)))
|
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
** Blocking Gate (Hard Enforcement)
|
** Blocking Gate (Hard Enforcement)
|
||||||
@@ -317,15 +252,7 @@ These tests verify the enforcement logic. Run with:
|
|||||||
(harness-log "~a" (engineering-violation-message git-check))
|
(harness-log "~a" (engineering-violation-message git-check))
|
||||||
(return-from engineering-standards-gate
|
(return-from engineering-standards-gate
|
||||||
(list :type :log
|
(list :type :log
|
||||||
:payload (list :text (engineering-violation-message git-check))))))
|
:payload (list :text (engineering-violation-message git-check)))))))
|
||||||
|
|
||||||
;; BLOCKING: Tangle sync check - .lisp must not be newer than .org
|
|
||||||
(let ((tangle-check (check-tangle-sync *engineering-std-*project-root*)))
|
|
||||||
(when tangle-check
|
|
||||||
(harness-log "~a" (engineering-violation-message tangle-check))
|
|
||||||
(return-from engineering-standards-gate
|
|
||||||
(list :type :log
|
|
||||||
:payload (list :text (engineering-violation-message tangle-check))))))))
|
|
||||||
|
|
||||||
action)
|
action)
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|||||||
@@ -136,19 +136,68 @@ Code without surrounding prose is a bug report waiting to happen.
|
|||||||
(setf idx (+ end-pos 9))))))))))
|
(setf idx (+ end-pos 9))))))))))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
|
** Tangle Sync Check
|
||||||
|
|
||||||
|
Verifies that tangled `.lisp` files are in sync with their Org source. Violation: edited .lisp directly instead of through Org.
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../library/gen/org-skill-literate-programming.lisp
|
||||||
|
(defvar *tangle-targets*
|
||||||
|
'(("skills/org-skill-engineering-standards.org" . "library/gen/org-skill-engineering-standards.lisp")
|
||||||
|
("skills/org-skill-literate-programming.org" . "library/gen/org-skill-literate-programming.lisp")
|
||||||
|
("harness/memory.org" . "library/memory.lisp")
|
||||||
|
("harness/loop.org" . "library/loop.lisp")
|
||||||
|
("harness/perceive.org" . "library/perceive.lisp")
|
||||||
|
("harness/reason.org" . "library/reason.lisp")
|
||||||
|
("harness/act.org" . "library/act.lisp")
|
||||||
|
("harness/skills.org" . "library/skills.lisp")
|
||||||
|
("harness/communication.org" . "library/communication.lisp")))
|
||||||
|
|
||||||
|
(defvar *lp-project-root* nil)
|
||||||
|
|
||||||
|
(defun lp-set-project-root (path)
|
||||||
|
(setf *lp-project-root* (uiop:ensure-directory-pathname path)))
|
||||||
|
|
||||||
|
(defun check-tangle-sync (&optional (root *lp-project-root*))
|
||||||
|
"Returns violation if any tangled .lisp file is newer than its Org source.
|
||||||
|
|
||||||
|
This detects direct .lisp edits (which violate the LP workflow)."
|
||||||
|
(when root
|
||||||
|
(dolist (pair *tangle-targets*)
|
||||||
|
(let* ((org-file (merge-pathnames (car pair) root))
|
||||||
|
(lisp-file (merge-pathnames (cdr pair) root))
|
||||||
|
(org-time (ignore-errors (file-write-date org-file)))
|
||||||
|
(lisp-time (ignore-errors (file-write-date lisp-file))))
|
||||||
|
(when (and org-time lisp-time (> lisp-time org-time))
|
||||||
|
(return-from check-tangle-sync
|
||||||
|
(list :type :log
|
||||||
|
:payload (list :text (format nil "LITERATE PROGRAMMING VIOLATION: ~a is newer than ~a. Edit Org source, not .lisp directly."
|
||||||
|
(file-namestring lisp-file) (file-namestring org-file)))))))))
|
||||||
|
nil)
|
||||||
|
#+end_src
|
||||||
|
|
||||||
** Skill Registration
|
** Skill Registration
|
||||||
|
|
||||||
|
The LP skill runs at priority 1100 (just below engineering-standards at 1000).
|
||||||
|
|
||||||
#+begin_src lisp :tangle ../library/gen/org-skill-literate-programming.lisp
|
#+begin_src lisp :tangle ../library/gen/org-skill-literate-programming.lisp
|
||||||
(defskill :skill-literate-programming
|
(defskill :skill-literate-programming
|
||||||
:priority 1100
|
:priority 1100
|
||||||
:trigger (lambda (ctx)
|
:trigger (lambda (ctx)
|
||||||
(declare (ignore ctx))
|
(declare (ignore ctx))
|
||||||
;; Trigger on any skill-related action
|
|
||||||
t)
|
t)
|
||||||
:probabilistic nil
|
:probabilistic nil
|
||||||
:deterministic (lambda (action context)
|
:deterministic (lambda (action context)
|
||||||
(declare (ignore context))
|
(declare (ignore context))
|
||||||
;; Audit the action's target file if it's an org skill
|
;; Check tangle sync before any file modification
|
||||||
|
(let ((file (and (listp action) (getf action :payload) (getf (getf action :payload) :file))))
|
||||||
|
(when file
|
||||||
|
(let ((tangle-check (check-tangle-sync *lp-project-root*)))
|
||||||
|
(when tangle-check
|
||||||
|
(return-from skill-literate-programming deterministic
|
||||||
|
(progn
|
||||||
|
(harness-log "~a" (getf (getf tangle-check :payload) :text))
|
||||||
|
tangle-check))))))
|
||||||
|
;; Audit org files for structural balance
|
||||||
(when (and (listp action)
|
(when (and (listp action)
|
||||||
(stringp (getf action :file)))
|
(stringp (getf action :file)))
|
||||||
(let ((file (getf action :file)))
|
(let ((file (getf action :file)))
|
||||||
@@ -161,6 +210,81 @@ Code without surrounding prose is a bug report waiting to happen.
|
|||||||
action))
|
action))
|
||||||
#+end_src
|
#+end_src
|
||||||
|
|
||||||
|
** Initialize Project Root
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../library/gen/org-skill-literate-programming.lisp
|
||||||
|
(defvar *lp-initialized* nil)
|
||||||
|
|
||||||
|
(defun lp-init ()
|
||||||
|
"Initialize the LP system with project root."
|
||||||
|
(unless *lp-initialized*
|
||||||
|
(let ((env-root (or (uiop:getenv "OPENCORTEX_ROOT")
|
||||||
|
(uiop:getenv "MEMEX_DIR")
|
||||||
|
"/home/user/memex/projects/opencortex")))
|
||||||
|
(lp-set-project-root env-root)
|
||||||
|
(setf *lp-initialized* t)
|
||||||
|
(harness-log "LITERATE PROGRAMMING: Initialized with root ~a" *lp-project-root*))))
|
||||||
|
|
||||||
|
;; Auto-initialize on load
|
||||||
|
(lp-init)
|
||||||
|
#+end_src
|
||||||
|
|
||||||
|
** Test Suite
|
||||||
|
|
||||||
|
These tests verify the LP enforcement logic. Run with:
|
||||||
|
~(fiveam:run! 'literate-programming-suite)~
|
||||||
|
|
||||||
|
#+begin_src lisp :tangle ../tests/literate-programming-tests.lisp
|
||||||
|
(defpackage :opencortex-literate-programming-tests
|
||||||
|
(:use :cl :fiveam :opencortex)
|
||||||
|
(:export #:literate-programming-suite))
|
||||||
|
|
||||||
|
(in-package :opencortex-literate-programming-tests)
|
||||||
|
|
||||||
|
(def-suite literate-programming-suite
|
||||||
|
:description "Tests for Literate Programming enforcement")
|
||||||
|
|
||||||
|
(in-suite literate-programming-suite)
|
||||||
|
|
||||||
|
(test tangle-sync-detects-stale-lisp
|
||||||
|
"check-tangle-sync returns violation when .lisp is newer than .org"
|
||||||
|
(let ((tmp-org "/tmp/test-skill.org")
|
||||||
|
(tmp-lisp "/tmp/test-skill.lisp"))
|
||||||
|
(with-open-file (f tmp-org :direction :output) (write-line "* Test" f))
|
||||||
|
(sleep 1)
|
||||||
|
(with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f))
|
||||||
|
(let* ((root (uiop:ensure-directory-pathname "/tmp/"))
|
||||||
|
(result (opencortex::check-tangle-sync root)))
|
||||||
|
(is (listp result))
|
||||||
|
(is (eq :log (getf result :type)))
|
||||||
|
(is (search "LITERATE PROGRAMMING VIOLATION" (getf (getf result :payload) :text)))
|
||||||
|
(uiop:delete-file-if-exists tmp-org)
|
||||||
|
(uiop:delete-file-if-exists tmp-lisp))))
|
||||||
|
|
||||||
|
(test tangle-sync-passes-when-synced
|
||||||
|
"check-tangle-sync returns nil when .org is newer than .lisp"
|
||||||
|
(let ((tmp-org "/tmp/test-skill2.org")
|
||||||
|
(tmp-lisp "/tmp/test-skill2.lisp"))
|
||||||
|
(with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f))
|
||||||
|
(sleep 1)
|
||||||
|
(with-open-file (f tmp-org :direction :output) (write-line "* Test" f))
|
||||||
|
(let* ((root (uiop:ensure-directory-pathname "/tmp/"))
|
||||||
|
(result (opencortex::check-tangle-sync root)))
|
||||||
|
(is (null result)))
|
||||||
|
(uiop:delete-file-if-exists tmp-org)
|
||||||
|
(uiop:delete-file-if-exists tmp-lisp)))
|
||||||
|
|
||||||
|
(test block-balance-valid
|
||||||
|
"literate-check-block-balance returns T for balanced code"
|
||||||
|
(is (eq t (opencortex::literate-check-block-balance "(defun test () t)"))))
|
||||||
|
|
||||||
|
(test block-balance-invalid
|
||||||
|
"literate-check-block-balance returns NIL for unbalanced code"
|
||||||
|
(multiple-value-bind (ok reason) (opencortex::literate-check-block-balance "(defun test ()")
|
||||||
|
(is (null ok))
|
||||||
|
(is (stringp reason))))
|
||||||
|
#+end_src
|
||||||
|
|
||||||
* See Also
|
* See Also
|
||||||
- [[file:org-skill-engineering-standards.org][Engineering Standards Skill]] - Lifecycle mandates
|
- [[file:org-skill-engineering-standards.org][Engineering Standards Skill]] - Lifecycle mandates
|
||||||
- [[file:org-skill-policy.org][Policy Skill]] - Constitutional constraints
|
- [[file:org-skill-policy.org][Policy Skill]] - Constitutional constraints
|
||||||
|
|||||||
@@ -60,30 +60,3 @@
|
|||||||
(let ((result (opencortex::engineering-standards-gate action nil)))
|
(let ((result (opencortex::engineering-standards-gate action nil)))
|
||||||
(is (listp result))
|
(is (listp result))
|
||||||
(is (eq :request (getf result :type))))))
|
(is (eq :request (getf result :type))))))
|
||||||
|
|
||||||
(test tangle-sync-detects-stale-lisp
|
|
||||||
"check-tangle-sync returns violation when .lisp is newer than .org"
|
|
||||||
(let ((tmp-org "/tmp/test-skill.org")
|
|
||||||
(tmp-lisp "/tmp/test-skill.lisp"))
|
|
||||||
(with-open-file (f tmp-org :direction :output) (write-line "* Test" f))
|
|
||||||
(sleep 1)
|
|
||||||
(with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f))
|
|
||||||
(let* ((root (uiop:ensure-directory-pathname "/tmp/"))
|
|
||||||
(result (opencortex::check-tangle-sync root)))
|
|
||||||
(when result
|
|
||||||
(is (eq :tangle-synced (opencortex::engineering-violation-rule result))))
|
|
||||||
(uiop:delete-file-if-exists tmp-org)
|
|
||||||
(uiop:delete-file-if-exists tmp-lisp)))
|
|
||||||
|
|
||||||
(test tangle-sync-passes-when-synced
|
|
||||||
"check-tangle-sync returns nil when .org is newer than .lisp"
|
|
||||||
(let ((tmp-org "/tmp/test-skill2.org")
|
|
||||||
(tmp-lisp "/tmp/test-skill2.lisp"))
|
|
||||||
(with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f))
|
|
||||||
(sleep 1)
|
|
||||||
(with-open-file (f tmp-org :direction :output) (write-line "* Test" f))
|
|
||||||
(let* ((root (uiop:ensure-directory-pathname "/tmp/"))
|
|
||||||
(result (opencortex::check-tangle-sync root)))
|
|
||||||
(is (null result)))
|
|
||||||
(uiop:delete-file-if-exists tmp-org)
|
|
||||||
(uiop:delete-file-if-exists tmp-lisp)))
|
|
||||||
|
|||||||
48
tests/literate-programming-tests.lisp
Normal file
48
tests/literate-programming-tests.lisp
Normal file
@@ -0,0 +1,48 @@
|
|||||||
|
(defpackage :opencortex-literate-programming-tests
|
||||||
|
(:use :cl :fiveam :opencortex)
|
||||||
|
(:export #:literate-programming-suite))
|
||||||
|
|
||||||
|
(in-package :opencortex-literate-programming-tests)
|
||||||
|
|
||||||
|
(def-suite literate-programming-suite
|
||||||
|
:description "Tests for Literate Programming enforcement")
|
||||||
|
|
||||||
|
(in-suite literate-programming-suite)
|
||||||
|
|
||||||
|
(test tangle-sync-detects-stale-lisp
|
||||||
|
"check-tangle-sync returns violation when .lisp is newer than .org"
|
||||||
|
(let ((tmp-org "/tmp/test-skill.org")
|
||||||
|
(tmp-lisp "/tmp/test-skill.lisp"))
|
||||||
|
(with-open-file (f tmp-org :direction :output) (write-line "* Test" f))
|
||||||
|
(sleep 1)
|
||||||
|
(with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f))
|
||||||
|
(let* ((root (uiop:ensure-directory-pathname "/tmp/"))
|
||||||
|
(result (opencortex::check-tangle-sync root)))
|
||||||
|
(is (listp result))
|
||||||
|
(is (eq :log (getf result :type)))
|
||||||
|
(is (search "LITERATE PROGRAMMING VIOLATION" (getf (getf result :payload) :text)))
|
||||||
|
(uiop:delete-file-if-exists tmp-org)
|
||||||
|
(uiop:delete-file-if-exists tmp-lisp))))
|
||||||
|
|
||||||
|
(test tangle-sync-passes-when-synced
|
||||||
|
"check-tangle-sync returns nil when .org is newer than .lisp"
|
||||||
|
(let ((tmp-org "/tmp/test-skill2.org")
|
||||||
|
(tmp-lisp "/tmp/test-skill2.lisp"))
|
||||||
|
(with-open-file (f tmp-lisp :direction :output) (write-line "(defun test () t)" f))
|
||||||
|
(sleep 1)
|
||||||
|
(with-open-file (f tmp-org :direction :output) (write-line "* Test" f))
|
||||||
|
(let* ((root (uiop:ensure-directory-pathname "/tmp/"))
|
||||||
|
(result (opencortex::check-tangle-sync root)))
|
||||||
|
(is (null result)))
|
||||||
|
(uiop:delete-file-if-exists tmp-org)
|
||||||
|
(uiop:delete-file-if-exists tmp-lisp)))
|
||||||
|
|
||||||
|
(test block-balance-valid
|
||||||
|
"literate-check-block-balance returns T for balanced code"
|
||||||
|
(is (eq t (opencortex::literate-check-block-balance "(defun test () t)"))))
|
||||||
|
|
||||||
|
(test block-balance-invalid
|
||||||
|
"literate-check-block-balance returns NIL for unbalanced code"
|
||||||
|
(multiple-value-bind (ok reason) (opencortex::literate-check-block-balance "(defun test ()")
|
||||||
|
(is (null ok))
|
||||||
|
(is (stringp reason))))
|
||||||
Reference in New Issue
Block a user