r5454: *** empty log message ***

diff --git a/example.lisp b/example.lisp
index 3fc9e3a2ce65a1cb3cd7c15a2291f29899bf87a0..837906b713cee0fa2945501a33430bd1f6697bab 100644 (file)
--- a/example.lisp
+++ b/example.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;

-;;;; ID:      $Id: example.lisp,v 1.5 2003/08/04 16:13:58 kevin Exp $
+;;;; ID:      $Id: example.lisp,v 1.6 2003/08/04 17:04:49 kevin Exp $

 ;;;; Purpose: Example file for XLUnit
 ;;;;
 ;;;; *************************************************************************
 ;;;; Purpose: Example file for XLUnit
 ;;;;
 ;;;; *************************************************************************


@@ -13,48 +13,38 @@
 
 (in-package #:xlunit-example)
 
 
 (in-package #:xlunit-example)
 

-;;; First we define some basic fixtures that we are going to need to
-;;; perform our tests.  A fixture is a place to hold data we need
+;;; First we define some basic test-cases that we are going to need to
+;;; perform our tests.  A test-case is a place to hold data we need

 ;;; during testing.  Often there are many test cases that use the same
 ;;; data.  Each of these test cases is an instance of a test-case.
 
 ;;; during testing.  Often there are many test cases that use the same
 ;;; data.  Each of these test cases is an instance of a test-case.
 

-(defclass math-fixture (test-case)
+(defclass math-test-case (test-case)

   ((numbera :accessor numbera)
    (numberb :accessor numberb))
   ((numbera :accessor numbera)
    (numberb :accessor numberb))

-  (:documentation "Test fixture for math testing"))
+  (:documentation "Test test-case for math testing"))

 
 

-;;; Then we define a set-up method for the fixture.  This method is run
-;;; prior to perfoming any test with an instance of this fixture.  It
+;;; Then we define a set-up method for the test-case.  This method is run
+;;; prior to perfoming any test with an instance of this test-case.  It

 ;;; should perform all initialization needed, and assume that it is starting
 ;;; with a pristine environment, well to a point, use your head here.
 
 ;;; should perform all initialization needed, and assume that it is starting
 ;;; with a pristine environment, well to a point, use your head here.
 

-(defmethod set-up ((fix math-fixture))
-  (setf (numbera fix) 2)
-  (setf (numberb fix) 3))
+(defmethod set-up ((tcase math-test-case))
+  (setf (numbera tcase) 2)
+  (setf (numberb tcase) 3))

 
 

-;;; Then we define a teardown method, which should return the instance
-;;; to it's original form and reset the environment.  In this case
-;;; there is little for us to do since the fixture is quite static.
-;;; In other cases we may need to clear some database tables, or
-;;; otherwise get rid of state built up while perofmring the test.
-;;; Here we just return T.
-
-(defmethod tear-down ((fix math-fixture))
-  t)
-
-(def-test-method test-addition ((test math-fixture))
+(def-test-method test-addition ((test math-test-case))

   (let ((result (+ (numbera test) (numberb test))))
   (let ((result (+ (numbera test) (numberb test))))

-    (test-assert (= result 5))))
+    (assert-true (= result 5))))

 
 

-(def-test-method test-subtraction ((test math-fixture))
+(def-test-method test-subtraction ((test math-test-case))

   (let ((result (- (numberb test) (numbera test))))
     (assert-equal result 1)))
 
 ;;; This method is meant to signal a failure
   (let ((result (- (numberb test) (numbera test))))
     (assert-equal result 1)))
 
 ;;; This method is meant to signal a failure

-(def-test-method test-subtraction-2 ((test math-fixture))
+(def-test-method test-subtraction-2 ((test math-test-case))

   (let ((result (- (numbera test) (numberb test))))
     (assert-equal result 1)))
 
 ;;;; Finally we can run our test suite and see how it performs.
   (let ((result (- (numbera test) (numberb test))))
     (assert-equal result 1)))
 
 ;;;; Finally we can run our test suite and see how it performs.

-(textui-test-run (make-test-suite 'math-fixture))
+(textui-test-run (make-instance 'math-test-case))

 
 

diff --git a/package.lisp b/package.lisp
index 6b58890dac78fc1cec7c4107b5edcc41fcaee129..ffaa50de62d978d82ca7451f5c379b708cfd351d 100644 (file)
--- a/package.lisp
+++ b/package.lisp
@@ -2,10 +2,10 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;

-;;;; ID:      $Id: package.lisp,v 1.6 2003/08/04 16:13:58 kevin Exp $
+;;;; ID:      $Id: package.lisp,v 1.7 2003/08/04 17:04:49 kevin Exp $

 ;;;; Purpose: Package definition for XLUnit
 ;;;;
 ;;;; Purpose: Package definition for XLUnit
 ;;;;

-;;;; $Id: package.lisp,v 1.6 2003/08/04 16:13:58 kevin Exp $
+;;;; $Id: package.lisp,v 1.7 2003/08/04 17:04:49 kevin Exp $

 ;;;; *************************************************************************
 
 (in-package #:cl-user)
 ;;;; *************************************************************************
 
 (in-package #:cl-user)


@@ -17,8 +17,9 @@
    ;; test-case.lisp
    #:test-case
    #:def-test-method
    ;; test-case.lisp
    #:test-case
    #:def-test-method

-   #:setup
-   #:teardown
+   #:set-up
+   #:tear-down
+   #:run

    #:run-test
    #:make-test
 
    #:run-test
    #:make-test
 


@@ -44,8 +45,8 @@
    #:summary
    
    ;; result.lisp
    #:summary
    
    ;; result.lisp

-   #:test-result
-   #:make-test-result
+   #:test-results
+   #:make-test-results

    #:was-successful
    )
   (:documentation "This is the XLUnit Framework."))
    #:was-successful
    )
   (:documentation "This is the XLUnit Framework."))

diff --git a/printer.lisp b/printer.lisp
index 729e0839e129a8814553a37e70872315f33add25..c89bfff0b722706124850b213fa5959d121e68c1 100644 (file)
--- a/printer.lisp
+++ b/printer.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;

-;;;; ID:      $Id: printer.lisp,v 1.3 2003/08/04 16:13:58 kevin Exp $
+;;;; ID:      $Id: printer.lisp,v 1.4 2003/08/04 17:04:49 kevin Exp $

 ;;;; Purpose: Printer functions for XLUnit
 ;;;;
 ;;;; *************************************************************************
 ;;;; Purpose: Printer functions for XLUnit
 ;;;;
 ;;;; *************************************************************************


@@ -58,38 +58,7 @@
                   (incf i))
               failures)))))
 
                   (incf i))
               failures)))))
 

-#|
-(defun result-printer (result seconds stream)
-  (format stream "~&Time: ~D~%~%" (coerce seconds 'float))
-  (print-defects (errors result) "error" stream)
-  (print-defects (failures result) "failure" stream)
-  (if (was-successful result)
-      (format stream "OK (~D tests)~%" (run-count result))
-    (progn
-      (format stream "~%FAILURES!!!~%")
-      (format stream "Tests run: ~D, Failures: ~D, Errors: ~D~%"
-             (run-count result) (failure-count result)
-             (error-count result)))))
-
-(defun print-defects (defects type stream)
-  (when defects
-    (let ((count (length defects)))
-      (if (= count 1)
-         (format stream "~&There was ~D ~A:~%" count type)
-       (format stream "~&There were ~D ~As:~%" count type))
-      (dotimes (i count)
-       (let ((defect (nth i defects)))
-         (format stream "~&~D) ~A " i (class-name
-                                       (class-of (failed-test defect))))
-         (apply #'format stream (simple-condition-format-control 
-                                 (thrown-condition defect))
-                (simple-condition-format-arguments 
-                 (thrown-condition defect)))
-         (fresh-line stream))))))
-
-|#
-

 (defgeneric summary (result))
 (defgeneric summary (result))

-(defmethod summary ((result test-result))
+(defmethod summary ((result test-results))

   (format nil "~D run, ~D erred, ~D failed"
   (format nil "~D run, ~D erred, ~D failed"

-         (run-count result) (error-count result) (failure-count result)))
+         (run-tests result) (error-count result) (failure-count result)))

diff --git a/suite.lisp b/suite.lisp
index 42d4d616a44b49511439acb1e8539ea47cebebc7..85cfcc6e2d40986119cca7c9d27012e940d8e356 100644 (file)
--- a/suite.lisp
+++ b/suite.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;

-;;;; ID:      $Id: suite.lisp,v 1.4 2003/08/04 16:42:27 kevin Exp $
+;;;; ID:      $Id: suite.lisp,v 1.5 2003/08/04 17:04:49 kevin Exp $

 ;;;; Purpose: Suite functions for XLUnit
 ;;;;
 ;;;; *************************************************************************
 ;;;; Purpose: Suite functions for XLUnit
 ;;;;
 ;;;; *************************************************************************


@@ -28,7 +28,7 @@
   t)
 
 (defmethod run-on-test ((suite test-suite)
   t)
 
 (defmethod run-on-test ((suite test-suite)

-                    &key (result (make-instance 'test-result))
+                    &key (result (make-instance 'test-results))

                     (handle-errors t))
   (setup-testsuite-named (slot-value suite 'name))
   (dolist (test (tests suite))
                     (handle-errors t))
   (setup-testsuite-named (slot-value suite 'name))
   (dolist (test (tests suite))

diff --git a/tcase.lisp b/tcase.lisp
new file mode 100644 (file)
index 0000000..da0d8de
--- /dev/null
+++ b/tcase.lisp
@@ -0,0 +1,147 @@
+;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
+;;;; *************************************************************************
+;;;; FILE IDENTIFICATION
+;;;;
+;;;; ID:      $Id: tcase.lisp,v 1.1 2003/08/04 17:04:49 kevin Exp $
+;;;; Purpose: Test fixtures for XLUnit
+;;;;
+;;;; *************************************************************************
+
+(in-package #:xlunit)
+
+
+(defclass test ()
+  ())
+
+(defclass test-case (test)
+  ((existing-suites :initform nil :accessor existing-suites
+                   :allocation :class)
+   (method-body
+    :initarg :method-body :accessor method-body :initform nil
+    :documentation
+    "A function designator which will be applied to this instance
+to perform that test-case.")
+   (name :initarg :name :reader name
+        :documentation "The name of this test-case, used in reports.")
+   (description :initarg :description :reader description
+               :documentation
+               "Short description of this test-case, uses in reports")
+   (suite :initform nil :accessor suite :initarg :suite))
+  (:documentation
+   "Base class for test-cases."))
+
+(defmethod initialize-instance :after ((ob test-case) &rest initargs)
+  (declare (ignore initargs))
+  (if (null (existing-suites ob))
+    (setf (existing-suites ob) (make-hash-table)))  ;;hash singleton
+  (unless (gethash (type-of ob) (existing-suites ob))
+    (setf (gethash (type-of ob) (existing-suites ob))
+          (make-instance 'test-suite)))             ;;specifi suite singleton
+  (setf (suite ob) (gethash (type-of ob) (existing-suites ob))))
+ 
+
+(defgeneric set-up (test)
+  (:documentation
+   "Method called before performing a test, should set up the
+environment the test-case needs to operate in."))
+
+(defmethod set-up ((test test-case))
+  )
+
+(defgeneric tear-down (test)
+  (:documentation
+   "Method called after performing a test.  Should reverse everything
+that the setup method did for this instance."))
+
+(defmethod tear-down ((test test-case))
+  )
+
+(defmethod run ((ob test-case))
+  (run-on-test-results ob (make-instance 'test-results)))
+   
+
+(defmethod run-on-test-results ((test test-case) result
+                               &key (handle-errors t))
+  (start-test test result)
+  (run-protected test result :handle-errors handle-errors)
+  (end-test test result))
+
+(defmethod run-base ((test test-case))
+  (set-up test)
+  (unwind-protect
+      (run-test test)
+    (tear-down test)))
+
+(defmethod run-test ((test test-case))
+  (funcall (method-body test)))
+
+(defmethod run-protected ((test test-case) res &key (handle-errors t))
+  (handler-case
+      (run-base test)
+    (assertion-failed (condition)
+      (add-failure res test condition))
+    (serious-condition (condition)
+      (add-error res test condition)))
+  res)
+
+
+(defmacro handler-case-if (test form &body cases)
+  `(if ,test
+       (handler-case
+        ,form
+       ,@cases)
+     ,form))
+
+(defmacro unwind-protect-if (test protected cleanup)
+  `(if ,test
+       (unwind-protect
+          ,protected
+        ,cleanup)
+     (progn ,protected ,cleanup)))
+
+#|
+(defmethod run-test ((test test-case)
+                    &key (result (make-instance 'test-results))
+                    (handle-errors t))
+  "Perform the test represented by the given test-case or test-suite.
+Returns a test-results object."
+  (incf (run-count result))
+  (with-slots (failures errors) result
+    (unwind-protect-if handle-errors
+       (handler-case-if handle-errors
+        (let ((res (progn (setup test)
+                          (funcall (method-body test) test))))
+          (when (typep res 'test-failure-condition)
+            (push (make-test-failure test res) failures)))
+        (test-failure-condition (failure)
+          (push (make-test-failure test failure) failures))
+        (error (err)
+          (push (make-test-failure test err) errors)))
+       
+       (if handle-errors
+           (handler-case
+               (teardown test)
+             (error (err)
+               (push (make-test-failure test err) errors)))
+           (teardown test))))
+  result)
+|#
+
+(defun make-test (fixture name &key method-body test-suite description)
+  "Create a test-case which is an instance of FIXTURE.  METHOD-BODY 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-case
+instance.  DESCRIPTION is obviously what it says it is."
+  (let ((newtest (make-instance fixture
+                  :name (etypecase name
+                               (symbol
+                                (string-downcase (symbol-name name)))
+                               (string
+                                name))
+                  :method-body 
+                  (if (and (symbolp name) (null method-body))
+                      name
+                    method-body)
+                  :description description)))
+    (when test-suite (add-test newtest test-suite))
+    newtest))

diff --git a/test-case.lisp b/test-case.lisp
deleted file mode 100644 (file)
index 2d54a13..0000000
--- a/test-case.lisp
+++ /dev/null
@@ -1,149 +0,0 @@
-;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
-;;;; *************************************************************************
-;;;; FILE IDENTIFICATION
-;;;;
-;;;; ID:      $Id: test-case.lisp,v 1.2 2003/08/04 16:42:27 kevin Exp $
-;;;; Purpose: Test fixtures for XLUnit
-;;;;
-;;;; *************************************************************************
-
-(in-package #:xlunit)
-
-
-(defclass test ()
-  ())
-
-(defclass test-case (test)
-  ((existing-suites :initform nil :accessor existing-suites
-                   :allocation :class)
-   (method-body
-    :initarg :method-body :accessor method-body :initform nil
-    :documentation
-    "A function designator which will be applied to this instance
-to perform that test-case.")
-   (name :initarg :name :reader name
-        :documentation "The name of this test-case, used in reports.")
-   (description :initarg :description :reader description
-               :documentation
-               "Short description of this test-case, uses in reports")
-   (suite :initform nil :accessor suite :initarg :suite))
-  (:documentation
-   "Base class for test-cases."))
-
-(defmethod initialize-instance :after ((ob test-case) &rest initargs)
-  (declare (ignore initargs))
-  (if (null (existing-suites ob))
-    (setf (existing-suites ob) (make-hash-table)))  ;;hash singleton
-  (unless (gethash (type-of ob) (existing-suites ob))
-    (setf (gethash (type-of ob) (existing-suites ob))
-          (make-instance 'test-suite)))             ;;specifi suite singleton
-  (setf (suite ob) (gethash (type-of ob) (existing-suites ob))))
- 
-
-(defgeneric set-up (test)
-  (:documentation
-   "Method called before performing a test, should set up the
-environment the test-case needs to operate in."))
-
-(defmethod set-up ((test test-case))
-  )
-
-(defgeneric tear-down (test)
-  (:documentation
-   "Method called after performing a test.  Should reverse everything
-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-result ((test test-case)
-                    &key (result (make-instance 'test-result))
-                    (handle-errors t))
-  (start-test test result)
-  (run-protected test result :handle-errors handle-errors)
-  (end-test test result))
-
-(defmethod run-base ((test test-case))
-  (set-up test)
-  (unwind-protect
-      (run-test test)
-    (tear-down test)))
-
-(defmethod run-test ((test test-case))
-  (funcall (method-body test)))
-
-(defmethod run-protected ((test test-case) res &key (handle-errors t))
-  (handler-case
-      (run-base test)
-    (assertion-failed (condition)
-      (add-failure res test condition))
-    (serious-condition (condition)
-      (add-error res test condition)))
-  res)
-
-
-(defmacro handler-case-if (test form &body cases)
-  `(if ,test
-       (handler-case
-        ,form
-       ,@cases)
-     ,form))
-
-(defmacro unwind-protect-if (test protected cleanup)
-  `(if ,test
-       (unwind-protect
-          ,protected
-        ,cleanup)
-     (progn ,protected ,cleanup)))
-
-#|
-(defmethod run-test ((test test-case)
-                    &key (result (make-instance 'test-result))
-                    (handle-errors t))
-  "Perform the test represented by the given test-case or test-suite.
-Returns a test-result object."
-  (incf (run-count result))
-  (with-slots (failures errors) result
-    (unwind-protect-if handle-errors
-       (handler-case-if handle-errors
-        (let ((res (progn (setup test)
-                          (funcall (method-body test) test))))
-          (when (typep res 'test-failure-condition)
-            (push (make-test-failure test res) failures)))
-        (test-failure-condition (failure)
-          (push (make-test-failure test failure) failures))
-        (error (err)
-          (push (make-test-failure test err) errors)))
-       
-       (if handle-errors
-           (handler-case
-               (teardown test)
-             (error (err)
-               (push (make-test-failure test err) errors)))
-           (teardown test))))
-  result)
-|#
-
-(defun make-test (fixture name &key method-body test-suite description)
-  "Create a test-case which is an instance of FIXTURE.  METHOD-BODY 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-case
-instance.  DESCRIPTION is obviously what it says it is."
-  (let ((newtest (make-instance fixture
-                  :name (etypecase name
-                               (symbol
-                                (string-downcase (symbol-name name)))
-                               (string
-                                name))
-                  :method-body 
-                  (if (and (symbolp name) (null method-body))
-                      name
-                    method-body)
-                  :description description)))
-    (when test-suite (add-test newtest test-suite))
-    newtest))

diff --git a/tests.lisp b/tests.lisp
index e5cfb41dfc2b8856c2eef3a8d275f6e2d2f13bc7..9b519193f16ce4543b49a9a9feb3bd56f42cbb85 100644 (file)
--- a/tests.lisp
+++ b/tests.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;

-;;;; Id:      $Id: tests.lisp,v 1.7 2003/08/04 16:13:58 kevin Exp $
+;;;; Id:      $Id: tests.lisp,v 1.8 2003/08/04 17:04:50 kevin Exp $

 ;;;; Purpose: Test suite for XLUnit
 ;;;;
 ;;;; *************************************************************************
 ;;;; Purpose: Test suite for XLUnit
 ;;;;
 ;;;; *************************************************************************


@@ -45,7 +45,7 @@
     (run-test test)
     (assert-equal (ws-log test) "setup test-method teardown ")))
 
     (run-test test)
     (assert-equal (ws-log test) "setup test-method teardown ")))
 

-(defmethod test-result ((self test-case-test))
+(defmethod test-results ((self test-case-test))

   (assert-equal "1 run, 0 erred, 0 failed" 
                (summary (run-test (make-test 'was-run 'test-method)))))
 
   (assert-equal "1 run, 0 erred, 0 failed" 
                (summary (run-test (make-test 'was-run 'test-method)))))
 


@@ -70,7 +70,7 @@
   
 (defmethod test-suite ((self test-case-test))
   (let ((suite (make-test-suite "TestSuite"))
   
 (defmethod test-suite ((self test-case-test))
   (let ((suite (make-test-suite "TestSuite"))

-       (result (make-test-result)))
+       (result (make-test-results)))

     (add-test (make-test 'was-run 'test-method) suite)
     (add-test (make-test 'was-run 'test-broken-method) suite)
     (run-test suite :result result)
     (add-test (make-test 'was-run 'test-method) suite)
     (add-test (make-test 'was-run 'test-broken-method) suite)
     (run-test suite :result result)

diff --git a/textui.lisp b/textui.lisp
index 92dbfb3b14d76f8239ae337731d9bf61e7733629..ec617e00f5a6ca426a5bbcd139e115d9b85b1909 100644 (file)
--- a/textui.lisp
+++ b/textui.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;

-;;;; ID:      $Id: textui.lisp,v 1.1 2003/08/04 16:13:58 kevin Exp $
+;;;; ID:      $Id: textui.lisp,v 1.2 2003/08/04 17:04:50 kevin Exp $

 ;;;; Purpose: Text UI for Test Runner
 ;;;;
 ;;;; *************************************************************************
 ;;;; Purpose: Text UI for Test Runner
 ;;;;
 ;;;; *************************************************************************


@@ -33,7 +33,7 @@
         (result (make-instance 'test-results))
        (start-time (get-internal-real-time)))
     (add-listener result test-runner)
         (result (make-instance 'test-results))
        (start-time (get-internal-real-time)))
     (add-listener result test-runner)

-    (run-on-test-result ob result)
+    (run-on-test-results ob result)

     (print-results test-runner result 
                   (/ (- (get-internal-real-time) start-time)
                     internal-time-units-per-second))))
     (print-results test-runner result 
                   (/ (- (get-internal-real-time) start-time)
                     internal-time-units-per-second))))

diff --git a/xlunit.asd b/xlunit.asd
index f6f3d44445fb65f61ef6b507471016ae47973ec4..67c0fdd5647aca725bcb070a1f7c034c3be91f96 100644 (file)
--- a/xlunit.asd
+++ b/xlunit.asd
@@ -7,7 +7,7 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Aug 2003
 ;;;;
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Aug 2003
 ;;;;

-;;;; $Id: xlunit.asd,v 1.3 2003/08/04 16:13:58 kevin Exp $
+;;;; $Id: xlunit.asd,v 1.4 2003/08/04 17:04:50 kevin Exp $

 ;;;; *************************************************************************
 
 (defpackage #:xlunit-system (:use #:asdf #:cl))
 ;;;; *************************************************************************
 
 (defpackage #:xlunit-system (:use #:asdf #:cl))


@@ -25,7 +25,7 @@
   :components
   ((:file "package")
    (:file "assert")
   :components
   ((:file "package")
    (:file "assert")

-   (:file "test-case")
+   (:file "tcase")

    (:file "suite")
    (:file "listener")
    (:file "result")
    (:file "suite")
    (:file "listener")
    (:file "result")