r5455: *** empty log message ***

diff --git a/LICENSE b/LICENSE
index 8ba724ee58d2fc1092490ef5c3870f16ea3f96b9..dfdbaca6fa692045a6441df4fdd127ad41b7e834 100644 (file)
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,6 @@
-Copyright (c) 2003 Kevin M. Rosenberg
+Copyright (c) 2003 Kevin M. Rosenberg <kevin@rosenberg.net>
+Copyright (C) 2002 Canoo Engineering AG <sandro.pedrazzini_at_canoo.com>
+

 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without

diff --git a/Makefile b/Makefile
new file mode 100644 (file)
index 0000000..0c6e148
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,9 @@
+all:
+
+
+.PHONY: clean
+clean:
+       @rm -rf .bin 
+       @rm -f *.ufsl *.fsl *.fas *.x86f *.sparcf *.fasl* *.lib
+       @rm -f *~ *.bak *.orig *.err \#*\# .#*
+

diff --git a/README b/README
index a2079b71d630bd7e2d99ad20b3d1ad9a4c6b27a9..7fceecbc8c4992de83f21b23cba7773927f75095 100644 (file)
--- a/README
+++ b/README
@@ -1,10 +1,8 @@
 XLUnit provides a unit testing package for Common Lisp.  It it based
 XLUnit provides a unit testing package for Common Lisp.  It it based

-on the XPTest package by OnShore development, but is rewritten to be
-closer in usage to the JUnit package.
-
-XLUnit it is designed to be used with significantly less overhead on
-the part of the test author compared to XPTest. Most powerfully,
-XLUnit can create dynamic test suites based on defined methods.
+on the 3 similar packages:
+   JUnit by Kent Beck
+   XPTest package by OnShore development
+   CLOS-unit by Sandro Pedrazzini

 
 XLUnit comes with its own test suite (tests.lisp) along with an
 example file (example.lisp).
 
 XLUnit comes with its own test suite (tests.lisp) along with an
 example file (example.lisp).

diff --git a/debian/changelog b/debian/changelog
index b4dd85464f6f4811a4aa90b3af43c1e3ba1b1a88..b3fd5b8c741cca98b7b69672a412bcf8e624aa8a 100644 (file)
--- a/debian/changelog
+++ b/debian/changelog
@@ -1,3 +1,9 @@
+cl-xlunit (0.5.0-1) unstable; urgency=low
+
+  * New usptream
+
+ -- Kevin M. Rosenberg <kmr@debian.org>  Mon,  4 Aug 2003 13:39:48 -0600
+

 cl-xlunit (0.2.0-1) unstable; urgency=low
 
   * New version
 cl-xlunit (0.2.0-1) unstable; urgency=low
 
   * New version

diff --git a/debian/copyright b/debian/copyright
index 85f2d571429933f0932c445271bb1c55e8a8f6c5..cb106ad9a696a3224a24aeeebb6774f693ad8338 100644 (file)
--- a/debian/copyright
+++ b/debian/copyright
@@ -8,7 +8,9 @@ Debian Maintainer:  Kevin M. Rosenberg <kmr@debian.org>
 
 Upstream Copyright Statement
 ============================
 
 Upstream Copyright Statement
 ============================

-Copyright (c) 2003 Kevin M. Rosenberg
+Copyright (c) 2003 Kevin M. Rosenberg <kevin@rosenberg.net>
+Copyright (C) 2002 Canoo Engineering AG <sandro.pedrazzini_at_canoo.com>
+

 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without
 All rights reserved.
 
 Redistribution and use in source and binary forms, with or without

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

-;;;; ID:      $Id: example.lisp,v 1.6 2003/08/04 17:04:49 kevin Exp $
+;;;; ID:      $Id: example.lisp,v 1.7 2003/08/04 19:31:34 kevin Exp $

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


@@ -32,19 +32,20 @@
   (setf (numbera tcase) 2)
   (setf (numberb tcase) 3))
 
   (setf (numbera tcase) 2)
   (setf (numberb tcase) 3))
 

-(def-test-method test-addition ((test math-test-case))
+
+(def-test-method (test-addition test math-test-case :run nil)

   (let ((result (+ (numbera test) (numberb test))))
     (assert-true (= result 5))))
 
   (let ((result (+ (numbera test) (numberb test))))
     (assert-true (= result 5))))
 

-(def-test-method test-subtraction ((test math-test-case))
+(def-test-method (test-subtraction test math-test-case :run nil)

   (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-test-case))
+(def-test-method (test-subtraction-2 test math-test-case :run nil)

   (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-instance 'math-test-case))
+(textui-test-run (get-suite math-test-case))

 
 

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

-;;;; ID:      $Id: package.lisp,v 1.7 2003/08/04 17:04:49 kevin Exp $
+;;;; ID:      $Id: package.lisp,v 1.8 2003/08/04 19:31:34 kevin Exp $

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

-;;;; $Id: package.lisp,v 1.7 2003/08/04 17:04:49 kevin Exp $
+;;;; $Id: package.lisp,v 1.8 2003/08/04 19:31:34 kevin Exp $

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


@@ -37,9 +37,12 @@
    #:setup-testsuite-named
    #:teardown-testsuite-named
    #:add-test
    #:setup-testsuite-named
    #:teardown-testsuite-named
    #:add-test

-   #:test-named
+   #:named-test

    #:remove-test
    #:tests
    #:remove-test
    #:tests

+   #:get-suite
+   #:test-suite
+   #:run-on-test-results

    
    ;; printer.lisp
    #:summary
    
    ;; printer.lisp
    #:summary

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

-;;;; ID:      $Id: printer.lisp,v 1.4 2003/08/04 17:04:49 kevin Exp $
+;;;; ID:      $Id: printer.lisp,v 1.5 2003/08/04 19:31:34 kevin Exp $

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


@@ -41,7 +41,8 @@
       (let ((i 1))
         (mapc #'(lambda (single-error)
                   (format (ostream ob) "~a) ~a: ~a~%" i
       (let ((i 1))
         (mapc #'(lambda (single-error)
                   (format (ostream ob) "~a) ~a: ~a~%" i

-                          (name (car single-error)) (cdr single-error))
+                          (name (failed-test single-error))
+                         (thrown-condition single-error))

                   (incf i))
               errors)))))
 
                   (incf i))
               errors)))))
 


@@ -53,8 +54,9 @@
         (format (ostream ob) "~%There were ~a failures:~%" (length failures)))
       (let ((i 1))
         (mapc #'(lambda (single-failure)
         (format (ostream ob) "~%There were ~a failures:~%" (length failures)))
       (let ((i 1))
         (mapc #'(lambda (single-failure)

-                  (format (ostream ob) "~a) ~a: ~a~%" i (name (car single-failure))
-                          (or (message (cdr single-failure)) ""))
+                  (format (ostream ob) "~a) ~a: ~a~%" i 
+                         (name (failed-test single-failure))
+                          (or (message (thrown-condition single-failure)) ""))

                   (incf i))
               failures)))))
 
                   (incf i))
               failures)))))
 

diff --git a/result.lisp b/result.lisp
index 1b7fd35984c9e60905f59664a427a5265ab8b7ff..eb49d0fc3773fb557c84e2cc581d918ff5066317 100644 (file)
--- a/result.lisp
+++ b/result.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;

-;;;; ID:      $Id: result.lisp,v 1.5 2003/08/04 16:42:27 kevin Exp $
+;;;; ID:      $Id: result.lisp,v 1.6 2003/08/04 19:31:34 kevin Exp $

 ;;;; Purpose:  Result functions for XLUnit
 ;;;;
 ;;;; *************************************************************************
 ;;;; Purpose:  Result functions for XLUnit
 ;;;;
 ;;;; *************************************************************************


@@ -35,7 +35,6 @@
   res)
 
 (defmethod end-test ((tcase test) (res test-results))
   res)
 
 (defmethod end-test ((tcase test) (res test-results))

-  (incf (run-tests res))

   (mapc (lambda (listener) (end-test listener tcase)) (listeners res))
   res)
 
   (mapc (lambda (listener) (end-test listener tcase)) (listeners res))
   res)
 

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

-;;;; ID:      $Id: suite.lisp,v 1.5 2003/08/04 17:04:49 kevin Exp $
+;;;; ID:      $Id: suite.lisp,v 1.6 2003/08/04 19:31:34 kevin Exp $

 ;;;; Purpose: Suite functions for XLUnit
 ;;;;
 ;;;; *************************************************************************
 
 (in-package #:xlunit)
 
 ;;;; Purpose: Suite functions for XLUnit
 ;;;;
 ;;;; *************************************************************************
 
 (in-package #:xlunit)
 

-(defclass test-suite ()
+(defclass test-suite (test)

   ((name :initform "" :initarg :name :reader test-suite-name)
    (tests :initarg :tests :accessor tests :initform nil)
    (description :initarg :description :reader description
   ((name :initform "" :initarg :name :reader test-suite-name)
    (tests :initarg :tests :accessor tests :initform nil)
    (description :initarg :description :reader description


@@ -19,65 +19,37 @@
   `(suite (make-instance ',class-name)))
  
 
   `(suite (make-instance ',class-name)))
  
 

-(defmethod setup-testsuite-named (name)
-  (declare (ignore name))
-  t)
-
-(defmethod teardown-testsuite-named (name)
-  (declare (ignore name))
-  t)
-
-(defmethod run-on-test ((suite test-suite)
-                    &key (result (make-instance 'test-results))
-                    (handle-errors t))
-  (setup-testsuite-named (slot-value suite 'name))
-  (dolist (test (tests suite))
-    (run-on-test test :result result :handle-errors handle-errors))
-  (teardown-testsuite-named (slot-value suite 'name))
-  result)
-
-

 (defmethod add-test ((ob test-suite) (new-test test))
 (defmethod add-test ((ob test-suite) (new-test test))

-  (setf (tests ob)
-        (delete-if #'(lambda (existing-tests-or-suite)
-                       (cond ((typep existing-tests-or-suite 'test-suite)
-                              (eq existing-tests-or-suite new-test))
-                             ((typep existing-tests-or-suite 'test-case)
-                              (eql (name existing-tests-or-suite)
-                                   (name new-test)))))
-                   (tests ob)))
+  (remove-test new-test ob)

   (setf (tests ob) (append (tests ob) (list new-test))))
 
   (setf (tests ob) (append (tests ob) (list new-test))))
 

-#|
-(defmethod remove-test ((test test-case) (suite test-suite))
-  (remhash (name test) (tests-hash suite)))
-
-(defmethod remove-test ((test test-suite) (suite test-suite))
-  (remhash (test-suite-name test) (tests-hash suite)))

 
 

-(defmethod named ((name string) (suite test-suite))
-  (gethash name (tests-hash suite)))
-|#
+(defmethod run-on-test-results ((ob test-suite) (result test-results)
+                               &key (handle-errors t))
+  (mapc #'(lambda (composite)  ;;test-case or suite
+            (run-on-test-results composite result
+                               :handle-errors handle-errors))
+        (tests ob)))
+
+(defmethod named-test (name (suite test-suite))
+  (some (lambda (test-or-suite)
+         (when (and (typep test-or-suite 'test-case)
+                    (equal name (name test-or-suite)))
+           test-or-suite))
+       (tests suite)))
+
+(defmethod remove-test ((test test) (suite test-suite))
+  (setf (tests suite)
+    (delete-if #'(lambda (existing-tests-or-suite)
+                  (cond ((typep existing-tests-or-suite 'test-suite)
+                         (eq existing-tests-or-suite new-test))
+                        ((typep existing-tests-or-suite 'test-case)
+                         (eql (name existing-tests-or-suite)
+                              (name test)))))
+              (tests suite))))

 
 ;; Dynamic test suite
 
 
 ;; Dynamic test suite
 

-(defun make-test-suite-for-fixture 
-    (fixture &key
-            (name 
-             (format nil "Automatic for ~A"
-                     (if (slot-boundp fixture 'name) 
-                         (name fixture)
-                       (type-of fixture))))
-            description)
-  (let ((suite  (make-instance 'test-suite
-                 :name name
-                 :description description))
-       (fns (find-test-generic-functions fixture)))
-    (dolist (fn fns)
-      (make-test (class-name (class-of fixture)) fn
-                :test-suite suite))
-    suite))
-

 (defun find-test-generic-functions (instance)
   "Return a list of symbols for generic functions specialized on the
 class of an instance and whose name begins with the string 'test-'.
 (defun find-test-generic-functions (instance)
   "Return a list of symbols for generic functions specialized on the
 class of an instance and whose name begins with the string 'test-'.


@@ -111,12 +83,15 @@ This is used to dynamically generate a list of tests for a fixture."
 ;      allow the usual lisp-like incremental developing and test.
 ;----------------------------------------------------------------------
                                                                                  
 ;      allow the usual lisp-like incremental developing and test.
 ;----------------------------------------------------------------------
                                                                                  

-(defmacro def-test-method (method-name class-name &body method-body)
-  `(let ((,(caar class-name)
-          (make-instance ',(cadar class-name)
+(defmacro def-test-method ((method-name instance-name class-name
+                           &key (run t))
+                          &body method-body)
+  `(let ((,instance-name
+          (make-instance ',class-name

             :name ',method-name)))
             :name ',method-name)))

-     (setf (method-body ,(caar class-name))
+     (setf (method-body ,instance-name)

            #'(lambda() ,@method-body))
            #'(lambda() ,@method-body))

-     (add-test (suite ,(caar class-name)) ,(caar class-name))
-     (textui-test-run ,(caar class-name))))
+     (add-test (suite ,instance-name) ,instance-name)
+     (when ,run 
+       (textui-test-run ,instance-name))))

                                                                                  
                                                                                  

diff --git a/tcase.lisp b/tcase.lisp
index da0d8ded73b5868c510094dac93ab7dee05e7a38..3d68142afba33e56f6b0f2cee2fc6040f6dbc77d 100644 (file)
--- a/tcase.lisp
+++ b/tcase.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;

-;;;; ID:      $Id: tcase.lisp,v 1.1 2003/08/04 17:04:49 kevin Exp $
+;;;; ID:      $Id: tcase.lisp,v 1.2 2003/08/04 19:31:34 kevin Exp $

 ;;;; Purpose: Test fixtures for XLUnit
 ;;;;
 ;;;; *************************************************************************
 ;;;; Purpose: Test fixtures for XLUnit
 ;;;;
 ;;;; *************************************************************************


@@ -21,7 +21,7 @@
     :documentation
     "A function designator which will be applied to this instance
 to perform that test-case.")
     :documentation
     "A function designator which will be applied to this instance
 to perform that test-case.")

-   (name :initarg :name :reader name
+   (name :initarg :name :reader name :initform ""

         :documentation "The name of this test-case, used in reports.")
    (description :initarg :description :reader description
                :documentation
         :documentation "The name of this test-case, used in reports.")
    (description :initarg :description :reader description
                :documentation


@@ -56,9 +56,11 @@ that the setup method did for this instance."))
 (defmethod tear-down ((test test-case))
   )
 
 (defmethod tear-down ((test test-case))
   )
 

-(defmethod run ((ob test-case))
-  (run-on-test-results ob (make-instance 'test-results)))
-   
+(defmethod run ((ob test) &key (handle-errors t))
+  "Generalized to work on test-case and test-suites"
+  (let ((res (make-test-results)))
+    (run-on-test-results ob res :handle-errors t)
+    res))

 
 (defmethod run-on-test-results ((test test-case) result
                                &key (handle-errors t))
 
 (defmethod run-on-test-results ((test test-case) result
                                &key (handle-errors t))


@@ -73,7 +75,7 @@ that the setup method did for this instance."))
     (tear-down test)))
 
 (defmethod run-test ((test test-case))
     (tear-down test)))
 
 (defmethod run-test ((test test-case))

-  (funcall (method-body test)))
+    (funcall (method-body test)))

 
 (defmethod run-protected ((test test-case) res &key (handle-errors t))
   (handler-case
 
 (defmethod run-protected ((test test-case) res &key (handle-errors t))
   (handler-case


@@ -85,63 +87,5 @@ that the setup method did for this instance."))
   res)
 
 
   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/tests.lisp b/tests.lisp
index 9b519193f16ce4543b49a9a9feb3bd56f42cbb85..3b848a4c6ed29df24ccec98633065d29bb6ee25a 100644 (file)
--- a/tests.lisp
+++ b/tests.lisp
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;

-;;;; Id:      $Id: tests.lisp,v 1.8 2003/08/04 17:04:50 kevin Exp $
+;;;; Id:      $Id: tests.lisp,v 1.9 2003/08/04 19:31:34 kevin Exp $

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


@@ -19,20 +19,22 @@
 (defclass was-run (test-case)
   ((log :accessor ws-log)))
 
 (defclass was-run (test-case)
   ((log :accessor ws-log)))
 

-(defmethod setup ((self was-run))
-  (setf (ws-log self) "setup "))
+(defmethod set-up ((self was-run))
+    (setf (ws-log self) "setup "))

 
 

-(defmethod teardown ((self was-run))
-  (setf (ws-log self) (concatenate 'string (ws-log self) "teardown ")))
+(defmethod tear-down ((self was-run))
+  (setf (ws-log self)
+       (concatenate 'string (ws-log self) "teardown ")))

 
 

-(defmethod test-method ((self was-run))
-  (setf (ws-log self) (concatenate 'string (ws-log self) "test-method ")))
+(def-test-method (test-method self was-run :run nil)
+    (setf (ws-log self) 
+      (concatenate 'string (ws-log self) "test-method ")))

 
 

-(defmethod test-broken-method ((self was-run))
-  (assert-equal pi (/ 22 7)))
+(def-test-method (test-broken-method self was-run :run nil)
+    (assert-equal pi (/ 22 7)))

 
 

-(defmethod test-error-method ((self was-run))
-  (error "Err"))
+(def-test-method (test-error-method self was-run :run nil)
+    (error "Err"))

 
 
 ;;; Main test fixture
 
 
 ;;; Main test fixture


@@ -40,50 +42,52 @@
 (defclass test-case-test (test-case)
   ())
 
 (defclass test-case-test (test-case)
   ())
 

-(defmethod test-template-method ((self test-case-test))
-  (let ((test (make-test 'was-run 'test-method)))
-    (run-test test)
+
+(def-test-method (test-template-method self test-case-test :run nil)
+  (let ((test (named-test 'test-method (get-suite was-run))))
+    (run test)

     (assert-equal (ws-log test) "setup test-method teardown ")))
 
     (assert-equal (ws-log test) "setup test-method teardown ")))
 

-(defmethod test-results ((self test-case-test))
+(def-test-method (test-results self test-case-test :run nil)

   (assert-equal "1 run, 0 erred, 0 failed" 
   (assert-equal "1 run, 0 erred, 0 failed" 

-               (summary (run-test (make-test 'was-run 'test-method)))))
-
-(defmethod test-fn ((self test-case-test))
-  (let ((test (make-test 'was-run '"Test Failure"
-                        :test-fn
-                        (lambda (test) 
-                          (declare (ignore test))
-                          (assert-equal 10 10)))))
+               (summary (run (named-test 'test-method (get-suite was-run))))))
+
+(def-test-method (test-fn self test-case-test :run nil)
+  (let ((test (make-instance 'test-case :name 'test-fn
+                             :method-body
+                             (lambda () 
+                               (declare (ignore test))
+                               (assert-equal 10 10)))))

     (assert-equal "1 run, 0 erred, 0 failed"
     (assert-equal "1 run, 0 erred, 0 failed"

-                 (summary (run-test test)))))
+                 (summary (run test)))))

 
 

-(defmethod test-failed-result ((self test-case-test))
+(def-test-method (test-failed-result self test-case-test :run nil)

   (assert-equal "1 run, 0 erred, 1 failed"
                (summary (run-test
   (assert-equal "1 run, 0 erred, 1 failed"
                (summary (run-test

-                         (make-test 'was-run 'test-broken-method)))))
+                         (named-test 'test-broken-method (get-suite was-run))))))

 
 

-(defmethod test-error-result ((self test-case-test))
-  (assert-equal "1 run, 1 erred, 0 failed"
-               (summary (run-test
-                         (make-test 'was-run 'test-error-method)))))
+(def-test-method (test-error-result self test-case-test :run nil)
+    (assert-equal "1 run, 1 erred, 0 failed"
+                 (summary (run-test
+                           (named-test 'test-error-method
+                                       (get-suite was-run))))))

   
   

-(defmethod test-suite ((self test-case-test))
-  (let ((suite (make-test-suite "TestSuite"))
+(def-test-method (test-suite self test-case-test :run nil)
+  (let ((suite (make-instance 'test-suite))

        (result (make-test-results)))
        (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 suite (named-test 'test-method (get-suite was-run)))
+    (add-test suite (named-test 'test-broken-method (get-suite was-run)))
+    (run-on-test-results suite result)

     (assert-equal "2 run, 0 erred, 1 failed" (summary result))))
 
     (assert-equal "2 run, 0 erred, 1 failed" (summary result))))
 

-(defmethod test-dynamic-suite ((self test-case-test))
+(def-test-method (test-dynamic-suite self test-case-test :run nil)

   (assert-equal "3 run, 1 erred, 1 failed" 
   (assert-equal "3 run, 1 erred, 1 failed" 

-               (summary (run-test (make-test-suite 'was-run)))))
+               (summary (run (get-suite was-run)))))
+

 
 

-(textui-test-run (make-test-suite 'test-case-test) :handle-errors nil)
+(textui-test-run (get-suite test-case-test))

 
 
 (defun do-tests ()
 
 
 (defun do-tests ()

-  (or (was-successful 
-       (run-test (make-test-suite 'test-case-test)))
+  (or (was-successful (run (get-suite test-case-test)))

       (error "Failed tests")))
       (error "Failed tests")))

diff --git a/xlunit.asd b/xlunit.asd
index 67c0fdd5647aca725bcb070a1f7c034c3be91f96..c7f293af20e0faba8ba17b02fe01833ffb6388be 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.4 2003/08/04 17:04:50 kevin Exp $
+;;;; $Id: xlunit.asd,v 1.5 2003/08/04 19:31:34 kevin Exp $

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


@@ -26,9 +26,9 @@
   ((:file "package")
    (:file "assert")
    (:file "tcase")
   ((:file "package")
    (:file "assert")
    (:file "tcase")

-   (:file "suite")

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

+   (:file "suite")

    (:file "textui")
    (:file "printer")
    ))
    (:file "textui")
    (:file "printer")
    ))