Removed trivia dependencyHEADmain

1 files changed, 63 insertions, 0 deletions

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."
 
 
 
+
+