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 --- src/legacy/README.org | 175 ++++++++++++++++++++++++++++++++++++++++++++++ src/legacy/package.lisp | 14 ++++ src/legacy/testiere.lisp | 115 ++++++++++++++++++++++++++++++ src/legacy/testiere.lisp~ | 115 ++++++++++++++++++++++++++++++ 4 files changed, 419 insertions(+) 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~ (limited to 'src/legacy') 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)))))))) + + + + -- cgit v1.2.3