r5450: *** empty log message ***
authorKevin M. Rosenberg <kevin@rosenberg.net>
Mon, 4 Aug 2003 12:16:13 +0000 (12:16 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Mon, 4 Aug 2003 12:16:13 +0000 (12:16 +0000)
assert.lisp
example.lisp
fixture.lisp
package.lisp
printer.lisp
result.lisp
suite.lisp
tests.lisp

index 8307e2fbfd82cb68ab5824e4f81cdaffd7a3fcd7..269e797af812df4c46f63a38e30d922d46b10e9b 100644 (file)
@@ -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)
index 44da45792d0444a989ba8a9145ec9a1eb85e248e..5265bcad013c22c928e533a01f3a3fc5d8ecb62f 100644 (file)
@@ -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
index 8408cc841c535cb5c9aa3a93f1f1719db522a145..84f28bf500cf06a9960ce225b4cb3c0c0c0981ee 100644 (file)
@@ -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))
index 4b51cf509d8d577dd8b202d54911d28435b85925..c2b1780eae6d4cc6890996f52f7af148006d30b7 100644 (file)
@@ -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
index 16f1bdb85cac9514678037fc5d771e2cc8edef34..af4adfc32694981fdbb334d027ee2bd4b128ee0c 100644 (file)
@@ -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)
index ba95e4a00eb7658075ed9a9bc51fd6704781c1f9..57ceba31def2df3f9373202cfb578f9b63f8974e 100644 (file)
@@ -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)
    (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))))
index 046b61ad67543f68a00d6422c9ad8cb343c5d431..e410b5daa958d8708d75e2ec9009f6280f2b17a0 100644 (file)
@@ -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)
index ef8ed7cf01b09b19da9a99ed82ee962d48ead6dd..555b6acd382cca5a50d34f4dedf6be453e743ea1 100644 (file)
@@ -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)))))