From 626d4ad3a850e199e5b4a472c06ae92532c82ac8 Mon Sep 17 00:00:00 2001 From: "Kevin M. Rosenberg" Date: Wed, 6 Aug 2003 11:37:23 +0000 Subject: [PATCH] r5461: *** empty log message *** --- example.lisp | 8 ++++---- suite.lisp | 21 +++------------------ tests.lisp | 34 +++++++++++++++++----------------- 3 files changed, 24 insertions(+), 39 deletions(-) diff --git a/example.lisp b/example.lisp index 5ddd148..73ab439 100644 --- a/example.lisp +++ b/example.lisp @@ -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 ;;;; ;;;; ************************************************************************* @@ -33,16 +33,16 @@ (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"))) diff --git a/suite.lisp b/suite.lisp index 391258e..4592100 100644 --- a/suite.lisp +++ b/suite.lisp @@ -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)))) - diff --git a/tests.lisp b/tests.lisp index 2659b84..b91520c 100644 --- a/tests.lisp +++ b/tests.lisp @@ -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 ;;;; ;;;; ************************************************************************* @@ -26,21 +26,21 @@ (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")) @@ -49,10 +49,10 @@ (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 @@ -61,26 +61,26 @@ ()) -(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 () @@ -89,19 +89,19 @@ (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))) @@ -109,7 +109,7 @@ (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))))) -- 2.34.1