test

test.lsip

(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))))