1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
2 ;;;; *************************************************************************
3 ;;;; FILE IDENTIFICATION
6 ;;;; Purpose: Test fixtures for XLUnit
8 ;;;; *************************************************************************
13 (defclass test-fixture ()
15 :initarg :test-fn :reader test-fn :initform nil
17 "A function designator which will be applied to this instance
18 to perform that test-case.")
20 :initarg :test-name :reader test-name
22 "The name of this test-case, used in reports.")
24 :initarg :description :reader description
26 "Short description of this test-case, uses in reports"))
28 "Base class for test-fixtures. Test-cases are instances of test-fixtures."))
30 (defgeneric setup (test)
32 "Method called before performing a test, should set up the
33 environment the test-case needs to operate in."))
35 (defmethod setup ((test test-fixture))
38 (defgeneric teardown (test)
40 "Method called after performing a test. Should reverse everything
41 that the setup method did for this instance."))
43 (defmethod teardown ((test test-fixture))
47 (defmacro handler-case-if (test form &body cases)
54 (defmacro unwind-protect-if (test protected cleanup)
59 (progn ,protected ,cleanup)))
62 (defmethod run-test ((test test-fixture)
63 &key (result (make-instance 'test-result))
65 "Perform the test represented by the given test-case or test-suite.
66 Returns a test-result object."
67 (incf (test-count result))
68 (with-slots (failures errors) result
69 (unwind-protect-if handle-errors
70 (handler-case-if handle-errors
71 (let ((res (progn (setup test)
72 (funcall (test-fn test) test))))
73 (when (typep res 'test-failure-condition)
74 (push (make-test-failure test res) failures)))
75 (test-failure-condition (failure)
76 (push (make-test-failure test failure) failures))
78 (push (make-test-failure test err) errors)))
84 (push (make-test-failure test err) errors)))
89 (defun make-test (fixture name &key test-fn test-suite description)
90 "Create a test-case which is an instance of FIXTURE. TEST-FN is
91 the method that will be invoked when perfoming this test, and can be a
92 symbol or a lambda taking a single argument, the test-fixture
93 instance. DESCRIPTION is obviously what it says it is."
94 (let ((newtest (make-instance fixture
95 :test-name (etypecase name
97 (string-downcase (symbol-name name)))
101 (if(and (symbolp name) (null test-fn))
104 :description description)))
105 (when test-suite (add-test newtest test-suite))