[feature] added with-stubs, updated [docs]

4 files changed, 94 insertions, 14 deletions

diff --git a/README.md b/README.md
index cc6a244..fbae172 100644
--- a/README.md
+++ b/README.md
@@ -12,13 +12,15 @@ during interactive development!
 
 A work in progress.  But here is the basic idea:
 
-    (defun/t fibble (x y &key (z 10))
-      "Hey, a docstring."
+    (defun/t sum-3 (x y &key (z 10))
+      "Sums three numbers, Z has a default value of 10"
       :tests
-      (= (1 2) 13)
-      (>= (1 2 :z 1) -5)
-      (:outputp (0 0 :z 0) (lambda (result) (equalp result 0)))
-      (:fails ("strings" "ain't" :z "numbers"))
+      (= (1 2) 13)        ; (sum-3 1 2) == 13
+      (= (1 2 :z 3) 6)    ; (sum-3 1 2 :z 3) == 6
+      (:output (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))
     
@@ -38,7 +40,7 @@ it to a VALUE.
 
 For example,  `(>= (1 2 :z 1) -5)` runs the test 
 
-    (assert (>= (fibble 1 2 :z 1) -5)) 
+    (assert (>= (sum-3 1 2 :z 1) -5)) 
     
 
 ## additional tests 
@@ -54,6 +56,10 @@ Where `TERM` varies according to the `KEYWORD` supplied.
 
 A few of these are 
 
+- `(:program FUNCTION-NAME ARGS...)` runs a funcion 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
@@ -109,3 +115,28 @@ questions. Useful for mocking.
 In the above, the temporary redefinition of JUST-A-FUNCTION is used.
 
 
+# `WITH-STUBS` and `:PROGRAM` Style Tests
+
+By using the `:program` test and the `with-stubs` macro, you can
+define just about any kind of test.  In the following, you use
+`with-stubs` to mock a function that makes an http request and returns
+a string.
+
+
+     (defun test-url-word-counter ()
+       "Stub the function that makes requests that word-counter uses, and then test 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)))) 
+         
+         
+If `test-url-word-counter` fails, `count-words` isn't defined.
diff --git a/examples.lisp b/examples.lisp
index 9ceb234..831cb09 100644
--- a/examples.lisp
+++ b/examples.lisp
@@ -1,13 +1,18 @@
 (defpackage :testiere.examples
   (:use #:cl)
   (:import-from #:testiere
-                #:defun/t))
+                #: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)
   (= (1 2) 13)
   (>= (1 2 :z 1) -5)
   (:outputp (0 10 :z 0) (lambda (result) (equalp result 10)))
@@ -52,3 +57,21 @@
   (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
index 9763e9b..9583460 100644
--- a/package.lisp
+++ b/package.lisp
@@ -3,7 +3,7 @@
 (defpackage #:testiere
   (:use #:cl)
   (:import-from #:trivia #:match #:guard)
-  (:export #:defun/t))
+  (:export #:defun/t #:with-stubs #:with-stub))
 
 
 
diff --git a/testiere.lisp b/testiere.lisp
index 3ec8a03..ea22b80 100644
--- a/testiere.lisp
+++ b/testiere.lisp
@@ -2,8 +2,6 @@
 
 (in-package #:testiere)
 
-(defun stub-names (stubs) (mapcar 'first stubs))
-
 (defun build-test (name spec)
   (match spec
     ((list :fails inputs)
@@ -17,6 +15,9 @@
          (,condition (c) (declare (ignore c)) t)
          (condition (c) (declare (ignore c)) nil))))
 
+    ((list* :program function-name  args)
+     `(funcall ',function-name ,@args))
+    
     ((list* :with-stubs redefs more-specs)
      (let* ((assoc-vars
               (loop for (stub-name . more) in redefs
@@ -59,6 +60,34 @@
         (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
@@ -82,6 +111,3 @@
 
 
 
-
-
-