r5453: *** empty log message ***
authorKevin M. Rosenberg <kevin@rosenberg.net>
Mon, 4 Aug 2003 16:43:20 +0000 (16:43 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Mon, 4 Aug 2003 16:43:20 +0000 (16:43 +0000)
.cvsignore [new file with mode: 0755]
assert.lisp
result.lisp
suite.lisp
test-case.lisp

diff --git a/.cvsignore b/.cvsignore
new file mode 100755 (executable)
index 0000000..691633a
--- /dev/null
@@ -0,0 +1,10 @@
+.bin
+*.fasl*
+*.dfsl
+*.pfsl
+*.ufsl
+*.fas
+*.fsl
+*.x86f
+*.sparcf
+*.cfsl
index fa2f100e92a216cf3bec1e0a4872b301e8e564e6..d46eaeb530e469e85e3f70dfff4afde0a947ac64 100644 (file)
@@ -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
 ;;;;
 ;;;; *************************************************************************
 
 
 (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)))
index 3ddead3d9fcd39df3a24b2b28db7d517afc6015f..1b7fd35984c9e60905f59664a427a5265ab8b7ff 100644 (file)
@@ -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)
    (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))))
 
 ; 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))
index 4a64425c9c89a870e3f5dbb96da25195c5552c83..42d4d616a44b49511439acb1e8539ea47cebebc7 100644 (file)
@@ -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)))
-
index a61627b60d14087ee671a9f63a65cb0d106a0e18..2d54a13a15d4f73b87822f64177b0e9063a4da7d 100644 (file)
@@ -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)