From: Kevin M. Rosenberg Date: Mon, 4 Aug 2003 16:43:20 +0000 (+0000) Subject: r5453: *** empty log message *** X-Git-Tag: debian-0.6.2-2~21 X-Git-Url: http://git.kpe.io/?p=xlunit.git;a=commitdiff_plain;h=e6a0ad7329d3ce497ce8c9f3d0d37811b2da4811 r5453: *** empty log message *** --- diff --git a/.cvsignore b/.cvsignore new file mode 100755 index 0000000..691633a --- /dev/null +++ b/.cvsignore @@ -0,0 +1,10 @@ +.bin +*.fasl* +*.dfsl +*.pfsl +*.ufsl +*.fas +*.fsl +*.x86f +*.sparcf +*.cfsl diff --git a/assert.lisp b/assert.lisp index fa2f100..d46eaeb 100644 --- a/assert.lisp +++ b/assert.lisp @@ -2,7 +2,7 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; ID: $Id: assert.lisp,v 1.4 2003/08/04 16:13:58 kevin Exp $ +;;;; ID: $Id: assert.lisp,v 1.5 2003/08/04 16:42:27 kevin Exp $ ;;;; Purpose: Assert functions for XLUnit ;;;; ;;;; ************************************************************************* @@ -11,33 +11,33 @@ (define-condition assertion-failed (simple-condition) - ((msg :initform nil :initarg :msg :accessor msg)) + ((message :initform nil :initarg :message :accessor message)) (:documentation "Base class for all test failures.")) -(defun failure-msg (msg &optional format-str &rest args) +(defun failure-message (message &optional format-str &rest args) "Signal a test failure and exit the test." (signal 'assertion-failed - :msg msg + :message message :format-control format-str :format-arguments args)) (defun failure (format-str &rest args) "Signal a test failure and exit the test." - (apply #'failure-msg nil format-str args)) + (apply #'failure-message nil format-str args)) -(defun assert-equal (v1 v2 &optional msg) +(defun assert-equal (v1 v2 &optional message) (unless (equal v1 v2) - (failure-msg msg "Test equal: ~S ~S" v1 v2))) + (failure-message message "Test equal: ~S ~S" v1 v2))) -(defun assert-eql (v1 v2 &optional msg) +(defun assert-eql (v1 v2 &optional message) (unless (eql v1 v2) - (failure-msg msg "Test eql: ~S ~S" v1 v2))) + (failure-message message "Test eql: ~S ~S" v1 v2))) -(defmacro assert-true (v &optional msg) +(defmacro assert-true (v &optional message) `(unless ,v - (failure-msg msg "Not true: ~S" ',v))) + (failure-message message "Not true: ~S" ',v))) -(defmacro assert-false (v &optional msg) +(defmacro assert-false (v &optional message) `(when ,v - (failure-msg msg "Not false: ~S" ',v))) + (failure-message message "Not false: ~S" ',v))) diff --git a/result.lisp b/result.lisp index 3ddead3..1b7fd35 100644 --- a/result.lisp +++ b/result.lisp @@ -2,7 +2,7 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; ID: $Id: result.lisp,v 1.4 2003/08/04 16:13:58 kevin Exp $ +;;;; ID: $Id: result.lisp,v 1.5 2003/08/04 16:42:27 kevin Exp $ ;;;; Purpose: Result functions for XLUnit ;;;; ;;;; ************************************************************************* @@ -10,7 +10,7 @@ (in-package #:xlunit) -(defclass test-result () +(defclass test-results () ((test :initarg :test :reader result-test) (count :initform 0 :accessor run-tests) (failures :initarg :failures :accessor failures :initform nil) @@ -19,27 +19,27 @@ (stop :initform nil :accessor stop)) (:documentation "Results of running test(s)")) -(defmethod failure-count ((res test-result)) +(defmethod failure-count ((res test-results)) (length (failures res))) -(defmethod error-count ((res test-result)) +(defmethod error-count ((res test-results)) (length (errors res))) -(defun make-test-result () - (make-instance 'test-result)) +(defun make-test-results () + (make-instance 'test-results)) -(defmethod start-test ((tcase test) (res test-result)) +(defmethod start-test ((tcase test) (res test-results)) (incf (run-tests res)) (mapc (lambda (listener) (start-test listener tcase)) (listeners res)) res) -(defmethod end-test ((tcase test) (res test-result)) +(defmethod end-test ((tcase test) (res test-results)) (incf (run-tests res)) (mapc (lambda (listener) (end-test listener tcase)) (listeners res)) res) -(defmethod add-listener ((res test-result) (listener test-listener)) +(defmethod add-listener ((res test-results) (listener test-listener)) (push listener (listeners res))) @@ -49,7 +49,7 @@ ((failed-test :initarg :failed-test :reader failed-test) (thrown-condition :initarg :thrown-condition :reader thrown-condition)) - (:documentation "Stored failures/errors in test-result slots")) + (:documentation "Stored failures/errors in test-results slots")) (defun make-test-failure (test condition) (make-instance 'test-failure :failed-test test @@ -66,7 +66,7 @@ (simple-condition-format-control (thrown-condition obj)) (simple-condition-format-arguments (thrown-condition obj))))) -(defmethod was-successful ((result test-result)) +(defmethod was-successful ((result test-results)) "Returns T if a result has no failures or errors" (and (null (failures result)) (null (errors result)))) @@ -75,14 +75,14 @@ ; methods add-error, add-failure ;---------------------------------------------------------------------- -(defmethod add-error ((ob test-result) (tcase test-case) condition) +(defmethod add-error ((ob test-results) (tcase test-case) condition) (push (make-test-failure tcase condition) (errors ob)) (mapc #'(lambda (single-listener) (add-error single-listener tcase condition)) (listeners ob))) -(defmethod add-failure ((ob test-result) (tcase test-case) condition) +(defmethod add-failure ((ob test-results) (tcase test-case) condition) (push (make-test-failure tcase condition) (failures ob)) (mapc #'(lambda (single-listener) (add-failure single-listener tcase condition)) diff --git a/suite.lisp b/suite.lisp index 4a64425..42d4d61 100644 --- a/suite.lisp +++ b/suite.lisp @@ -2,7 +2,7 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; ID: $Id: suite.lisp,v 1.3 2003/08/04 16:13:58 kevin Exp $ +;;;; ID: $Id: suite.lisp,v 1.4 2003/08/04 16:42:27 kevin Exp $ ;;;; Purpose: Suite functions for XLUnit ;;;; ;;;; ************************************************************************* @@ -120,14 +120,3 @@ This is used to dynamically generate a list of tests for a fixture." (add-test (suite ,(caar class-name)) ,(caar class-name)) (textui-test-run ,(caar class-name)))) - -;;; Test Runners - -(defmethod textui-test-run ((suite test-suite) &key (stream t) - (handle-errors t)) - (let* ((start-time (get-internal-real-time)) - (result (run-on-test suite :handle-errors handle-errors)) - (seconds (/ (- (get-internal-real-time) start-time) - internal-time-units-per-second))) - (result-printer result seconds stream))) - diff --git a/test-case.lisp b/test-case.lisp index a61627b..2d54a13 100644 --- a/test-case.lisp +++ b/test-case.lisp @@ -2,7 +2,7 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; ID: $Id: test-case.lisp,v 1.1 2003/08/04 16:13:58 kevin Exp $ +;;;; ID: $Id: test-case.lisp,v 1.2 2003/08/04 16:42:27 kevin Exp $ ;;;; Purpose: Test fixtures for XLUnit ;;;; ;;;; ************************************************************************* @@ -56,9 +56,12 @@ that the setup method did for this instance.")) (defmethod tear-down ((test test-case)) ) +(defmethod run ((ob test-case)) + (run-on-test-result ob (make-instance 'test-results))) + -(defmethod run-on-test ((test test-case) +(defmethod run-on-test-result ((test test-case) &key (result (make-instance 'test-result)) (handle-errors t)) (start-test test result)