;;;; *************************************************************************
;;;; 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")))
;;;; *************************************************************************
;;;; 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
;;;;
;;;; *************************************************************************
(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
(add-test (suite ,instance-name) ,instance-name)
(when ,run
(textui-test-run ,instance-name))))
-
;;;; *************************************************************************
;;;; 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)))))