diff options
| -rw-r--r-- | package.lisp | 4 | ||||
| -rw-r--r-- | testiere.lisp | 27 |
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)))) |