Testiere2

Add examples

changed some internal names; improved some error messages

Added more examples

renaming exports

Added New Readme

13 files changed, 932 insertions, 147 deletions

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/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.lisp b/examples/legacy-examples.lisp
index b515b98..b515b98 100644
--- a/examples.lisp
+++ b/examples/legacy-examples.lisp
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/package.lisp b/src/legacy/package.lisp
index 9583460..3724728 100644
--- a/package.lisp
+++ b/src/legacy/package.lisp
@@ -1,8 +1,8 @@
 ;;;; package.lisp
 
-(defpackage #:testiere
+(defpackage #:testiere.legacy
   (:use #:cl)
-  (:import-from #:trivia #:match #:guard)
+  (: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/testiere.lisp b/src/legacy/testiere.lisp~
index b606b9f..b606b9f 100644
--- a/testiere.lisp
+++ b/src/legacy/testiere.lisp~
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 <colin@cicadas.surf>"
+  :description "TDD system for Common Lisp"
+  :author "Colin OKeefe <colin@cicadas.surf>"
   :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")))