From 4025722943ae814c88da1fa8fe5778cffecce4ad Mon Sep 17 00:00:00 2001 From: colin Date: Sat, 9 Sep 2023 11:09:10 -0700 Subject: Testiere2 Add examples changed some internal names; improved some error messages Added more examples renaming exports Added New Readme --- README.org | 357 ++++++++++++++++++++++++++---------------- clpmfile | 6 - examples.lisp | 72 --------- examples/examples.lisp | 124 +++++++++++++++ examples/legacy-examples.lisp | 72 +++++++++ package.lisp | 14 -- src/legacy/README.org | 175 +++++++++++++++++++++ src/legacy/package.lisp | 14 ++ src/legacy/testiere.lisp | 115 ++++++++++++++ src/legacy/testiere.lisp~ | 115 ++++++++++++++ src/package.lisp | 21 +++ src/package.lisp~ | 16 ++ src/standard-hooks.lisp | 68 ++++++++ src/testiere.lisp | 177 +++++++++++++++++++++ testiere.asd | 16 +- testiere.lisp | 115 -------------- 16 files changed, 1131 insertions(+), 346 deletions(-) delete mode 100644 clpmfile delete mode 100644 examples.lisp create mode 100644 examples/examples.lisp create mode 100644 examples/legacy-examples.lisp delete mode 100644 package.lisp create mode 100644 src/legacy/README.org create mode 100644 src/legacy/package.lisp create mode 100644 src/legacy/testiere.lisp create mode 100644 src/legacy/testiere.lisp~ create mode 100644 src/package.lisp create mode 100644 src/package.lisp~ create mode 100644 src/standard-hooks.lisp create mode 100644 src/testiere.lisp delete mode 100644 testiere.lisp diff --git a/README.org b/README.org index 755a885..0e4ca0c 100644 --- a/README.org +++ b/README.org @@ -1,175 +1,264 @@ 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. +for the your lisp 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. +With ~testiere~, you embed test expressions directly into your +code. When you compile, those tests are run. If any tests fail, you +are dropped into the debugger where you can decide what to do. -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. +This approach has several beneifts: -Here is an example: +1. **Does Not Add Dependencies** You do not need to add ~testiere~ as + a dependency to your project. It is enough to load ~testiere~ into + your Lisp image and evoke ~(testiere:on)~. +2. **TDD** Common Lisp is a language well suited to interactive + development. Why should testing be any different? With ~testiere~ + you can test functions as you =C-c C-c= them in SLIME, or whenever + you load or compile a file. +3. **Self Documentation** Because tests are in the source (but do not + end up compiled into executable code unless ~testiere~ is "on"), + you get purposeful documentation of your code for free. Why read a + comment when there's a test!? -#+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. +Out of the box, ~testiere~ supports testing of the following: -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. +- ~defun~ +- ~defmethod~ +- ~deftype~ +- ~defclass~ +- ~defstruct~ -** 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: +** A Basic 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 +(defun add3 (x y z) + "Adds three numbers" + #+testiere + (:tests + (= 6 (add3 1 2 3)) + (:fails (add3 "hey")) + (:fails (add3 1 2))) (+ 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 +This compiles as normal. If you wish to run the tests in the +~(:tests ...)~ form, however, you need to turn testiere on. -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. +#+begin_src lisp -**** Comparator Test Specifications +(testiere:testiere-on) -: (comparator (&rest args...) value) +#+end_src -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. +Now if you try recompiling =add3= those tests will be run. -Amending the above example, we include a comparator test: +This approach lets you add tests to functions without actually +including the testiere source in your distributed code. You need only +have testiere loaded and turned on during development. +You can, of course, turn testiere off too: #+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)) + +(testiere:testiere-off) #+end_src -**** Other Test Specifications +** Tests Expressions + +Within the body of a ~(:tests ...)~ form are test expressions. + +| Expression | Description | +|----------------------------------------------------+------------------------------------------------| +| ~(:is form)~ | The test fails if ~form~ evaluates | +| | to NIL. | +|----------------------------------------------------+------------------------------------------------| +| ~(pred form1 form2)~ | E.g ~(= (foo) 10)~ Provides more | +| | informative error messages than ~:is~ | +|----------------------------------------------------+------------------------------------------------| +| ~(:funcall function arg1 ...)~ | Calls a function with some arguments. | +| | If this function signals an error, | +| | then the test fails. Useful when | +| | running many or complex tests. | +|----------------------------------------------------+------------------------------------------------| +| ~(:fails form)~ | Evaluates ~form~ and expects it to | +| | signal an error. If it does not | +| | signal an error, the test fails. | +|----------------------------------------------------+------------------------------------------------| +| ~(:signals condition form)~ | Evaluates ~form~ and expects it to | +| | signal a condition of type | +| | ~condition~. If it does not, then | +| | the test fails. | +|----------------------------------------------------+------------------------------------------------| +| ~(:let bindings test1 ...)~ | Runs test expressions in the context | +| | of some bound variables. | +|----------------------------------------------------+------------------------------------------------| +| ~(:with-defuns ((name args body) ...) tests ... )~ | Mimics ~labels~ syntax. Used for | +| | stubbing / mocking functions will which | +| | have temporary definitions for the | +| | duration of the ~:with-defuns~ form. | +|----------------------------------------------------+------------------------------------------------| +| ~(:with-generic name methods tests ... )~ | Temporarily redefine the an entire generic | +| | function for the duration of the enclosed | +| | ~tests~. ~methods~ is a list of forms, each of | +| | is essentially anything that normally follows | +| | ~(defmethod name ...)~. | +| | E.g. ~((x string) (string-upcase x))~ or | +| | ~(:after (x string) (print "after"))~ | + +** Examples -Every other form appearing in a test suite is a list that starts with -a keyword. +#+begin_src lisp +(defpackage :testiere.examples + (:use #:cl #:testiere)) -- ~(: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. +(defpackage :dummy + (:use #:cl)) +(in-package :testiere.examples) -*** Mocking and Stubbing +;;; Turn Testiere On. +(testiere-on) -The following test forms allow for the running of tests inside a -context in which certain functions or global values are bound: +;;; BASIC TESTS -Binding variables looks like +(defun add3 (x y z) + "Adds three numbers" + #+testiere + (:tests + (= 6 (add3 1 2 3)) + (:is (evenp (add3 2 2 2))) + (:fails (add3)) + (:fails (add3 1 2 "oh no"))) + (+ x y z)) -: (:let LET-BINDINGS TESTS) - -and are useful for binding dynamic variables for use during a set of -tests. +;;; Using external tests + +(defun dummy::test-add10 (n) + "Tests add10 in the same way N times. Obviously useless. We define +this in a separate package to give you an idea that you can embed +tests that aren't part of the package you're testing." + (loop :repeat n :do + (assert (= 13 (add10 3))))) + +(defun add10 (x) + "Adds 10 to X" + #+testiere + (:tests + (:funcall 'dummy::test-add10 1)) + (+ x 10)) + +;;; Adding some context to tests with :LET + +(defvar *count*) + +(defun increment-count (&optional (amount 1)) + "Increments *COUNT* by AMOUNT" + #+testiere + (:tests + (:let ((*count* 5)) + (:funcall #'increment-count) + (= *count* 6) + (:funcall #'increment-count 4) + (= *count* 10)) + (:let ((*count* -10)) + (= (increment-count) -9))) + (incf *count* amount)) + +;;; Stubbing functions with :WITH-DEFUNS + +(defun dummy::make-drakma-request (url) + "Assume this actually makes an HTTP request using drakma" + ) + +(defun test-count-words-in-response () + (assert (= 3 (count-words-in-response "blah")))) + +(defun count-words-in-response (url) + "Fetches a url and counts the words in the response." + #+testiere + (:tests + (:with-defuns + ((dummy::make-drakma-request (url) + (declare (values (simple-array character))) + "Hello there dudes")) + (= 3 (count-words-in-response "dummy-url")) + (:funcall 'test-count-words-in-response))) + (loop + :with resp string := (dummy::make-drakma-request url) + :with in-word? := nil + :for char :across resp + :when (and in-word? (not (alphanumericp char))) + :count 1 :into wc + :and :do (setf in-word? nil) + :when (alphanumericp char) + :do (setf in-word? t) + :finally (return + (if (alphanumericp char) (1+ wc) wc)))) + +;;; Testing Classes + +(defclass point () + ((x + :accessor px + :initform 0 + :initarg :x) + (y + :accessor py + :initform 0 + :initarg :y)) + #+testiere + (:tests + (:let ((pt (make-instance 'point :x 10 :y 20))) + (= 20 (py pt)) + (= 10 (px pt)) + (:is (< (px pt) (py pt)))))) + +;;; Testing Structs + +(defstruct pt + x y + #+testiere + (:tests + (:let ((pt (make-pt :x 10 :y 20))) + (= 20 (pt-y pt)) + (:is (< (pt-x pt) (pt-y pt)))))) + +;;; Testing Types + +(deftype optional-int () + #+testiere + (:tests + (:is (typep nil 'optional-int)) + (:is (typep 10 'optional-int)) + (:is (not (typep "foo" 'optional-int)))) + '(or integer null)) -For example +#+end_src -#+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. +** How does it work? -#+begin_src lisp +Under the hood, ~testiere~ defines a custom ~*macroexpand-hook*~ that +consults a registry of hooks. If a macro is found in the registery, +tests are extracted and run whenever they appear. Otherwise the hook +expands code normally. +** Extending - (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)) +Users can register ~testiere~ hooks by calling +~testiere:register-hook~ on three arguments: -#+end_src - -In the above, the temporary redefinition of ~JUST-A-FUNCTION~ is used. +1. A symbol naming a macro +2. A function designator for a function that extracts tests from a + macro call (from the ~&whole~ of a macro call), returning the + modified form and a list of the extracted test expressions. All of + the built-ins hooks use the ~testiere::standard-extractor~. +3. An optional function accepting the same ~&whole~ of the macro call, + and returning a list of restart handlers that are inserted as-is + into the body of a ~restart-case~. See =src/standard-hooks.lisp= + for examples. diff --git a/clpmfile b/clpmfile deleted file mode 100644 index 3e087ff..0000000 --- a/clpmfile +++ /dev/null @@ -1,6 +0,0 @@ -;;; -*- Mode: common-lisp; -*- -(:api-version "0.4") - -(:source "quicklisp" :url "https://beta.quicklisp.org/dist/quicklisp.txt" :type :quicklisp) - -(:asd "testiere.asd") diff --git a/examples.lisp b/examples.lisp deleted file mode 100644 index b515b98..0000000 --- a/examples.lisp +++ /dev/null @@ -1,72 +0,0 @@ -(defpackage :testiere.examples - (:use #:cl) - (:import-from #:testiere - #:defun/t - #:with-stubs)) - -(in-package :testiere.examples) - -(defun test-fibble () - (assert (= 13 (fibble 1 2)))) - -(defun/t fibble (x y &key (z 10)) - "Hey, a docstring." - :tests - (:program test-fibble) - :end - (+ x y z)) - -(defvar *count*) - -(defun/t increment-count () - "Increments the *count* variable." - :tests - (:let ((*count* 4)) - (:afterp () (lambda () (= *count* 5))) - (= () 6) - (:outputp () (lambda (x) (= x 7)))) - :end - (incf *count*)) - -(defun/t other-increment-count (&optional (amount 1)) - "Also increments the *count* variable by an optional amount." - :tests - (:let ((*count* 10)) - (= () 11)) - (:let ((*count* 0)) - (= (10) 10) - (:afterp (2) (lambda () (= *count* 12)))) - :end - (incf *count* amount)) - - -(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)) - - -(defun make-drakma-request () - "Make an HTTP request using DRAKMA" - ;; implemented elsewhere - ) - -(defun test-url-word-counter () - (with-stubs - ((make-drakma-request () "one two three four five six seven")) - (assert (= (count-words) 7)))) - -(defun/t count-words () - "Fetches a url and counts now many words the page contains." - :tests - (:program test-url-word-counter) - :end - (let ((fetched - (make-drakma-request))) - (1+ (count #\space fetched)))) diff --git a/examples/examples.lisp b/examples/examples.lisp new file mode 100644 index 0000000..a188f2f --- /dev/null +++ b/examples/examples.lisp @@ -0,0 +1,124 @@ +(defpackage :testiere.examples + (:use #:cl #:testiere)) + +(defpackage :dummy + (:use #:cl)) + +(in-package :testiere.examples) + +;;; Turn Testiere On. +(testiere-on) + +;;; BASIC TESTS + +(defun add3 (x y z) + "Adds three numbers" + #+testiere + (:tests + (= 6 (add3 1 2 3)) + (:is (evenp (add3 2 2 2))) + (:fails (add3)) + (:fails (add3 1 2 "oh no"))) + (+ x y z)) + +;;; Using external tests + +(defun dummy::test-add10 (n) + "Tests add10 in the same way N times. Obviously useless. We define +this in a separate package to give you an idea that you can embed +tests that aren't part of the package you're testing." + (loop :repeat n :do + (assert (= 13 (add10 3))))) + +(defun add10 (x) + "Adds 10 to X" + #+testiere + (:tests + (:funcall 'dummy::test-add10 1)) + (+ x 10)) + +;;; Adding some context to tests with :LET + +(defvar *count*) + +(defun increment-count (&optional (amount 1)) + "Increments *COUNT* by AMOUNT" + #+testiere + (:tests + (:let ((*count* 5)) + (:funcall #'increment-count) + (= *count* 6) + (:funcall #'increment-count 4) + (= *count* 10)) + (:let ((*count* -10)) + (= (increment-count) -9))) + (incf *count* amount)) + +;;; Stubbing functions with :WITH-DEFUNS + +(defun dummy::make-drakma-request (url) + "Assume this actually makes an HTTP request using drakma" + ) + +(defun test-count-words-in-response () + (assert (= 3 (count-words-in-response "blah")))) + +(defun count-words-in-response (url) + "Fetches a url and counts the words in the response." + #+testiere + (:tests + (:with-defuns + ((dummy::make-drakma-request (url) + (declare (values (simple-array character))) + "Hello there dudes")) + (= 3 (count-words-in-response "dummy-url")) + (:funcall 'test-count-words-in-response))) + (loop + :with resp string := (dummy::make-drakma-request url) + :with in-word? := nil + :for char :across resp + :when (and in-word? (not (alphanumericp char))) + :count 1 :into wc + :and :do (setf in-word? nil) + :when (alphanumericp char) + :do (setf in-word? t) + :finally (return + (if (alphanumericp char) (1+ wc) wc)))) + +;;; Testing Classes + +(defclass point () + ((x + :accessor px + :initform 0 + :initarg :x) + (y + :accessor py + :initform 0 + :initarg :y)) + #+testiere + (:tests + (:let ((pt (make-instance 'point :x 10 :y 20))) + (= 20 (py pt)) + (= 10 (px pt)) + (:is (< (px pt) (py pt)))))) + +;;; Testing Structs + +(defstruct pt + x y + #+testiere + (:tests + (:let ((pt (make-pt :x 10 :y 20))) + (= 20 (pt-y pt)) + (:is (< (pt-x pt) (pt-y pt)))))) + +;;; Testing Types + +(deftype optional-int () + #+testiere + (:tests + (:is (typep nil 'optional-int)) + (:is (typep 10 'optional-int)) + (:is (not (typep "foo" 'optional-int)))) + '(or integer null)) diff --git a/examples/legacy-examples.lisp b/examples/legacy-examples.lisp new file mode 100644 index 0000000..b515b98 --- /dev/null +++ b/examples/legacy-examples.lisp @@ -0,0 +1,72 @@ +(defpackage :testiere.examples + (:use #:cl) + (:import-from #:testiere + #:defun/t + #:with-stubs)) + +(in-package :testiere.examples) + +(defun test-fibble () + (assert (= 13 (fibble 1 2)))) + +(defun/t fibble (x y &key (z 10)) + "Hey, a docstring." + :tests + (:program test-fibble) + :end + (+ x y z)) + +(defvar *count*) + +(defun/t increment-count () + "Increments the *count* variable." + :tests + (:let ((*count* 4)) + (:afterp () (lambda () (= *count* 5))) + (= () 6) + (:outputp () (lambda (x) (= x 7)))) + :end + (incf *count*)) + +(defun/t other-increment-count (&optional (amount 1)) + "Also increments the *count* variable by an optional amount." + :tests + (:let ((*count* 10)) + (= () 11)) + (:let ((*count* 0)) + (= (10) 10) + (:afterp (2) (lambda () (= *count* 12)))) + :end + (incf *count* amount)) + + +(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)) + + +(defun make-drakma-request () + "Make an HTTP request using DRAKMA" + ;; implemented elsewhere + ) + +(defun test-url-word-counter () + (with-stubs + ((make-drakma-request () "one two three four five six seven")) + (assert (= (count-words) 7)))) + +(defun/t count-words () + "Fetches a url and counts now many words the page contains." + :tests + (:program test-url-word-counter) + :end + (let ((fetched + (make-drakma-request))) + (1+ (count #\space fetched)))) diff --git a/package.lisp b/package.lisp deleted file mode 100644 index 9583460..0000000 --- a/package.lisp +++ /dev/null @@ -1,14 +0,0 @@ -;;;; package.lisp - -(defpackage #:testiere - (:use #:cl) - (:import-from #:trivia #:match #:guard) - (:export #:defun/t #:with-stubs #:with-stub)) - - - - - - - - diff --git a/src/legacy/README.org b/src/legacy/README.org new file mode 100644 index 0000000..755a885 --- /dev/null +++ b/src/legacy/README.org @@ -0,0 +1,175 @@ +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 new file mode 100644 index 0000000..3724728 --- /dev/null +++ b/src/legacy/package.lisp @@ -0,0 +1,14 @@ +;;;; 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 new file mode 100644 index 0000000..010b12d --- /dev/null +++ b/src/legacy/testiere.lisp @@ -0,0 +1,115 @@ +;;;; 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~ new file mode 100644 index 0000000..b606b9f --- /dev/null +++ b/src/legacy/testiere.lisp~ @@ -0,0 +1,115 @@ +;;;; 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 new file mode 100644 index 0000000..9594019 --- /dev/null +++ b/src/package.lisp @@ -0,0 +1,21 @@ +;;;; package.lisp + +(defpackage #:testiere + (:use #:cl #:testiere.legacy) + (:import-from #:trivia #:ematch) + (:export + #:on + #:off + #:register-hook + ;; legacy + #:defun/t + #:with-stub + #:with-stubs)) + + + + + + + + diff --git a/src/package.lisp~ b/src/package.lisp~ new file mode 100644 index 0000000..bbe3e8f --- /dev/null +++ b/src/package.lisp~ @@ -0,0 +1,16 @@ +;;;; package.lisp + +(defpackage #:testiere + (:use #:cl) + (:import-from #:trivia #:ematch) + (:export #:testiere-on + #:testiere-off + #:register-testiere-hook)) + + + + + + + + diff --git a/src/standard-hooks.lisp b/src/standard-hooks.lisp new file mode 100644 index 0000000..fcf1367 --- /dev/null +++ b/src/standard-hooks.lisp @@ -0,0 +1,68 @@ +;;;; standard-hooks.lisp -- built-in hooks for standard def* macros + +(in-package :testiere) + +;;; DEFSTRUCT + +;; (defstruct moo +;; #+testiere +;; (:tests ...) +;; a b c) + +(register-hook + 'cl:defstruct + #'standard-extractor) + +;;; DEFCLASS + +;; (defclass fooar () +;; (slots...) +;; #+testiere +;; (:tests ...)) + +(defun defclass-restarts-expander (form) + (let ((name (second form))) + `((make-unbound + () + (setf (find-class ',name) nil))))) + +(register-hook + 'cl:defclass + #'standard-extractor + #'defclass-restarts-expander) + +;;; DEFMETHOD + +;; (defmethod okwhat ((x moo) (y bar) z) +;; "Here's a method" +;; #+testiere +;; (:tests ...) +;; (flah (moo-blah x) (barbar y))) + +(register-hook 'cl:defmethod #'standard-extractor) + +;;; DEFUN + +;; (defun add3 (x y z) +;; "Adds three thigns" +;; #+testiere +;; (:tests ...) +;; (+ x y z)) + +(defun defun-restarts-expander (form) + (let ((name (second form))) + `((make-unbound + () + (fmakunbound ',name))))) + +(register-hook 'cl:defun #'standard-extractor #'defun-restarts-expander) + +;;; DEFTYPE + +;; (deftype optional-number () +;; "Its a number, or not" +;; #+testiere +;; (:tests ...) +;; `(or number null)) + +(register-hook 'cl:deftype #'standard-extractor) diff --git a/src/testiere.lisp b/src/testiere.lisp new file mode 100644 index 0000000..df516e0 --- /dev/null +++ b/src/testiere.lisp @@ -0,0 +1,177 @@ +;;;; testiere.lisp -- core testiere functionality + +(in-package #:testiere) + +(defstruct testiere-hook + ;; a function that extracts '(:tests ...), returning them and the modified form + (extractor nil) + ;; a function that accepts a form and returns a list of restart handlers + (restarts-expander nil)) + +(defvar *testiere-hooks* + (make-hash-table) + "Registry of macro functions and testiere-hook") + +(defun register-hook (macro extractor &optional restarts-expander) + "Register a new hook for use with testiere. + +MACRO is a symbol naming a macro-function + +EXTRACTOR is a function of one argument, FORM representing the &WHOLE +of the macro-function call. It returns two values: a modified s form +identical with FORM except (:tests ...) forms have been +removed. The second value should be the conatenation of the CDRs of +these (:tests ...) forms. + +RESTARTS-EXPANDER is an optional functionof one argument. It returns +the restart handler clauses of a RESTART-CASE form. These are the +restarts to try when tests fail." + (setf (gethash (macro-function macro) *testiere-hooks*) + (make-testiere-hook + :extractor extractor + :restarts-expander restarts-expander))) + +(defvar *cached-macroexpand-hook* nil) + +(defun testiere-hook (expander form environment) + (let* ((hook + (gethash expander *testiere-hooks*))) + (cond + (hook + (with-slots (extractor restarts-expander) hook + (multiple-value-bind (form test-forms) (funcall extractor form) + (if test-forms + (let ((tests (expand-test-forms test-forms))) + (if restarts-expander + `(prog1 ,(funcall expander form environment) + (restart-case (progn ,@tests) + ,@(funcall restarts-expander form))) + `(prog1 ,(funcall expander form environment) + ,@tests))) + (funcall expander form environment))))) + (t + (funcall expander form environment))))) + +(defun expand-test-forms (forms) + (mapcar #'expand-test-form forms)) + +(defun expand-test-form (form) + (ematch form + ((list :fails failing-form) + `(assert (handler-case (progn ,failing-form nil) + (error () t)) + () + "~s should have signalled an error but did not." + ',failing-form)) + + ((list :signals condition signalling-form) + `(assert (handler-case (progn ,signalling-form) + (,condition () t) + (condition () nil)) + () + "~s should have signalled ~s but did not." + ',condition)) + + ((list* :funcall function args) + `(funcall ,function ,@args)) + + ((list* :with-defuns (list* stubs) body) + (expand-defun-stubs stubs body)) + + ((list* :with-generic name (list* method-stubs) body) + (expand-generic-stub name method-stubs body)) + + ((list* :let (list* bindings) body) + `(let ,bindings ,@(expand-test-forms body))) + + ((list :is form) + `(assert ,form () "~s failed" ',form)) + + ((list comparator a b) + (let ((a-result (gensym)) + (b-result (gensym)) + (pred-result (gensym))) + `(let* ((,a-result ,a) + (,b-result ,b) + (,pred-result (,comparator ,a-result ,b-result))) + (assert ,pred-result () "~s failed with ~s" + ',form + (list ',comparator ,a-result ,b-result))))))) + +(defun expand-defun-stubs (defs body) + (let* ((redef-names + (mapcar #'car defs)) + + (defun-cache + (loop :for name :in redef-names + :collect `(cons ',name + (and (fboundp ',name) + (fdefinition ',name))))) + + (defun-cache-var + (gensym "DEFUN-CACHE")) + + (defun-redefs + (loop :for (name lambda-list . fbod) :in defs + :collect `(setf (fdefinition ',name) + (lambda ,lambda-list ,@fbod)))) + + (defun-restore + (loop :for name :in redef-names + :collect `(if (cdr (assoc ',name ,defun-cache-var)) + (setf (fdefinition ',name) + (cdr (assoc ',name ,defun-cache-var))) + (fmakunbound ',name))))) + `(let ((,defun-cache-var (list ,@defun-cache))) + (unwind-protect + (progn ,@defun-redefs + ,@(expand-test-forms body)) + ,@defun-restore)))) + +(defun expand-generic-stub (name method-stubs body) + (let* ((orig-generic + (gensym "DEFGENERIC-CACHE")) + + (method-defs + (loop :for stub :in method-stubs + :collect `(defmethod ,name ,@stub)))) + + `(let ((,orig-generic (and (fboundp ',name) (fdefinition ',name)))) + (unwind-protect + (progn + ,@method-defs + ,@(expand-test-forms body)) + (when ,orig-generic + (setf (fdefinition ',name) ',orig-generic)))))) + + +(defun standard-extractor (orig-form) + "A somewhat naive default test form extractor. Returns two values, +orig-form without test forms included, and a collection of test forms." + (loop + :for form :in orig-form + :when (and (listp form) + (eq :tests (first form))) + :append (cdr form) :into tests-forms + :else + :collect form :into defun-form + :finally (return (values defun-form tests-forms)))) + + +(defun on () + (unless (member :testiere *features*) + (pushnew :testiere *features*) + (setf + *cached-macroexpand-hook* *macroexpand-hook* + *macroexpand-hook* 'testiere-hook ))) + +(defun off () + (when (member :testiere *features*) + (setf *features* (delete :testiere *features*)) + (setf *macroexpand-hook* *cached-macroexpand-hook* + *cached-macroexpand-hook* nil))) + + + + + diff --git a/testiere.asd b/testiere.asd index 3db3701..147b556 100644 --- a/testiere.asd +++ b/testiere.asd @@ -1,11 +1,17 @@ ;;;; testiere.asd (asdf:defsystem #:testiere - :description "Interactive Testing for DEFUN" - :author "Colin Okay " + :description "TDD system for Common Lisp" + :author "Colin OKeefe " :license "GPLv3" - :version "0.1.0" + :version "1.0.0" :depends-on (:trivia) + :pathname "src/" :serial t - :components ((:file "package") - (:file "testiere"))) + :components ((:module "legacy" + :serial t + :components ((:file "package") + (:file "testiere"))) + (:file "package") + (:file "testiere") + (:file "standard-hooks"))) diff --git a/testiere.lisp b/testiere.lisp deleted file mode 100644 index b606b9f..0000000 --- a/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)))))))) - - - - -- cgit v1.2.3