--- /dev/null
+.bin
+*.fasl*
+*.dfsl
+*.pfsl
+*.ufsl
+*.fas
+*.fsl
+*.x86f
+*.sparcf
+*.cfsl
;;;; *************************************************************************
;;;; 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
;;;;
;;;; *************************************************************************
(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)))
;;;; *************************************************************************
;;;; 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
;;;;
;;;; *************************************************************************
(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)
(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)))
((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
(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))))
; 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))
;;;; *************************************************************************
;;;; 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
;;;;
;;;; *************************************************************************
(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)))
-
;;;; *************************************************************************
;;;; 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
;;;;
;;;; *************************************************************************
(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)