ユニットテストツールのようななにか

動的言語を使う人達は、簡単なユニットテストくらいなら言語自体の機能をつかってぱぱっと書いてしまうのではないかと想像しています。

私は趣味で適当なプログラムを書いているだけでろくにテストをしませんが、カバレッジのとりかたもわかったことなのでテストツールを書いてみました。

前のエントリでは、SBCLでのカバレッジの結果の出力先はファイルパスと書きましたが、どうもSBCLでもディレクトリのパスっぽいです。どうしてファイルを指定すると思い込んでいたのでしょう。

(defpackage unit-test
  (:use :cl)
  (:shadow cl:assert)
  (:nicknames :utest)
  (:export test-error
	   assert
	   do-as-test
	   define-test-case
	   *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*))

#+SBCL (require 'sb-cover)
#+SBCL (declaim (optimize sb-cover:store-coverage-data))

(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 ()
  #+SBCL *coverage-p*
  #+CCL *coverage-p*
  #+OPEM-MCL *coverage-p*)

#+SBCL
(defun start-coverage-sbcl ()
  (dolist (file *coverage-files*)
    (compile-and-load file)))

#+SBCL
(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))))

;; function.lisp

(defun make-add (a)
  (lambda (x)
    (+ x a)))

(defun quoted? (obj)
  (if (and (listp obj)
	   (eq (car obj) 'quote))
      T
      nil))

(defun bad-quoted? (obj)
  (if (and (listp obj)
	   (eq (car obj) 'quote))
      nil
      T))

;; テストコード
(utest:define-test-case test-01 ()
	   (let ((add-5 (make-add 5)))
	     (utest:assert (eq 6 (funcall add-5 1)))))
(utest:define-test-case test-02 ()
	   (utest:assert (eq nil (quoted? :hoge))))
(utest:define-test-case test-03 ()
	   (utest:assert (eq T (bad-quoted? ''hoge)))))

(utest:do-as-test
	     (:continue-on-test-error-p t
	      :coverage-p t
	      :coverage-files '("/path/to/function")
	      :coverage-path "/path/to/dir/")
	   (test-01)
	   (test-02)
	   (test-03))

;;Run test case: TEST-01
;;Run test case: TEST-02
;;Run test case: TEST-03
;;Assert failed: "Assertion failed"
;;form: (UNIT-TEST:ASSERT (EQ T (BAD-QUOTED? ''HOGE)))
;;result: NIL
;;Assertion 3,  Success 2, Fail 1