From 8133177de9c5d202520bd83b5e797ef7a39942ad Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Mon, 4 Aug 2003 12:16:13 +0000 Subject: [PATCH] r5450: *** empty log message *** --- assert.lisp | 4 +--- example.lisp | 6 ++--- fixture.lisp | 66 +++++++++++++++++++--------------------------------- package.lisp | 13 ++++------- printer.lisp | 6 ++--- result.lisp | 22 +++++++++++------- suite.lisp | 6 ++--- tests.lisp | 11 ++++----- 8 files changed, 53 insertions(+), 81 deletions(-) diff --git a/assert.lisp b/assert.lisp index 8307e2f..269e797 100644 --- a/assert.lisp +++ b/assert.lisp @@ -2,11 +2,9 @@ ;;;; ************************************************************************* ;;;; 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) diff --git a/example.lisp b/example.lisp index 44da457..5265bca 100644 --- a/example.lisp +++ b/example.lisp @@ -2,11 +2,9 @@ ;;;; ************************************************************************* ;;;; 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 diff --git a/fixture.lisp b/fixture.lisp index 8408cc8..84f28bf 100644 --- a/fixture.lisp +++ b/fixture.lisp @@ -2,31 +2,26 @@ ;;;; ************************************************************************* ;;;; 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 @@ -68,43 +63,31 @@ that the setup method did for this instance.")) &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." @@ -114,11 +97,10 @@ 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)) diff --git a/package.lisp b/package.lisp index 4b51cf5..c2b1780 100644 --- a/package.lisp +++ b/package.lisp @@ -2,20 +2,17 @@ ;;;; ************************************************************************* ;;;; 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 diff --git a/printer.lisp b/printer.lisp index 16f1bdb..af4adfc 100644 --- a/printer.lisp +++ b/printer.lisp @@ -2,11 +2,9 @@ ;;;; ************************************************************************* ;;;; 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) diff --git a/result.lisp b/result.lisp index ba95e4a..57ceba3 100644 --- a/result.lisp +++ b/result.lisp @@ -2,11 +2,9 @@ ;;;; ************************************************************************* ;;;; 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) @@ -17,17 +15,23 @@ (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) @@ -38,5 +42,5 @@ (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)))) diff --git a/suite.lisp b/suite.lisp index 046b61a..e410b5d 100644 --- a/suite.lisp +++ b/suite.lisp @@ -2,11 +2,9 @@ ;;;; ************************************************************************* ;;;; 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) diff --git a/tests.lisp b/tests.lisp index ef8ed7c..555b6ac 100644 --- a/tests.lisp +++ b/tests.lisp @@ -2,12 +2,9 @@ ;;;; ************************************************************************* ;;;; 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 @@ -49,9 +46,9 @@ (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))))) -- 2.34.1