From 7159a111b28fa88af41967e195b78c1571059d7a Mon Sep 17 00:00:00 2001
From: colin <colin@cicadas.surf>
Date: Sun, 4 Feb 2024 10:25:31 -0800
Subject: Add: automatic test suite construction

---
 src/standard-hooks.lisp | 31 ++++++++++++++++++++++++++++---
 1 file changed, 28 insertions(+), 3 deletions(-)

(limited to 'src/standard-hooks.lisp')

diff --git a/src/standard-hooks.lisp b/src/standard-hooks.lisp
index 86725ca..0548865 100644
--- a/src/standard-hooks.lisp
+++ b/src/standard-hooks.lisp
@@ -2,6 +2,29 @@
 
 (in-package :testiere)
 
+;;; COMMON FUNCTIONS
+
+(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 standard-form-key (form)
+  "The first is a list (MACRO NAME) that uniquely identifies the form
+form which tests are being defined. NAME's package is the suite to
+which the tests of FORM will be be added.
+
+This form key function is sutable for Common Lisp definition macros."
+  (list (first form) (second form)))
+
+
 ;;; DEFSTRUCT
 
 ;; (defstruct moo
@@ -11,6 +34,7 @@
 
 (register-hook
  'cl:defstruct
+ #'standard-form-key
  #'standard-extractor)
 
 ;;; DEFCLASS
@@ -30,6 +54,7 @@
 (register-hook
  'cl:defclass
  #'standard-extractor
+ #'standard-form-key
  #'defclass-restarts-expander)
 
 ;;; DEFMETHOD
@@ -40,7 +65,7 @@
 ;;   (:tests ...)
 ;;   (flah  (moo-blah x) (barbar y)))
 
-(register-hook 'cl:defmethod #'standard-extractor)
+(register-hook 'cl:defmethod #'standard-extractor #'standard-form-key)
 
 ;;; DEFUN
 
@@ -57,7 +82,7 @@
        ()
        (fmakunbound ',name)))))
 
-(register-hook 'cl:defun #'standard-extractor #'defun-restarts-expander)
+(register-hook 'cl:defun #'standard-extractor #'standard-form-key #'defun-restarts-expander)
 
 ;;; DEFTYPE
 
@@ -67,4 +92,4 @@
 ;;   (:tests ...)
 ;;   `(or number null))
 
-(register-hook 'cl:deftype #'standard-extractor)
+(register-hook 'cl:deftype #'standard-extractor #'standard-form-key)
-- 
cgit v1.2.3