X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests.lisp;fp=tests.lisp;h=9e4d4b7fcfd5f5d83aacb53b5412960854c23296;hb=c7bc011f355411986f238987a4f97c93f66818dc;hp=9f2302adb23af5263f0a1aab3fa71b21c6344218;hpb=95c39c23a9d9db5b42fbc784ac75557fb1eb1a60;p=xlunit.git diff --git a/tests.lisp b/tests.lisp index 9f2302a..9e4d4b7 100644 --- a/tests.lisp +++ b/tests.lisp @@ -7,7 +7,7 @@ ;;;; Author: Kevin Rosenberg ;;;; ;;;; Put in public domain by Kevin Rosenberg -;;;; $Id: tests.lisp,v 1.1 2003/08/04 06:00:01 kevin Exp $ +;;;; $Id: tests.lisp,v 1.2 2003/08/04 09:46:44 kevin Exp $ ;;;; ************************************************************************* (defpackage #:xltest-tests @@ -15,8 +15,76 @@ (in-package #:xltest-tests) -(defclass xltests (test-fixture) - () - ) +(defclass was-run (test-fixture) + ((log :accessor ws-log))) + + +(defmethod setup ((self was-run)) + (setf (ws-log self) "setup ")) + +(defmethod teardown ((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 "))) + +(defmethod test-broken-method ((self was-run)) + (assert-equal pi (/ 22 7))) + +(defmethod test-error-method ((self was-run)) + (error "Err")) + +(defclass test-case-test (test-fixture) + ((result :accessor result))) + +(defmethod setup ((self test-case-test)) + (setf (result self) (make-instance 'test-result))) + +(defmethod test-template-method ((self test-case-test)) + (let ((test (make-test 'was-run 'test-method))) + (run-test test (result self)) + (assert-equal (ws-log test) "setup test-method teardown "))) + +(defmethod test-result ((self test-case-test)) + (let ((test (make-test 'was-run 'test-method))) + (run-test test (result self)) + (assert-equal "1 run, 0 errored, 0 failed" (summary (result self))))) + +(defmethod test-thunk ((self test-case-test)) + (let ((test (make-test 'was-run '"Test Failure" + :test-thunk + (lambda (test) + (declare (ignore test)) + (assert-equal 10 10))))) + (run-test test (result self)) + (assert-equal "1 run, 0 errored, 0 failed" + (summary (result self))))) + +(defmethod test-failed-result ((self test-case-test)) + (let ((test (make-test 'was-run 'test-broken-method))) + (run-test test (result self)) + (assert-equal "1 run, 0 errored, 1 failed" + (summary (result self))))) + +(defmethod test-error-result ((self test-case-test)) + (let ((test (make-test 'was-run 'test-error-method))) + (run-test test (result self)) + (assert-equal "1 run, 1 errored, 0 failed" + (summary (result self))))) + +(defmethod test-suite ((self test-case-test)) + (let ((suite (make-test-suite "TestSuite"))) + (add-test (make-test 'was-run 'test-method) suite) + (add-test (make-test 'was-run 'test-broken-method) suite) + (run-test suite (result self))) + (assert-equal "2 run, 0 errored, 1 failed" + (summary (result self)))) + +(defmethod test-dynamic-suite ((self test-case-test)) + (let ((suite (make-test-suite 'was-run))) + (run-test suite (result self))) + (assert-equal "3 run, 1 errored, 1 failed" + (summary (result self)))) + +(text-testrunner (make-test-suite 'test-case-test)) -(defmethod xltes