lunit.el

   1 ;;; lunit.el --- simple testing framework for luna
   2
   3 ;; Copyright (C) 2000 Daiki Ueno.
   4
   5 ;; Author: Daiki Ueno <ueno@unixuser.org>
   6 ;; Keywords: OOP, XP
   7
   8 ;; This file is part of FLIM (Faithful Library about Internet Message).
   9
  10 ;; This program is free software; you can redistribute it and/or
  11 ;; modify it under the terms of the GNU General Public License as
  12 ;; published by the Free Software Foundation; either version 2, or (at
  13 ;; your option) any later version.
  14
  15 ;; This program is distributed in the hope that it will be useful, but
  16 ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  18 ;; General Public License for more details.
  19
  20 ;; You should have received a copy of the GNU General Public License
  21 ;; along with GNU Emacs; see the file COPYING.  If not, write to the
  22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
  23 ;; Boston, MA 02111-1307, USA.
  24
  25 ;;; Commentary:
  26
  27 ;; This module is inspired by "JUnit A Cook's Tour".
  28 ;; <URL:http://www.junit.org/junit/doc/cookstour/cookstour.htm>
  29
  30 ;; (require 'lunit)
  31 ;;
  32 ;; (luna-define-class silly-test-case (lunit-test-case))
  33 ;;
  34 ;; (luna-define-method silly-test-1 ((case silly-test-case))
  35 ;;   (lunit-assert (integerp "a")))
  36 ;;
  37 ;; (luna-define-method silly-test-2 ((case silly-test-case))
  38 ;;   (lunit-assert (stringp "b")))
  39 ;;
  40 ;; (lunit
  41 ;;  (lunit-make-test-suite
  42 ;;   (lunit-make-test-case 'silly-test-case 'silly-test-1)
  43 ;;   (lunit-make-test-case 'silly-test-case 'silly-test-2)))
  44 ;; ______________________________________________________________________
  45 ;; Starting test silly-test-1
  46 ;; failure: (integerp "a")
  47 ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  48 ;; ______________________________________________________________________
  49 ;; Starting test silly-test-2
  50 ;; ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
  51 ;; 2 total, 1 failures, 0 errors
  52
  53 ;;; Code:
  54
  55 (require 'luna)
  56
  57 (eval-when-compile (require 'cl))
  58
  59 ;;; @ test
  60 ;;;
  61
  62 (eval-and-compile
  63   (luna-define-class lunit-test ()
  64                      (name))
  65
  66   (luna-define-internal-accessors 'lunit-test))
  67
  68 (luna-define-generic lunit-test-number-of-tests (test)
  69   "Count the number of test cases that will be run by the test.")
  70
  71 (luna-define-generic lunit-test-run (test result)
  72   "Run the test and collects its result in result.")
  73
  74 (luna-define-generic lunit-test-suite-add-test (suite test)
  75   "Add the test to the suite.")
  76
  77 ;;; @ test listener
  78 ;;;
  79
  80 (luna-define-class lunit-test-listener ())
  81
  82 (luna-define-generic lunit-test-listener-error (listener case error)
  83   "An error occurred.")
  84
  85 (luna-define-generic lunit-test-listener-failure (listener case failure)
  86   "An failure occurred.")
  87
  88 (luna-define-generic lunit-test-listener-start (listener case)
  89   "A test started.")
  90
  91 (luna-define-generic lunit-test-listener-end (listener case)
  92   "A test ended.")
  93
  94 ;;; @ test result
  95 ;;;
  96
  97 (put 'lunit-error 'error-message "test error")
  98 (put 'lunit-error 'error-conditions '(lunit-error error))
  99
 100 (put 'lunit-failure 'error-message "test failure")
 101 (put 'lunit-failure 'error-conditions '(lunit-failure lunit-error error))
 102
 103 (eval-and-compile
 104   (luna-define-class lunit-test-result ()
 105                      (errors
 106                       failures
 107                       listeners))
 108
 109   (luna-define-internal-accessors 'lunit-test-result))
 110
 111 (luna-define-generic lunit-test-result-run (result case)
 112   "Run the test case.")
 113
 114 (luna-define-generic lunit-test-result-error (result case error)
 115   "Add error to the list of errors.
 116 The passed in exception caused the error.")
 117
 118 (luna-define-generic lunit-test-result-failure (result case failure)
 119   "Add failure to the list of failures.
 120 The passed in exception caused the failure.")
 121
 122 (luna-define-generic lunit-test-result-add-listener (result listener)
 123   "Add listener to the list of listeners.")
 124
 125 (defun lunit-make-test-result (&rest listeners)
 126   "Return a newly allocated `lunit-test-result' instance with LISTENERS."
 127   (luna-make-entity 'lunit-test-result :listeners listeners))
 128
 129 (luna-define-method lunit-test-result-run ((result lunit-test-result) case)
 130   (let ((listeners (lunit-test-result-listeners-internal result)))
 131     (dolist (listener listeners)
 132       (lunit-test-listener-start listener case))
 133     (condition-case error
 134         (lunit-test-case-run case)
 135       (lunit-failure
 136        (lunit-test-result-failure result case (nth 1 error)))
 137       (lunit-error
 138        (lunit-test-result-error result case (cdr error))))
 139     (dolist (listener listeners)
 140       (lunit-test-listener-end listener case))))
 141
 142 (luna-define-method lunit-test-result-error ((result lunit-test-result)
 143                                              case error)
 144   (let ((listeners (lunit-test-result-listeners-internal result))
 145         (errors (lunit-test-result-errors-internal result)))
 146     (if errors
 147         (nconc errors (list (cons case error)))
 148       (lunit-test-result-set-errors-internal result (list (cons case error))))
 149     (dolist (listener listeners)
 150       (lunit-test-listener-error listener case error))))
 151
 152 (luna-define-method lunit-test-result-failure ((result lunit-test-result)
 153                                                case failure)
 154   (let ((listeners (lunit-test-result-listeners-internal result))
 155         (failures (lunit-test-result-failures-internal result)))
 156     (if failures
 157         (nconc failures (list (cons case failure)))
 158       (lunit-test-result-set-failures-internal result (list (cons case failure))))
 159     (dolist (listener listeners)
 160       (lunit-test-listener-failure listener case failure))))
 161
 162 (luna-define-method lunit-test-result-add-listener ((result lunit-test-result)
 163                                                     listener)
 164   (let ((listeners (lunit-test-result-listeners-internal result)))
 165     (if listeners
 166         (nconc listeners (list listener))
 167       (lunit-test-result-set-listeners-internal result (list listener)))))
 168
 169 ;;; @ test case
 170 ;;;
 171
 172 (luna-define-class lunit-test-case (lunit-test))
 173
 174 (luna-define-generic lunit-test-case-run (case)
 175   "Run the test case.")
 176
 177 (luna-define-generic lunit-test-case-setup (case)
 178   "Setup the test case.")
 179
 180 (luna-define-generic lunit-test-case-teardown (case)
 181   "Clear the test case.")
 182
 183 (defun lunit-make-test-case (class name)
 184   "Return a newly allocated `lunit-test-case'.
 185 CLASS is a symbol for class derived from `lunit-test-case'.
 186 NAME is name of the method to be tested."
 187   (luna-make-entity class :name name))
 188
 189 (luna-define-method lunit-test-number-of-tests ((case lunit-test-case))
 190   1)
 191
 192 (luna-define-method lunit-test-run ((case lunit-test-case) result)
 193   (lunit-test-result-run result case))
 194
 195 (luna-define-method lunit-test-case-setup ((case lunit-test-case)))
 196 (luna-define-method lunit-test-case-teardown ((case lunit-test-case)))
 197
 198 (luna-define-method lunit-test-case-run ((case lunit-test-case))
 199   (lunit-test-case-setup case)
 200   (unwind-protect
 201       (let* ((name
 202               (lunit-test-name-internal case))
 203              (functions
 204               (luna-find-functions case name)))
 205         (unless functions
 206           (error "Method \"%S\" not found" name))
 207         (condition-case error
 208             (funcall (car functions) case)
 209           (lunit-failure
 210            (signal (car error)(cdr error)))
 211           (error
 212            (signal 'lunit-error (cdr error)))))
 213     (lunit-test-case-teardown case)))
 214
 215 ;;; @ test suite
 216 ;;;
 217
 218 (eval-and-compile
 219   (luna-define-class lunit-test-suite (lunit-test)
 220                      (tests))
 221
 222   (luna-define-internal-accessors 'lunit-test-suite))
 223
 224 (defun lunit-make-test-suite (&rest tests)
 225   "Return a newly allocated `lunit-test-suite' instance."
 226   (luna-make-entity 'lunit-test-suite :tests tests))
 227
 228 (luna-define-method lunit-test-suite-add-test ((suite lunit-test-suite) test)
 229   (let ((tests (lunit-test-suite-tests-internal suite)))
 230     (if tests
 231         (nconc tests (list test))
 232       (lunit-test-suite-set-tests-internal suite (list test)))))
 233
 234 (luna-define-method lunit-test-number-of-tests ((suite lunit-test-suite))
 235   (let ((tests (lunit-test-suite-tests-internal suite))
 236         (accu 0))
 237     (dolist (test tests)
 238       (setq accu (+ accu (lunit-test-number-of-tests test))))
 239     accu))
 240
 241 (luna-define-method lunit-test-run ((suite lunit-test-suite) result)
 242   (let ((tests (lunit-test-suite-tests-internal suite)))
 243     (dolist (test tests)
 244       (lunit-test-run test result))))
 245
 246 ;;; @ test runner
 247 ;;;
 248
 249 (defmacro lunit-assert (condition-expr)
 250   (let ((condition (eval condition-expr)))
 251     `(unless ,condition
 252        (signal 'lunit-failure (list ',condition-expr)))))
 253
 254 (defvar lunit-test-results-buffer "*Lunit Results*")
 255
 256 (luna-define-class lunit-test-printer (lunit-test-listener))
 257
 258 (luna-define-method lunit-test-listener-error ((printer lunit-test-printer)
 259                                                case error)
 260   (princ (format "error: %S\n" error)))
 261
 262 (luna-define-method lunit-test-listener-failure ((printer lunit-test-printer)
 263                                                  case failure)
 264   (princ (format "failure: %S\n" failure)))
 265
 266 (luna-define-method lunit-test-listener-start ((printer lunit-test-printer) case)
 267   (princ (format "\
 268 ______________________________________________________________________
 269 Starting test %S
 270 " (lunit-test-name-internal case))))
 271
 272 (luna-define-method lunit-test-listener-end ((printer lunit-test-printer) case)
 273   (princ "\
 274 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 275 "))
 276
 277 (defun lunit (test)
 278   "Run TEST and display the result."
 279   (let* ((printer
 280           (luna-make-entity 'lunit-test-printer))
 281          (result
 282           (lunit-make-test-result printer))
 283          failures
 284          errors)
 285     (with-output-to-temp-buffer lunit-test-results-buffer
 286       (lunit-test-run test result)
 287       (setq failures (lunit-test-result-failures-internal result)
 288             errors (lunit-test-result-errors-internal result))
 289       (princ (format "%d runs, %d failures, %d errors"
 290                      (lunit-test-number-of-tests test)
 291                      (length failures)
 292                      (length errors))))
 293     nil))
 294
 295 (provide 'lunit)
 296
 297 ;;; lunit.el ends here