diff --git a/lisp/programming-lisp.lisp b/lisp/programming-lisp.lisp index 16b7719..933a126 100644 --- a/lisp/programming-lisp.lisp +++ b/lisp/programming-lisp.lisp @@ -146,78 +146,3 @@ (defskill :passepartout-programming-lisp :priority 400 :trigger (lambda (ctx) (declare (ignore ctx)) nil)) - -(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 - (is (eq t (passepartout:lisp-structural-check "(+ 1 2)")))) - -(test structural-unbalanced-open - (multiple-value-bind (ok reason) (passepartout:lisp-structural-check "(+ 1 2") - (is (null ok)) - (is (search "Reader Error" reason)))) - -(test structural-unbalanced-close - (multiple-value-bind (ok reason) (passepartout:lisp-structural-check "+ 1 2)") - (is (null ok)) - (is (search "Reader Error" reason)))) - -(test syntactic-valid - (is (eq t (passepartout:lisp-syntactic-check "(+ 1 2)")))) - -(test semantic-safe - (is (eq t (passepartout:lisp-semantic-check "(+ 1 2)")))) - -(test semantic-blocked-eval - (multiple-value-bind (ok reason) (passepartout:lisp-semantic-check "(eval '(+ 1 2))") - (is (null ok)) - (is (search "Unsafe" reason)))) - -(test unified-success - (let ((result (passepartout:lisp-validate "(+ 1 2)" :strict t))) - (is (eq (getf result :status) :success)))) - -(test unified-failure - (let ((result (passepartout:lisp-validate "(+ 1 2" :strict nil))) - (is (eq (getf result :status) :error)))) - -(test eval-basic - (let ((result (passepartout:lisp-eval "(+ 1 2)"))) - (is (eq (getf result :status) :success)) - (is (string= (getf result :result) "3")))) - -(test structural-extract - (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 - (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 - (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 - (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))))))) diff --git a/lisp/programming-org.lisp b/lisp/programming-org.lisp index 93a7c02..8575f5c 100644 --- a/lisp/programming-org.lisp +++ b/lisp/programming-org.lisp @@ -16,9 +16,9 @@ (some (lambda (tag) (some (lambda (private-tag) (string-equal (string-trim '(#\: #\space) tag) - (string-trim '(#\: #\space) private-tag)) + (string-trim '(#\: #\space) private-tag))) privacy-tags)) - tags-list))))) + tags-list)))) (defun org-privacy-strip (content) "Removes Org headlines whose :TAGS: property contains a privacy-filtered tag. @@ -217,7 +217,7 @@ AST format: (:TYPE :HEADLINE :properties (:ID ... :TITLE ... :TAGS (...)) ;; Headline (setf output (format nil "~a~@[ ~a~] ~a" stars todo title)) (when tags - (let ((tag-str (format nil "~{~a~^:~}" (mapcar (lambda (t) (string-trim '(#\:) t)) tags)))) + (let ((tag-str (format nil "~{~a~^:~}" (mapcar (lambda (tag) (string-trim '(#\:) tag)) tags)))) (setf output (concatenate 'string output (format nil " :~a::~%" tag-str)))) (setf output (concatenate 'string output (string #\Newline)))) (unless tags @@ -242,38 +242,3 @@ AST format: (:TYPE :HEADLINE :properties (:ID ... :TITLE ... :TAGS (...)) (defskill :passepartout-programming-org :priority 100 :trigger (lambda (ctx) (declare (ignore ctx)) nil)) - -(defpackage :passepartout-utils-org-tests - (:use :cl :fiveam :passepartout) - (:export #:utils-org-suite)) - -(in-package :passepartout-utils-org-tests) - -(def-suite utils-org-suite - :description "Tests for Utils Org skill.") - -(in-suite utils-org-suite) - -(test id-generation - (let ((id1 (org-id-generate)) - (id2 (org-id-generate))) - (is (plusp (length id1))) - (is (not (string= id1 id2))))) - -(test id-format - (let ((formatted (org-id-format "abc12345"))) - (is (search "id:" formatted)))) - -(test property-setter - (let ((ast (list :type :HEADLINE - :properties (list :ID "id:test123" :TITLE "Test") - :contents nil))) - (org-property-set ast "id:test123" :STATUS "ACTIVE") - (is (string= (getf (getf ast :properties) :STATUS) "ACTIVE")))) - -(test todo-setter - (let ((ast (list :type :HEADLINE - :properties (list :ID "id:todo001" :TITLE "Task") - :contents nil))) - (org-todo-set ast "id:todo001" "DONE") - (is (string= (getf (getf ast :properties) :TODO) "DONE")))) diff --git a/lisp/system-archivist.lisp b/lisp/system-archivist.lisp index 8ad2d30..f9479fe 100644 --- a/lisp/system-archivist.lisp +++ b/lisp/system-archivist.lisp @@ -60,7 +60,7 @@ Returns a list of plists: (:title :content :tags )." (setf in-properties nil)) (when (and in-properties (uiop:string-prefix-p ":TAGS:" trimmed)) (setf current-tags - (mapcar (lambda (t) (string-trim '(#\Space) t)) + (mapcar (lambda (tag) (string-trim '(#\Space) tag)) (uiop:split-string (string-trim '(#\Space) (subseq trimmed 6)) :separator '(#\space #\tab))))) (cond diff --git a/lisp/system-memory.lisp b/lisp/system-memory.lisp index d320dae..061ce5f 100644 --- a/lisp/system-memory.lisp +++ b/lisp/system-memory.lisp @@ -15,16 +15,16 @@ Returns a plist: (:total :by-type :by-todo (orphans 0)) (maphash (lambda (id obj) (setf (gethash id all-ids) t) - (let ((t (memory-object-type obj)) + (let ((obj-type (memory-object-type obj)) (attrs (memory-object-attributes obj)) (v (memory-object-version obj))) - (unless (and type-filter (not (eq t type-filter))) + (unless (and type-filter (not (eq obj-type type-filter))) (let ((todo (getf attrs :TODO-STATE))) (when (and todo-filter (not (string-equal todo todo-filter))) (return nil))) (incf total) - (incf (gethash t type-counts 0)) + (incf (gethash obj-type type-counts 0)) (let ((todo (getf attrs :TODO-STATE))) (when todo (incf (gethash todo todo-counts 0)))) diff --git a/org/programming-lisp.org b/org/programming-lisp.org index fb955c5..e9ab9bd 100644 --- a/org/programming-lisp.org +++ b/org/programming-lisp.org @@ -215,7 +215,7 @@ The skill has four layers: * Test Suite Tests for the Lisp Validator structural, syntactic, and semantic gates. -#+begin_src lisp :tangle ../lisp/programming-lisp.lisp +#+begin_src lisp :tangle ../tests/programming-lisp-tests.lisp (defpackage :passepartout-utils-lisp-tests (:use :cl :fiveam :passepartout) (:export #:utils-lisp-suite)) diff --git a/org/programming-org.org b/org/programming-org.org index 56f3624..3087357 100644 --- a/org/programming-org.org +++ b/org/programming-org.org @@ -33,9 +33,9 @@ Structural manipulation tools for Org-mode files. This skill handles reading, wr (some (lambda (tag) (some (lambda (private-tag) (string-equal (string-trim '(#\: #\space) tag) - (string-trim '(#\: #\space) private-tag)) + (string-trim '(#\: #\space) private-tag))) privacy-tags)) - tags-list))))) + tags-list)))) #+end_src ** org-privacy-strip @@ -299,7 +299,7 @@ AST format: (:TYPE :HEADLINE :properties (:ID ... :TITLE ... :TAGS (...)) ;; Headline (setf output (format nil "~a~@[ ~a~] ~a" stars todo title)) (when tags - (let ((tag-str (format nil "~{~a~^:~}" (mapcar (lambda (t) (string-trim '(#\:) t)) tags)))) + (let ((tag-str (format nil "~{~a~^:~}" (mapcar (lambda (tag) (string-trim '(#\:) tag)) tags)))) (setf output (concatenate 'string output (format nil " :~a::~%" tag-str)))) (setf output (concatenate 'string output (string #\Newline)))) (unless tags @@ -331,7 +331,10 @@ AST format: (:TYPE :HEADLINE :properties (:ID ... :TITLE ... :TAGS (...)) * Test Suite Verification of the structural manipulation for Org-mode files and their AST representation. -#+begin_src lisp :tangle ../lisp/programming-org.lisp +#+begin_src lisp :tangle ../tests/programming-org-tests.lisp +(eval-when (:compile-toplevel :load-toplevel :execute) + (ignore-errors (ql:quickload :fiveam :silent t))) + (defpackage :passepartout-utils-org-tests (:use :cl :fiveam :passepartout) (:export #:utils-org-suite)) diff --git a/org/system-archivist.org b/org/system-archivist.org index 52f5966..ed01fc5 100644 --- a/org/system-archivist.org +++ b/org/system-archivist.org @@ -104,7 +104,7 @@ Returns a list of plists: (:title :content :tags )." (setf in-properties nil)) (when (and in-properties (uiop:string-prefix-p ":TAGS:" trimmed)) (setf current-tags - (mapcar (lambda (t) (string-trim '(#\Space) t)) + (mapcar (lambda (tag) (string-trim '(#\Space) tag)) (uiop:split-string (string-trim '(#\Space) (subseq trimmed 6)) :separator '(#\space #\tab))))) (cond diff --git a/org/system-memory.org b/org/system-memory.org index bb20e03..21526f5 100644 --- a/org/system-memory.org +++ b/org/system-memory.org @@ -29,16 +29,16 @@ Returns a plist: (:total :by-type :by-todo (orphans 0)) (maphash (lambda (id obj) (setf (gethash id all-ids) t) - (let ((t (memory-object-type obj)) + (let ((obj-type (memory-object-type obj)) (attrs (memory-object-attributes obj)) (v (memory-object-version obj))) - (unless (and type-filter (not (eq t type-filter))) + (unless (and type-filter (not (eq obj-type type-filter))) (let ((todo (getf attrs :TODO-STATE))) (when (and todo-filter (not (string-equal todo todo-filter))) (return nil))) (incf total) - (incf (gethash t type-counts 0)) + (incf (gethash obj-type type-counts 0)) (let ((todo (getf attrs :TODO-STATE))) (when todo (incf (gethash todo todo-counts 0))))