r5461: *** empty log message ***
authorKevin M. Rosenberg <kevin@rosenberg.net>
Wed, 6 Aug 2003 11:37:23 +0000 (11:37 +0000)
committerKevin M. Rosenberg <kevin@rosenberg.net>
Wed, 6 Aug 2003 11:37:23 +0000 (11:37 +0000)
example.lisp
suite.lisp
tests.lisp

index 5ddd14841436bd9287e9337c10cb7de10cc51f53..73ab43974003224e3ac142e644fb09f3be524463 100644 (file)
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; ID:      $Id: example.lisp,v 1.8 2003/08/05 22:56:25 kevin Exp $
+;;;; ID:      $Id: example.lisp,v 1.9 2003/08/06 11:37:23 kevin Exp $
 ;;;; Purpose: Example file for XLUnit
 ;;;;
 ;;;; *************************************************************************
   (setf (numberb tcase) 3))
 
 
-(def-test-method (test-addition test math-test-case :run nil)
+(def-test-method test-addition ((test math-test-case) :run nil)
   (let ((result (+ (numbera test) (numberb test))))
     (assert-true (= result 5))))
 
-(def-test-method (test-subtraction test math-test-case :run nil)
+(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
-(def-test-method (test-subtraction-2 test math-test-case :run nil)
+(def-test-method test-subtraction-2 ((test math-test-case) :run nil)
   (let ((result (- (numbera test) (numberb test))))
     (assert-equal result 1 "This is meant to failure")))
 
index 391258e26afb373f15de2b9f014b62dc7882c456..4592100637ad30c018cce32e270f7b4449ddcc7f 100644 (file)
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; ID:      $Id: suite.lisp,v 1.7 2003/08/05 22:56:25 kevin Exp $
+;;;; ID:      $Id: suite.lisp,v 1.8 2003/08/06 11:37:23 kevin Exp $
 ;;;; Purpose: Suite functions for XLUnit
 ;;;;
 ;;;; *************************************************************************
@@ -69,22 +69,8 @@ This is used to dynamically generate a list of tests for a fixture."
     (nreverse res)))
 
 
-;----------------------------------------------------------------------
-; macro def-test-method
-;
-; Creates the representation of a test method (included within a
-; test-case object) and add it to the corresponding suite class.
-; => clos version of the pluggable selector pattern
-;
-; use:  (def-test-method test-assert-false (clos-unit-test)
-;          (assert-true (eql (+ 1 2) 4) "comment"))
-;
-; new: it calls the textui-test-run function during eval, so to
-;      allow the usual lisp-like incremental developing and test.
-;----------------------------------------------------------------------
-                                                                                 
-(defmacro def-test-method ((method-name instance-name class-name
-                           &key (run t))
+(defmacro def-test-method (method-name ((instance-name class-name)
+                                       &key (run t))
                           &body method-body)
   `(let ((,instance-name
           (make-instance ',class-name
@@ -94,4 +80,3 @@ This is used to dynamically generate a list of tests for a fixture."
      (add-test (suite ,instance-name) ,instance-name)
      (when ,run 
        (textui-test-run ,instance-name))))
-                                                                                 
index 2659b84ad3a55cba848c9234546cd9f2e1893507..b91520c21475bd273529b655bbb147c3c32473c7 100644 (file)
@@ -2,7 +2,7 @@
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
-;;;; Id:      $Id: tests.lisp,v 1.11 2003/08/05 22:56:25 kevin Exp $
+;;;; Id:      $Id: tests.lisp,v 1.12 2003/08/06 11:37:23 kevin Exp $
 ;;;; Purpose: Self Test suite for XLUnit
 ;;;;
 ;;;; *************************************************************************
   (setf (ws-log self)
        (concatenate 'string (ws-log self) "teardown ")))
 
-(def-test-method (test-method self was-run :run nil)
+(def-test-method test-method ((self was-run) :run nil)
     (setf (ws-log self) 
       (concatenate 'string (ws-log self) "test-method ")))
 
-(def-test-method (test-broken-method self was-run :run nil)
+(def-test-method test-broken-method ((self was-run) :run nil)
     (assert-equal pi (/ 22 7)))
 
-(def-test-method (test-not-eql self was-run :run nil)
+(def-test-method test-not-eql ((self was-run) :run nil)
     (assert-not-eql (cons t t) (cons t t)))
 
-(def-test-method (test-eql self was-run :run nil)
+(def-test-method test-eql ((self was-run) :run nil)
     (let ((obj (cons t t)))
       (assert-eql obj obj)))
 
-(def-test-method (test-error-method self was-run :run nil)
+(def-test-method test-error-method ((self was-run) :run nil)
     (error "Err"))
 
 
 (defclass test-two-cases (test-case)
   ())
 
-(def-test-method (test-1 self test-two-cases :run nil)
+(def-test-method test-1 ((self test-two-cases) :run nil)
     (assert-true t))
 
-(def-test-method (test-2 self test-two-cases :run nil)
+(def-test-method test-2 ((self test-two-cases) :run nil)
     (assert-false nil))
 
 ;;; Main test fixture
   ())
 
 
-(def-test-method (test-template-method self test-case-test :run nil)
+(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 ")))
 
-(def-test-method (test-results self test-case-test :run nil)
+(def-test-method test-results ((self test-case-test) :run nil)
   (assert-equal "1 run, 0 erred, 0 failed" 
                (summary (run (named-test 'test-method 
                                          (get-suite was-run))))))
 
-(def-test-method (test-eql self test-case-test :run nil)
+(def-test-method test-eql ((self test-case-test) :run nil)
   (assert-equal "1 run, 0 erred, 0 failed" 
                (summary (run (named-test 'test-eql (get-suite was-run))))))
 
-(def-test-method (test-not-eql self test-case-test :run nil)
+(def-test-method test-not-eql ((self test-case-test) :run nil)
   (assert-equal "1 run, 0 erred, 0 failed" 
                (summary (run (named-test 'test-not-eql
                                          (get-suite was-run))))))
 
-(def-test-method (test-fn self test-case-test :run nil)
+(def-test-method test-fn ((self test-case-test) :run nil)
   (let ((test (make-instance 'test-case :name 'test-fn
                              :method-body
                              (lambda () 
     (assert-equal "1 run, 0 erred, 0 failed"
                  (summary (run test)))))
 
-(def-test-method (test-failed-result self test-case-test :run nil)
+(def-test-method test-failed-result ((self test-case-test) :run nil)
   (assert-equal "1 run, 0 erred, 1 failed"
                (summary (run
                          (named-test 'test-broken-method
                                      (get-suite was-run))))))
 
-(def-test-method (test-error-result self test-case-test :run nil)
+(def-test-method test-error-result ((self test-case-test) :run nil)
     (assert-equal "1 run, 1 erred, 0 failed"
                  (summary (run
                            (named-test 'test-error-method
                                        (get-suite was-run))))))
   
-(def-test-method (test-suite self test-case-test :run nil)
+(def-test-method test-suite ((self test-case-test) :run nil)
   (let ((suite (make-instance 'test-suite))
        (result (make-test-results)))
     (add-test suite (named-test 'test-method (get-suite was-run)))
     (run-on-test-results suite result)
     (assert-equal "2 run, 0 erred, 1 failed" (summary result))))
 
-(def-test-method (test-dynamic-suite self test-case-test :run nil)
+(def-test-method test-dynamic-suite ((self test-case-test) :run nil)
   (assert-equal "2 run, 0 erred, 0 failed" 
                (summary (run (get-suite test-two-cases)))))