aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--package.lisp4
-rw-r--r--testiere.lisp27
2 files changed, 24 insertions, 7 deletions
diff --git a/package.lisp b/package.lisp
index 145dadd..11b9171 100644
--- a/package.lisp
+++ b/package.lisp
@@ -2,6 +2,8 @@
(defpackage #:testiere
(:use #:cl)
- (:import-from #:trivia #:match #:guard))
+ (:import-from #:trivia #:match #:guard)
+ (:export #:defun+
+ #:defmethod+))
diff --git a/testiere.lisp b/testiere.lisp
index 1750a2d..c7b8934 100644
--- a/testiere.lisp
+++ b/testiere.lisp
@@ -4,7 +4,6 @@
(defun stub-names (stubs) (mapcar 'first stubs))
-
(defun build-test (name spec)
(match spec
((list :fails inputs)
@@ -57,13 +56,13 @@
(let ((specs (subseq body (1+ start-pos) end-pos))
(before (subseq body 0 start-pos))
(after (nthcdr (1+ end-pos) body)))
- (values (mapcar (lambda (spec) (build-test name spec)) specs)
- (append before after))))))
+ (list (mapcar (lambda (spec) (build-test name spec)) specs)
+ (append before after))))))
(defmacro defun+ (name lambda-list &body body)
"Like regular DEFUN, but with embedded unit tests. If those tests
would fail, the function fails to be defined. "
- (multiple-value-bind (tests function-body) (extract-tests name body)
+ (destructuring-bind (tests function-body) (extract-tests name body)
`(labels ((,name ,lambda-list ,@function-body))
(handler-case
(progn ,@tests
@@ -71,8 +70,24 @@
(error (e)
(format t "~a~%Not defining ~a" e ',name))))))
-(defmacro defmethod+ (name (&optional combination) lambda-list &body body)
+(defun parse-defmethod (args)
+ (match args
+ ((guard (list* qualifier lambda-list body)
+ (and (not (listp qualifier))
+ (listp lambda-list)))
+ (list (list qualifier lambda-list) body))
+ ((list* lambda-list body)
+ (list (list lambda-list) body))
+
+ (_ (error "Malformed DEFMETHOD: ~a " args))))
+
+(defmacro defmethod+ (name &rest args)
"Like regular DEFMETHOD, but with embedded unit tests. If those
- test would fail, the method fails to be defined. ")
+ test would fail, the method fails to be defined. "
+ (destructuring-bind (qual-and-lambda-list body) (parse-defmethod args)
+ (destructuring-bind (tests function-body) (extract-tests name body)
+ `(progn
+ (defmethod ,name ,@qual-and-lambda-list ,@function-body)
+ ,@tests))))