diff options
| -rw-r--r-- | CHANGELOG.md | 5 | ||||
| -rw-r--r-- | src/legacy/README.org | 175 | ||||
| -rw-r--r-- | src/legacy/package.lisp | 14 | ||||
| -rw-r--r-- | src/legacy/testiere.lisp | 115 | ||||
| -rw-r--r-- | src/legacy/testiere.lisp~ | 115 | ||||
| -rw-r--r-- | src/package.lisp | 1 | ||||
| -rw-r--r-- | src/testiere.lisp | 63 | ||||
| -rw-r--r-- | testiere-examples.asd | 9 | ||||
| -rw-r--r-- | testiere.asd | 6 |
9 files changed, 80 insertions, 423 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md new file mode 100644 index 0000000..8fcc9d2 --- /dev/null +++ b/CHANGELOG.md @@ -0,0 +1,5 @@ + 1.3.1 + ----- + + - Removed trivia dependency + diff --git a/src/legacy/README.org b/src/legacy/README.org deleted file mode 100644 index 755a885..0000000 --- a/src/legacy/README.org +++ /dev/null @@ -1,175 +0,0 @@ -A [[https://en.wiktionary.org/wiki/testiere][testiere]] is armor for the head of a horse and ~testiere~ is armor -for the head of your ~defun~ forms. - -* Testiere - -With ~testiere~ you can program in an interactive TDD-like -fashion. Tests are included at the top of a ~defun/t~ form. When you -recompile your functions interactively, the tests are run. If any -fail, you are dropped into a debugger where you can decide to revert -the definition to the last known working version, or you can choose to -unbind it altogether. - -The system supports mocking and stubbing in your tests, so that you -can, e.g. test the system in different dynamic contexts or by mocking -network request functions. - -Here is an example: - -#+begin_src lisp - -(defun/t sum-3 (x y &key (z 10)) - "Sums three numbers, Z has a default value of 10" - :tests - (:program some-test-function) - (= (1 2) 13) ; (sum-3 1 2) == 13 - (= (1 2 :z 3) 6) ; (sum-3 1 2 :z 3) == 6 - (:outputp (0 0) ; tests that (sum-3 0 0) passes the predicate - (lambda (result) (= 10 result))) - (:fails ; ensures that (sum-3 "strings" "ain't" :z "numbers") fails - ("strings" "ain't" :z "numbers")) - :end - (+ x y z)) - -#+end_src - -In the above, a function ~sum-3~ is defined with five embedded -tests. The test specification syntax is detailed below. If any of the -tests fail, the function will not be redefined and you will drop into -the debugger, which asks you how you'd like to proceed. - -The approach to TDD-like development taking by ~testiere~ may not be -appropriate to all circumstances, but it is good for interactive -development of interactive applications (😉) whose "main loop" -involves a good sized collection of unit-testable functions. - -** Test Specification - -There are a few kinds of tests available. - -*** For the Impatient, Just Use =:program= Tests - -Most users will probably benefit from the ~:program~ style test. Here -is a quick example: - -#+begin_src lisp - -(defun test-fibble () - (assert (= 13 (fibble 1 2)))) - -(defun/t fibble (x y &key (z 10)) - "Adds three numbers, one of which defaults to 10." - :tests - (:program test-fibble) - :end - (+ x y z)) - -#+end_src - -In the above test, we insist that the ~test-fibble~ function not -signal an error condition in order for ~fibble~ to be successfully -(re)compiled. - -*** Basic Test Specifications - -A test suite is a list of forms that appear between ~:tests~ and -~:end~ in the body of a ~defun/t~ form. The test suite must appear -after any optional docstring and before the function body actually -begins. - -A catalog of test form specifications follows. - -**** Comparator Test Specifications - -: (comparator (&rest args...) value) - -The ~comparator~ should be the name of a binary predicate (like ~<~ or -~eql~). These tests proceed by calling ~(comparator (apply my-fun args) value)~ -If the comparison fails, an error condition is signaled. - -Amending the above example, we include a comparator test: - - -#+begin_src lisp -(defun/t fibble (x y &key (z 10)) - "Adds three numbers, one of which defaults to 10." - :tests - (:program test-fibble) - (= (0 0 :z 30) 30) ; (assert (= (fibble 0 0 :z 30) 30)) - :end - (+ x y z)) - -#+end_src - -**** Other Test Specifications - -Every other form appearing in a test suite is a list that starts with -a keyword. - -- ~(:program FUNCTION-NAME ARGS...)~ runs a function named - FUNCTION-NAME with arguments ARGS. This function is meant to act as - a test suite for the function being defined with defun/t. It may - call that function and ASSERT things about it. -- ~(:outputp (..ARGS...) PREDICATE)~ asserts that the output passes - the one-argument predicate. -- ~(:afterp (...ARGS...) THUNK)~ asserts that the thunk should return - non-nil after the function has run. Good for testing values of - dynamic variables that the function might interact with. -- ~(:fails (...ARGS...))~ asserts that the function will produce an - error with the given arguments. -- ~(:signals (...ARGS...) CONDITION)~ where ~CONDITION~ is the name of - a condition. Asserts that the function will signal a condition of - the supplied type when called with the provided arguments. - - -*** Mocking and Stubbing - -The following test forms allow for the running of tests inside a -context in which certain functions or global values are bound: - -Binding variables looks like - -: (:let LET-BINDINGS TESTS) - -and are useful for binding dynamic variables for use during a set of -tests. - -For example - -#+begin_src lisp - - (defvar *count*) - - (defun/t increment-count () - "Increments the *count* variable." - :tests - (:let ((*count* 4)) - (:afterp () (lambda () (= *count* 5))) ; 5 after the first call - (= () 6) ; 6 after the second - (:outputp () (lambda (x) (= x 7)))) ; and 7 after the third - :end - (incf *count*)) -#+end_src - -The ~:with-stubs~ form is similar, except that it binds temporary -values to functions that might be called by the form in -questions. Useful for mocking. - -#+begin_src lisp - - - (defun just-a-function () - (print "Just a function.")) - - (defun/t call-just-a-function () - "Calls JUST-A-FUNCTION." - :tests - (:with-stubs ((just-a-function () (print "TEMP JUST-A-FUNCTION."))) - (equal () "TEMP JUST-A-FUNCTION.")) - :end - (just-a-function)) - -#+end_src - -In the above, the temporary redefinition of ~JUST-A-FUNCTION~ is used. - diff --git a/src/legacy/package.lisp b/src/legacy/package.lisp deleted file mode 100644 index 3724728..0000000 --- a/src/legacy/package.lisp +++ /dev/null @@ -1,14 +0,0 @@ -;;;; package.lisp - -(defpackage #:testiere.legacy - (:use #:cl) - (:import-from #:trivia #:match) - (:export #:defun/t #:with-stubs #:with-stub)) - - - - - - - - diff --git a/src/legacy/testiere.lisp b/src/legacy/testiere.lisp deleted file mode 100644 index 010b12d..0000000 --- a/src/legacy/testiere.lisp +++ /dev/null @@ -1,115 +0,0 @@ -;;;; testiere.lisp - -(in-package #:testiere.legacy) - -(defun build-test (name spec) - (match spec - ((list :fails inputs) - `(assert - (handler-case (progn (,name ,@inputs) nil) - (error (e) (declare (ignore e)) t)))) - - ((list :signals inputs condition) - `(assert - (handler-case (progn (,name ,@inputs) nil) - (,condition (c) (declare (ignore c)) t) - (condition (c) (declare (ignore c)) nil)))) - - ((list* :program function-name args) - `(when (fboundp ',function-name) - (funcall ',function-name ,@args))) - - ((list* :with-stubs redefs more-specs) - (let* ((assoc-vars - (loop for (stub-name . more) in redefs - collect (list stub-name (gensym (symbol-name stub-name))))) - (cache-binding-forms - (loop for (stub-name tmp-var) in assoc-vars - collect `(,tmp-var (fdefinition ',stub-name)))) - (redef-forms - (loop for (stub-name lambda-list . body) in redefs - collect `(setf (fdefinition ',stub-name) - (function (lambda ,lambda-list ,@body))))) - (clean-up - (loop for (stub-name . more) in redefs - for binding = (assoc stub-name assoc-vars) - collect `(setf (fdefinition ',stub-name) ,(second binding))))) - `(let ,cache-binding-forms - (unwind-protect - (progn - ,@redef-forms - ,@(mapcar (lambda (s) (build-test name s)) more-specs)) - ,@clean-up)))) - ((list* :let bindings more-specs) - `(let ,bindings - ,@(mapcar (lambda (s) (build-test name s)) more-specs))) - ((list :afterp inputs thunk-test) - `(progn (,name ,@inputs) - (assert (funcall ,thunk-test)))) - ((list :outputp inputs output-test) - `(assert (funcall ,output-test (,name ,@inputs)))) - ((list comparator-function inputs expected-output) - `(assert (,comparator-function (,name ,@inputs) ,expected-output))))) - -(defun extract-tests (name body) - (let ((end-pos (position :end body)) - (start-pos (position :tests body))) - (when (and end-pos start-pos) - (let ((specs (subseq body (1+ start-pos) end-pos)) - (before (subseq body 0 start-pos)) - (after (nthcdr (1+ end-pos) body))) - (list (mapcar (lambda (spec) (build-test name spec)) specs) - (append before after)))))) - -(defmacro with-stub ((name lambda-list &body body) &body forms) - "Runs forms in a context where NAME is temporarily rebound to a -different function. If NAME is not FBOUNDP then it is temporarily -defined." - (let ((cached (gensym))) - `(let ((,cached - (when (fboundp ',name) - (fdefinition ',name)))) - (unwind-protect - (progn - (setf (fdefinition ',name) - (lambda ,lambda-list ,@body)) - ,@forms) - (if ,cached - (setf (fdefinition ',name) - ,cached) - (fmakunbound ',name)))))) - -(defmacro with-stubs (redefinitions &body forms) - "Like WITH-STUB, but REDEFINITIONS is a list of (NAME LAMBDA-LIST -. BODY) list, suitable for defining a function." - (loop - with inner = `(progn ,@forms) - for (name lambda-list . body) in (reverse redefinitions) - do (setf inner `(with-stub (,name ,lambda-list ,@body) - ,inner)) - finally (return inner))) - - -(defmacro defun/t (name lambda-list &body body) - "Like regular DEFUN, but with embedded unit tests. If those tests - would fail, the function fails to be defined. " - (destructuring-bind (tests function-body) (extract-tests name body) - (let ((cached (gensym))) - `(let ((,cached - (when (fboundp ',name) - (fdefinition ',name)))) - (restart-case - (eval-when (:compile-toplevel :load-toplevel :execute) - (progn - (defun ,name ,lambda-list ,@function-body) - ,@tests)) - (make-unbound () (fmakunbound ',name)) - (revert-to-last-good-version () - (if ,cached - (setf (symbol-function ',name) - ,cached) - (fmakunbound ',name)))))))) - - - - diff --git a/src/legacy/testiere.lisp~ b/src/legacy/testiere.lisp~ deleted file mode 100644 index b606b9f..0000000 --- a/src/legacy/testiere.lisp~ +++ /dev/null @@ -1,115 +0,0 @@ -;;;; testiere.lisp - -(in-package #:testiere) - -(defun build-test (name spec) - (match spec - ((list :fails inputs) - `(assert - (handler-case (progn (,name ,@inputs) nil) - (error (e) (declare (ignore e)) t)))) - - ((list :signals inputs condition) - `(assert - (handler-case (progn (,name ,@inputs) nil) - (,condition (c) (declare (ignore c)) t) - (condition (c) (declare (ignore c)) nil)))) - - ((list* :program function-name args) - `(when (fboundp ',function-name) - (funcall ',function-name ,@args))) - - ((list* :with-stubs redefs more-specs) - (let* ((assoc-vars - (loop for (stub-name . more) in redefs - collect (list stub-name (gensym (symbol-name stub-name))))) - (cache-binding-forms - (loop for (stub-name tmp-var) in assoc-vars - collect `(,tmp-var (fdefinition ',stub-name)))) - (redef-forms - (loop for (stub-name lambda-list . body) in redefs - collect `(setf (fdefinition ',stub-name) - (function (lambda ,lambda-list ,@body))))) - (clean-up - (loop for (stub-name . more) in redefs - for binding = (assoc stub-name assoc-vars) - collect `(setf (fdefinition ',stub-name) ,(second binding))))) - `(let ,cache-binding-forms - (unwind-protect - (progn - ,@redef-forms - ,@(mapcar (lambda (s) (build-test name s)) more-specs)) - ,@clean-up)))) - ((list* :let bindings more-specs) - `(let ,bindings - ,@(mapcar (lambda (s) (build-test name s)) more-specs))) - ((list :afterp inputs thunk-test) - `(progn (,name ,@inputs) - (assert (funcall ,thunk-test)))) - ((list :outputp inputs output-test) - `(assert (funcall ,output-test (,name ,@inputs)))) - ((list comparator-function inputs expected-output) - `(assert (,comparator-function (,name ,@inputs) ,expected-output))))) - -(defun extract-tests (name body) - (let ((end-pos (position :end body)) - (start-pos (position :tests body))) - (when (and end-pos start-pos) - (let ((specs (subseq body (1+ start-pos) end-pos)) - (before (subseq body 0 start-pos)) - (after (nthcdr (1+ end-pos) body))) - (list (mapcar (lambda (spec) (build-test name spec)) specs) - (append before after)))))) - -(defmacro with-stub ((name lambda-list &body body) &body forms) - "Runs forms in a context where NAME is temporarily rebound to a -different function. If NAME is not FBOUNDP then it is temporarily -defined." - (let ((cached (gensym))) - `(let ((,cached - (when (fboundp ',name) - (fdefinition ',name)))) - (unwind-protect - (progn - (setf (fdefinition ',name) - (lambda ,lambda-list ,@body)) - ,@forms) - (if ,cached - (setf (fdefinition ',name) - ,cached) - (fmakunbound ',name)))))) - -(defmacro with-stubs (redefinitions &body forms) - "Like WITH-STUB, but REDEFINITIONS is a list of (NAME LAMBDA-LIST -. BODY) list, suitable for defining a function." - (loop - with inner = `(progn ,@forms) - for (name lambda-list . body) in (reverse redefinitions) - do (setf inner `(with-stub (,name ,lambda-list ,@body) - ,inner)) - finally (return inner))) - - -(defmacro defun/t (name lambda-list &body body) - "Like regular DEFUN, but with embedded unit tests. If those tests - would fail, the function fails to be defined. " - (destructuring-bind (tests function-body) (extract-tests name body) - (let ((cached (gensym))) - `(let ((,cached - (when (fboundp ',name) - (fdefinition ',name)))) - (restart-case - (eval-when (:compile-toplevel :load-toplevel :execute) - (progn - (defun ,name ,lambda-list ,@function-body) - ,@tests)) - (make-unbound () (fmakunbound ',name)) - (revert-to-last-good-version () - (if ,cached - (setf (symbol-function ',name) - ,cached) - (fmakunbound ',name)))))))) - - - - diff --git a/src/package.lisp b/src/package.lisp index ce58b63..ec5b5fe 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -2,7 +2,6 @@ (defpackage #:testiere (:use #:cl) - (:import-from #:trivia #:ematch) (:export #:on #:off diff --git a/src/testiere.lisp b/src/testiere.lisp index 451d886..5255ed3 100644 --- a/src/testiere.lisp +++ b/src/testiere.lisp @@ -138,7 +138,68 @@ restarts to try when tests fail." (defun expand-test-forms (key forms) (loop :for form :in forms :collect (expand-test-form key form))) + (defun expand-test-form (key form) + (assert (and (listp form) form) (form) "Form must be a non-null list, not ~s" form) + (case (first form) + (:fails + `(unless (handler-case (progn ,(second form) nil) + (error () t)) + (failed ',key "~s should have signalled an error but did not." + ',(second form)))) + (:signals + `(unless (handler-case (progn ,(third form)) + (,(second form) () t) + (condition () nil)) + (failed ',key "~s should have signalled ~s but did not." + ',(third form) + ',(second form)))) + + (:funcall + (let ((err (gensym "ERROR-"))) + `(handler-case (funcall ,(second form) ,@(cddr form)) + (error (,err) (failed ',key "~s signalled an error: ~s" + '(funcall ,(second form) ,@(cddr form)) + ,err))))) + + (:with-defuns + (assert (listp (second form)) + (form) + "stubbed defuns must be a list alá labels, not ~s" + (second form)) + (expand-defun-stubs key (second form) (cddr form))) + + (:with-generic + (assert (listp (third form)) (form) + "stubbed generic must be a list as per defgeneric bodies, not ~s" + (third form)) + (expand-generic-stub key (second form) (third form) (cdddr form))) + + (:let `(let ,(second form) ,@(expand-test-forms key (cddr form)))) + + (:do + (let ((err (gensym "ERROR-"))) + `(handler-case ,(second form) + (error (,err) + (failed ',key "Side effecting code ~s signalled an error ~s" + ',(second form) ,err))))) + + (:is + `(unless ,(second form) + (failed ',key "~s returned NIL" ',(second form)))) + + (t + (destructuring-bind (comparator a b) form + (let ((left (gensym "LEFT-")) + (right (gensym "RIGHT-")) + (pred-result (gensym "RESULT-"))) + `(let* ((,left ,a) + (,right ,b) + (,pred-result (,comparator ,left ,right))) + (unless ,pred-result + (failed ',key "~s is NIL" ',form)))))))) + +#+off(defun expand-test-form (key form) (ematch form ((list :fails failing-form) `(unless (handler-case (progn ,failing-form nil) @@ -254,3 +315,5 @@ restarts to try when tests fail." + + diff --git a/testiere-examples.asd b/testiere-examples.asd new file mode 100644 index 0000000..2f919cf --- /dev/null +++ b/testiere-examples.asd @@ -0,0 +1,9 @@ +(asdf:defsystem #:testiere-examples + :description "A demo of testiere" + :author "Colin <colin@cicadas.surf>" + :license "GPLv3" + :version "0.0.1" + :depends-on (:testiere) + :pathname "examples/" + :serial t + :components ((:file "examples"))) diff --git a/testiere.asd b/testiere.asd index 3703823..f3748c3 100644 --- a/testiere.asd +++ b/testiere.asd @@ -2,12 +2,12 @@ (asdf:defsystem #:testiere :description "TDD system for Common Lisp" - :author "Colin OKeefe <colin@cicadas.surf>" + :author "Colin <colin@cicadas.surf>" :license "GPLv3" - :version "1.3.0" - :depends-on (:trivia) + :version "1.3.1" :pathname "src/" :serial t :components ((:file "package") (:file "testiere") (:file "standard-hooks"))) + |