X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests.lisp;h=ef8ed7cf01b09b19da9a99ed82ee962d48ead6dd;hb=318cda1a328e9d99af2270c73cb13262e485a1ff;hp=9f2302adb23af5263f0a1aab3fa71b21c6344218;hpb=95c39c23a9d9db5b42fbc784ac75557fb1eb1a60;p=xlunit.git diff --git a/tests.lisp b/tests.lisp index 9f2302a..ef8ed7c 100644 --- a/tests.lisp +++ b/tests.lisp @@ -3,20 +3,86 @@ ;;;; FILE IDENTIFICATION ;;;; ;;;; Name: tests.lisp -;;;; Purpose: Test suite for XLTest +;;;; Purpose: Test suite for XLUnit ;;;; 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.4 2003/08/04 12:01:54 kevin Exp $ ;;;; ************************************************************************* -(defpackage #:xltest-tests - (:use #:cl #:xltest)) +(defpackage #:xlunit-tests + (:use #:cl #:xlunit)) -(in-package #:xltest-tests) +(in-package #:xlunit-tests) -(defclass xltests (test-fixture) - () - ) -(defmethod xltes +;; Helper 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")) + +;;; Main test fixture + +(defclass test-case-test (test-fixture) + ()) + +(defmethod test-template-method ((self test-case-test)) + (let ((test (make-test 'was-run 'test-method))) + (run-test test) + (assert-equal (ws-log test) "setup test-method teardown "))) + +(defmethod test-result ((self test-case-test)) + (assert-equal "1 run, 0 erred, 0 failed" + (summary (run-test (make-test 'was-run 'test-method))))) + +(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))))) + (assert-equal "1 run, 0 erred, 0 failed" + (summary (run-test test))))) + +(defmethod test-failed-result ((self test-case-test)) + (assert-equal "1 run, 0 erred, 1 failed" + (summary (run-test + (make-test 'was-run 'test-broken-method))))) + +(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))))) + +(defmethod test-suite ((self test-case-test)) + (let ((suite (make-test-suite "TestSuite")) + (result (make-test-result))) + (add-test (make-test 'was-run 'test-method) suite) + (add-test (make-test 'was-run 'test-broken-method) suite) + (run-test suite :result result) + (assert-equal "2 run, 0 erred, 1 failed" (summary result)))) + +(defmethod test-dynamic-suite ((self test-case-test)) + (assert-equal "3 run, 1 erred, 1 failed" + (summary (run-test (make-test-suite 'was-run))))) + +(text-testrunner (make-test-suite 'test-case-test) :handle-errors nil) + +(defun do-tests () + (or (was-successful + (run-test (make-test-suite 'test-case-test))) + (error "Failed tests")))