aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorcolin <colin@cicadas.surf>2023-09-09 11:09:10 -0700
committercolin <colin@cicadas.surf>2023-09-09 13:59:36 -0700
commit4025722943ae814c88da1fa8fe5778cffecce4ad (patch)
tree12ca12b13dc53913eab33d61e5c7eeea946699e0 /src
parent1bb8d1f8826e21314aae0a96dc25d088afad36f5 (diff)
Testiere2
Add examples changed some internal names; improved some error messages Added more examples renaming exports Added New Readme
Diffstat (limited to 'src')
-rw-r--r--src/legacy/README.org175
-rw-r--r--src/legacy/package.lisp14
-rw-r--r--src/legacy/testiere.lisp115
-rw-r--r--src/legacy/testiere.lisp~115
-rw-r--r--src/package.lisp21
-rw-r--r--src/package.lisp~16
-rw-r--r--src/standard-hooks.lisp68
-rw-r--r--src/testiere.lisp177
8 files changed, 701 insertions, 0 deletions
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)))
+
+
+
+
+