;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; Name: assert.lisp
+;;;; ID: $Id: assert.lisp,v 1.2 2003/08/04 12:16:13 kevin Exp $
;;;; Purpose: Assert functions for XLUnit
-;;;; Author: Kevin Rosenberg
;;;;
-;;;; $Id: assert.lisp,v 1.1 2003/08/04 12:01:54 kevin Exp $
;;;; *************************************************************************
(in-package #:xlunit)
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; Name: example.lisp
-;;;; Purpose: Example file for XLUnit
-;;;; Authors: Kevin Rosenberg and Craig Brozefsky
+;;;; ID: $Id: example.lisp,v 1.4 2003/08/04 12:16:13 kevin Exp $
+;;;; Purpose: Example file for XLUnit
;;;;
-;;;; $Id: example.lisp,v 1.3 2003/08/04 09:50:33 kevin Exp $
;;;; *************************************************************************
(defpackage #:xlunit-example
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; Name: fixture.lisp
-;;;; Purpose: eXtreme Lisp Test Suite
-;;;; Authors: Kevin Rosenberg and Craig Brozefsky
+;;;; ID: $Id: fixture.lisp,v 1.2 2003/08/04 12:16:13 kevin Exp $
+;;;; Purpose: Test fixtures for XLUnit
;;;;
-;;;; $Id: fixture.lisp,v 1.1 2003/08/04 12:01:54 kevin Exp $
;;;; *************************************************************************
(in-package #:xlunit)
(defclass test-fixture ()
- ((test-thunk
- :initarg :test-thunk :reader test-thunk
- :initform 'perform-test
+ ((test-fn
+ :initarg :test-fn :reader test-fn :initform nil
:documentation
- "A thunk or symbol which will be applied to this instance, a
-test-case, to perform that test-case. Defaults to 'perform-test")
+ "A function designator which will be applied to this instance
+to perform that test-case.")
(test-name
- :initarg :test-name
- :reader test-name
+ :initarg :test-name :reader test-name
:documentation
"The name of this test-case, used in reports.")
(test-description
- :initarg :description
- :reader description
+ :initarg :description :reader description
:documentation
"Short description of this test-case, uses in reports"))
(:documentation
&key (result (make-instance 'test-result))
(handle-errors t))
"Perform the test represented by the given test-case or test-suite.
-Returns one or more test-result objects, one for each test-case
-performed."
+Returns a test-result object."
(incf (test-count result))
(with-slots (failures errors) result
(unwind-protect-if handle-errors
(handler-case-if handle-errors
(let ((res (progn (setup test)
- (funcall (test-thunk test) test))))
- (if (typep res 'test-failure-condition)
- (push (make-instance 'test-failure
- :failed-test test
- :thrown-condition res)
- failures)))
+ (funcall (test-fn test) test))))
+ (when (typep res 'test-failure-condition)
+ (push (make-test-failure test res) failures)))
(test-failure-condition (failure)
- (push (make-instance 'test-failure
- :failed-test test
- :thrown-condition failure)
- failures))
+ (push (make-test-failure test failure) failures))
(error (err)
- (push (make-instance 'test-failure
- :failed-test test
- :thrown-condition err)
- errors)))
+ (push (make-test-failure test err) errors)))
+
(if handle-errors
(handler-case
(teardown test)
(error (err)
- (push
- (make-instance 'test-failure
- :failed-test test :thrown-condition err)
- errors)))
- (teardown test))))
+ (push (make-test-failure test err) errors)))
+ (teardown test))))
result)
-(defun make-test (fixture name &key test-thunk test-suite description)
- "Create a test-case which is an instance of FIXTURE. TEST-THUNK is
+(defun make-test (fixture name &key test-fn test-suite description)
+ "Create a test-case which is an instance of FIXTURE. TEST-FN is
the method that will be invoked when perfoming this test, and can be a
symbol or a lambda taking a single argument, the test-fixture
instance. DESCRIPTION is obviously what it says it is."
(string-downcase (symbol-name name)))
(string
name))
- :test-thunk
- (if(and (symbolp name) (null test-thunk))
+ :test-fn
+ (if(and (symbolp name) (null test-fn))
name
- test-thunk)
+ test-fn)
:description description)))
- (if test-suite (add-test newtest test-suite))
- newtest))
-
+ (when test-suite (add-test newtest test-suite))
+ newtest))
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; Name: package.lisp
-;;;; Purpose: Package definition for XLTEST
-;;;; Authors: Kevin Rosenberg and Craig Brozefsky
+;;;; ID: $Id: package.lisp,v 1.5 2003/08/04 12:16:13 kevin Exp $
+;;;; Purpose: Package definition for XLUnit
;;;;
-;;;; $Id: package.lisp,v 1.4 2003/08/04 12:01:54 kevin Exp $
+;;;; $Id: package.lisp,v 1.5 2003/08/04 12:16:13 kevin Exp $
;;;; *************************************************************************
(in-package #:cl-user)
-(defpackage #:xlunit-framework
- (:use #:common-lisp)
- (:nicknames #:xlunit #:xptest)
+(defpackage #:xlunit
+ (:use #:cl)
(:export
- ;;; Framework classes
;; fixture
#:test-fixture
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; Name: printer.lisp
-;;;; Purpose: Printer functions for XLUnit
-;;;; Authors: Kevin Rosenberg
+;;;; ID: $Id: printer.lisp,v 1.2 2003/08/04 12:16:13 kevin Exp $
+;;;; Purpose: Printer functions for XLUnit
;;;;
-;;;; $Id: printer.lisp,v 1.1 2003/08/04 12:01:54 kevin Exp $
;;;; *************************************************************************
(in-package #:xlunit)
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; Name: result.lisp
-;;;; Purpose: Result functions for XLUnit
-;;;; Authors: Kevin Rosenberg
+;;;; ID: $Id: result.lisp,v 1.2 2003/08/04 12:16:13 kevin Exp $
+;;;; Purpose: Result functions for XLUnit
;;;;
-;;;; $Id: result.lisp,v 1.1 2003/08/04 12:01:54 kevin Exp $
;;;; *************************************************************************
(in-package #:xlunit)
(count :initform 0 :accessor test-count)
(failures :initarg :failures :reader test-failures :initform nil)
(errors :initarg :errors :reader test-errors :initform nil))
- (:documentation "The result of applying a test"))
-
+ (:documentation "Results of running test(s)"))
(defun make-test-result ()
(make-instance 'test-result))
(defclass test-failure ()
((failed-test :initarg :failed-test :reader failed-test)
- (thrown-condition :initarg :thrown-condition :reader thrown-condition)))
+ (thrown-condition :initarg :thrown-condition
+ :reader thrown-condition))
+ (:documention "Stored failures/errors in test-result slots"))
+
+(defun make-test-failure (test condition)
+ (make-instance 'test-failure :failed-test test
+ :thrown-condition condition))
(defmethod is-failure ((failure test-failure))
+ "Returns T if a failure was a test-failure condition"
(typep (thrown-condition failure) 'test-failure-condition))
(defmethod print-object ((obj test-failure) stream)
(simple-condition-format-arguments (thrown-condition obj)))))
(defmethod was-successful ((result test-result))
- (and (null (test-failures result))
- (null (test-errors result))))
+ "Returns T if a result has no failures or errors"
+ (and (null (test-failures result)) (null (test-errors result))))
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; Name: suite.lisp
-;;;; Purpose: Suite functions for XLUnit
-;;;; Authors: Kevin Rosenberg and Craig Brozefsky
+;;;; ID: $Id: suite.lisp,v 1.2 2003/08/04 12:16:13 kevin Exp $
+;;;; Purpose: Suite functions for XLUnit
;;;;
-;;;; $Id: suite.lisp,v 1.1 2003/08/04 12:01:54 kevin Exp $
;;;; *************************************************************************
(in-package #:xlunit)
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
-;;;; Name: tests.lisp
-;;;; Purpose: Test suite for XLUnit
-;;;; Author: Kevin Rosenberg
+;;;; Id: $Id: tests.lisp,v 1.5 2003/08/04 12:16:13 kevin Exp $
+;;;; Purpose: Test suite for XLUnit
;;;;
-;;;; Put in public domain by Kevin Rosenberg
-;;;; $Id: tests.lisp,v 1.4 2003/08/04 12:01:54 kevin Exp $
;;;; *************************************************************************
(defpackage #:xlunit-tests
(assert-equal "1 run, 0 erred, 0 failed"
(summary (run-test (make-test 'was-run 'test-method)))))
-(defmethod test-thunk ((self test-case-test))
+(defmethod test-fn ((self test-case-test))
(let ((test (make-test 'was-run '"Test Failure"
- :test-thunk
+ :test-fn
(lambda (test)
(declare (ignore test))
(assert-equal 10 10)))))