Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- (defpackage net.phorni.unit-test
- (:use :cl)
- (:shadow cl:assert)
- (:nicknames :utest)
- (:export test-error
- assert
- define-condition
- do-as-test
- *unit-test-error-port*
- *default-assert-error-message*
- *continue-on-test-error*
- *assert-count*
- *assert-error-count*
- *assert-error-report-function*
- *coverage-p*
- *coverage-files*
- *coverage-path*))
- (in-package :utest)
- (define-condition test-error (condition)
- ((msg :accessor message-of :initarg :message)
- (form :accessor form-of :initarg :form)
- (result :accessor result-of :initarg :result))
- (:default-initargs :message "" :form nil :result nil))
- (defun make-test-error (msg form result)
- (cerror "continue to eval forms"
- 'test-error
- :message msg
- :form form
- :result result))
- (defvar *unit-test-error-port* *standard-output*)
- (defparameter *default-assert-error-message*
- "Assertion failed")
- (defparameter *continue-on-test-error* nil)
- (defparameter *assert-count* 0)
- (defparameter *assert-error-count* 0)
- (defparameter *coverage-p* nil)
- (defparameter *coverage-files* nil)
- (defparameter *coverage-path* nil)
- (defparameter *assert-error-report-function*
- (lambda (msg form result)
- (format *unit-test-error-port*
- "Assert failed: ~S~%form: ~S~%result: ~S"
- msg form result)))
- (defun compile-and-load (path)
- (compile-file path)
- (load path))
- (defun coverage-p ()
- #+(and SBCL SB-COVER) *coverage-p*
- #+CCL *coverage-p*
- #+OPEM-MCL *coverage-p*)
- #+(and SBCL SB-COVER)
- (defun start-coverage-sbcl ()
- (declaim (optimize sb-cover:store-coverage-data))
- (dolist (file *coverage-files*)
- (compile-and-load file)))
- #+(and SBCL SB-COVER)
- (defun report-coverage-sbcl ()
- ;; *coverage-path* is file-path
- (sb-cover:report *coverage-path*))
- #+CCL
- (defun start-coverage-ccl ()
- (setf ccl:*compile-code-coverage* t)
- (dolist (file *coverage-files*)
- (compile-and-load file)))
- #+CCL
- (defun report-coverage-ccl ()
- ;; *coverage-files* is directory-path
- (ccl:report-coverage *coverage-path*))
- (defun report-test ()
- (format *unit-test-error-port*
- "Assertion ~A, Success ~A, Fail ~A~%"
- *assert-count*
- (- *assert-count* *assert-error-count*)
- *assert-error-count*)
- (when (and (coverage-p) *coverage-files*)
- #+SBCL (report-coverage-sbcl)
- #+CCL (report-coverage-ccl)))
- (defun handler-test-error (e)
- (incf *assert-error-count*)
- (funcall *assert-error-report-function*
- (message-of e)
- (form-of e)
- (result-of e))
- (when *continue-on-test-error*
- (continue)))
- (defmacro define-test-case (name lambda-list &body body)
- `(defun ,name ,lambda-list
- (format *unit-test-error-port*
- "Run test case: ~A~%"
- ',name)
- (handler-bind ((test-error #'handler-test-error))
- ,@body)))
- (defmacro assert (&whole form test-form &optional msg-fmt &rest args)
- (let ((sym (gensym)))
- `(progn
- (incf *assert-count*)
- (let ((,sym ,test-form))
- (unless ,sym
- (make-test-error
- (format nil (or ,msg-fmt *default-assert-error-message*) ,@args)
- ',form
- ,sym))
- ,sym))))
- (defmacro do-as-test
- ((&key error-port continue-on-test-error-p
- assert-error-report-function coverage-p
- coverage-path coverage-files)
- &body body)
- `(let ((*unit-test-error-port* (or ,error-port *unit-test-error-port*))
- (*continue-on-test-error*
- (or ,continue-on-test-error-p *continue-on-test-error*))
- (*assert-error-report-function*
- (or ,assert-error-report-function *assert-error-report-function*))
- (*assert-error-count* 0)
- (*assert-count* 0)
- (*coverage-path* (or ,coverage-path *coverage-path*))
- (*coverage-p* (or ,coverage-p *coverage-p*))
- (*coverage-files* (or ,coverage-files *coverage-files*)))
- (when (and (coverage-p) *coverage-files*)
- #+SBCL (start-coverage-sbcl)
- #+CCL (start-coverage-ccl))
- (unwind-protect
- (handler-bind ((test-error #'handler-test-error))
- ,@body)
- (report-test))))
Add Comment
Please, Sign In to add comment