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-and-compile
  58   (luna-define-class lunit-test ()
  59                      (name))
  60
  61   (luna-define-internal-accessors 'lunit-test)
  62
  63   (luna-define-class lunit-test-case (lunit-test))
  64
  65   (luna-define-class lunit-test-suite (lunit-test)
  66                      (tests))
  67
  68   (luna-define-internal-accessors 'lunit-test-suite)
  69
  70   (luna-define-class lunit-test-result ()
  71                      (errors
  72                       failures
  73                       listeners))
  74
  75   (luna-define-internal-accessors 'lunit-test-result)
  76
  77   (luna-define-class lunit-test-listener ()))
  78
  79 (luna-define-generic lunit-test-number-of-tests (test)
  80   "Count the number of test cases that will be run by the test.")
  81
  82 (luna-define-generic lunit-test-run (test result)
  83   "Run the test and collects its result in result.")
  84
  85 (luna-define-generic lunit-test-case-run (case)
  86   "Run the test case.")
  87
  88 (luna-define-generic lunit-test-case-setup (case)
  89   "Setup the test case.")
  90
  91 (luna-define-generic lunit-test-case-teardown (case)
  92   "Clear the test case.")
  93
  94 (luna-define-generic lunit-test-suite-add-test (suite test)
  95   "Add the test to the suite.")
  96
  97 (luna-define-generic lunit-test-result-run (result case)
  98   "Run the test case.")
  99
 100 (luna-define-generic lunit-test-result-error (result case error)
 101   "Add error to the list of errors.
 102 The passed in exception caused the error.")
 103
 104 (luna-define-generic lunit-test-result-failure (result case failure)
 105   "Add failure to the list of failures.
 106 The passed in exception caused the failure.")
 107
 108 (luna-define-generic lunit-test-result-add-listener (result listener)
 109   "Add listener to the list of listeners.")
 110
 111 (luna-define-generic lunit-test-listener-error (listener case error)
 112   "An error occurred.")
 113
 114 (luna-define-generic lunit-test-listener-failure (listener case failure)
 115   "An failure occurred.")
 116
 117 (luna-define-generic lunit-test-listener-start (listener case)
 118   "A test started.")
 119
 120 (luna-define-generic lunit-test-listener-end (listener case)
 121   "A test ended.")
 122
 123 (put 'lunit-error 'error-message "test error")
 124 (put 'lunit-error 'error-conditions '(lunit-error error))
 125
 126 (put 'lunit-failure 'error-message "test failure")
 127 (put 'lunit-failure 'error-conditions '(lunit-failure lunit-error error))
 128
 129 (defmacro lunit-assert (condition-expr)
 130   (let ((condition (eval condition-expr)))
 131     `(unless ,condition
 132        (signal 'lunit-failure (list ',condition-expr)))))
 133
 134 (defvar lunit-test-results-buffer "*Lunit Test Results*")
 135
 136 (defun lunit (test)
 137   (let* ((listener
 138           (luna-make-entity 'lunit-test-listener))
 139          (result
 140           (lunit-make-test-result listener))
 141          failures
 142          errors)
 143     (with-output-to-temp-buffer lunit-test-results-buffer
 144       (lunit-test-run test result)
 145       (setq failures (lunit-test-result-failures-internal result)
 146             errors (lunit-test-result-errors-internal result))
 147       (princ (format "%d total, %d failures, %d errors"
 148                      (lunit-test-number-of-tests test)
 149                      (length failures)
 150                      (length errors))))
 151     nil))
 152
 153 ;;; @ test listener
 154 ;;;
 155
 156 (luna-define-method lunit-test-listener-error ((listener lunit-test-listener)
 157                                                case error)
 158   (princ (format "error: %S\n" error)))
 159
 160 (luna-define-method lunit-test-listener-failure ((listener lunit-test-listener)
 161                                                  case failure)
 162   (princ (format "failure: %S\n" failure)))
 163
 164 (luna-define-method lunit-test-listener-start ((listener lunit-test-listener)
 165                                                case)
 166   (princ (format "\
 167 ______________________________________________________________________
 168 Starting test %S
 169 " (lunit-test-name-internal case))))
 170
 171 (luna-define-method lunit-test-listener-end ((listener lunit-test-listener)
 172                                              case)
 173   (princ "\
 174 ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 175 "))
 176
 177 ;;; @ test result
 178 ;;;
 179
 180 (defun lunit-make-test-result (&rest listeners)
 181   (luna-make-entity 'lunit-test-result :listeners listeners))
 182
 183 (luna-define-method lunit-test-result-run ((result lunit-test-result) case)
 184   (let ((listeners (lunit-test-result-listeners-internal result)))
 185     (dolist (listener listeners)
 186       (lunit-test-listener-start listener case))
 187     (condition-case error
 188         (lunit-test-case-run case)
 189       (lunit-failure
 190        (lunit-test-result-failure result case (nth 1 error)))
 191       (lunit-error
 192        (lunit-test-result-error result case (cdr error))))
 193     (dolist (listener listeners)
 194       (lunit-test-listener-end listener case))))
 195
 196 (luna-define-method lunit-test-result-error ((result lunit-test-result)
 197                                              case error)
 198   (let ((listeners (lunit-test-result-listeners-internal result))
 199         (errors (lunit-test-result-errors-internal result)))
 200     (if errors
 201         (nconc errors (list (cons case error)))
 202       (lunit-test-result-set-errors-internal result (list (cons case error))))
 203     (dolist (listener listeners)
 204       (lunit-test-listener-error listener case error))))
 205
 206 (luna-define-method lunit-test-result-failure ((result lunit-test-result)
 207                                                case failure)
 208   (let ((listeners (lunit-test-result-listeners-internal result))
 209         (failures (lunit-test-result-failures-internal result)))
 210     (if failures
 211         (nconc failures (list (cons case failure)))
 212       (lunit-test-result-set-failures-internal result (list (cons case failure))))
 213     (dolist (listener listeners)
 214       (lunit-test-listener-failure listener case failure))))
 215
 216 (luna-define-method lunit-test-result-add-listener ((result lunit-test-result)
 217                                                     listener)
 218   (let ((listeners (lunit-test-result-listeners-internal result)))
 219     (if listeners
 220         (nconc listeners (list listener))
 221       (lunit-test-result-set-listeners-internal result (list listener)))))
 222
 223 ;;; @ test case
 224 ;;;
 225
 226 (defun lunit-make-test-case (class name)
 227   (luna-make-entity class :name name))
 228
 229 (luna-define-method lunit-test-number-of-tests ((case lunit-test-case))
 230   1)
 231
 232 (luna-define-method lunit-test-run ((case lunit-test-case) result)
 233   (lunit-test-result-run result case))
 234
 235 (luna-define-method lunit-test-case-setup ((case lunit-test-case)))
 236 (luna-define-method lunit-test-case-teardown ((case lunit-test-case)))
 237
 238 (luna-define-method lunit-test-case-run ((case lunit-test-case))
 239   (lunit-test-case-setup case)
 240   (unwind-protect
 241       (let* ((name
 242               (lunit-test-name-internal case))
 243              (functions
 244               (luna-find-functions case name)))
 245         (unless functions
 246           (error "Method \"%S\" not found" name))
 247         (condition-case error
 248             (funcall (car functions) case)
 249           (lunit-failure
 250            (signal (car error)(cdr error)))
 251           (error
 252            (signal 'lunit-error (cdr error)))))
 253     (lunit-test-case-teardown case)))
 254
 255 ;;; @ test suite
 256 ;;;
 257
 258 (defun lunit-make-test-suite (&rest tests)
 259   (luna-make-entity 'lunit-test-suite :tests tests))
 260
 261 (luna-define-method lunit-test-suite-add-test ((suite lunit-test-suite) test)
 262   (let ((tests (lunit-test-suite-tests-internal suite)))
 263     (if tests
 264         (nconc tests (list test))
 265       (lunit-test-suite-set-tests-internal suite (list test)))))
 266
 267 (luna-define-method lunit-test-number-of-tests ((suite lunit-test-suite))
 268   (let ((tests (lunit-test-suite-tests-internal suite))
 269         (accu 0))
 270     (dolist (test tests)
 271       (setq accu (+ accu (lunit-test-number-of-tests test))))
 272     accu))
 273
 274 (luna-define-method lunit-test-run ((suite lunit-test-suite) result)
 275   (let ((tests (lunit-test-suite-tests-internal suite)))
 276     (dolist (test tests)
 277       (lunit-test-run test result))))
 278
 279 (provide 'lunit)
 280
 281 ;;; lunit.el ends here