From 4456c2f10407e3f2290c4a8027fb9c9980820b68 Mon Sep 17 00:00:00 2001
From: Colin Okay <okay@toyful.space>
Date: Sun, 20 Mar 2022 07:47:17 -0500
Subject: refactor defun/t to use symbol-function values, and restart-case

---
 clpmfile      |  6 ++++++
 testiere.lisp | 22 +++++++++++++++-------
 2 files changed, 21 insertions(+), 7 deletions(-)
 create mode 100644 clpmfile

diff --git a/clpmfile b/clpmfile
new file mode 100644
index 0000000..3e087ff
--- /dev/null
+++ b/clpmfile
@@ -0,0 +1,6 @@
+;;; -*- 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/testiere.lisp b/testiere.lisp
index 003647c..8bdd526 100644
--- a/testiere.lisp
+++ b/testiere.lisp
@@ -59,17 +59,25 @@
         (list (mapcar (lambda (spec) (build-test name spec)) specs)
               (append before after))))))
 
+
 (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)
-    `(labels ((,name ,lambda-list ,@function-body))
-       (handler-case
-           (progn ,@tests
-                  (defun ,name ,lambda-list ,@function-body))
-         (error (e)
-           (invoke-debugger e)
-           )))))
+    (let ((cached (gensym)))
+      `(let ((,cached
+               (when (fboundp ',name)
+                 (symbol-function ',name))))
+         (restart-case
+             (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