X-Git-Url: http://git.kpe.io/?a=blobdiff_plain;f=tests.lisp;h=9b519193f16ce4543b49a9a9feb3bd56f42cbb85;hb=381a23bb7ab8dd206bcd430ce9c7ee9c53e52f13;hp=9e4d4b7fcfd5f5d83aacb53b5412960854c23296;hpb=c7bc011f355411986f238987a4f97c93f66818dc;p=xlunit.git diff --git a/tests.lisp b/tests.lisp index 9e4d4b7..9b51919 100644 --- a/tests.lisp +++ b/tests.lisp @@ -2,22 +2,22 @@ ;;;; ************************************************************************* ;;;; FILE IDENTIFICATION ;;;; -;;;; Name: tests.lisp -;;;; Purpose: Test suite for XLTest -;;;; Author: Kevin Rosenberg +;;;; Id: $Id: tests.lisp,v 1.8 2003/08/04 17:04:50 kevin Exp $ +;;;; Purpose: Test suite for XLUnit ;;;; -;;;; Put in public domain by Kevin Rosenberg -;;;; $Id: tests.lisp,v 1.2 2003/08/04 09:46:44 kevin Exp $ ;;;; ************************************************************************* -(defpackage #:xltest-tests - (:use #:cl #:xltest)) +(in-package #:cl-user) +(defpackage #:xlunit-tests + (:use #:cl #:xlunit) + (:export #:do-tests)) +(in-package #:xlunit-tests) -(in-package #:xltest-tests) -(defclass was-run (test-fixture) - ((log :accessor ws-log))) +;; Helper test fixture +(defclass was-run (test-case) + ((log :accessor ws-log))) (defmethod setup ((self was-run)) (setf (ws-log self) "setup ")) @@ -34,57 +34,56 @@ (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))) +;;; Main test fixture + +(defclass test-case-test (test-case) + ()) (defmethod test-template-method ((self test-case-test)) (let ((test (make-test 'was-run 'test-method))) - (run-test test (result self)) + (run-test test) (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-results ((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)) +(defmethod test-fn ((self test-case-test)) (let ((test (make-test 'was-run '"Test Failure" - :test-thunk + :test-fn (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))))) + (assert-equal "1 run, 0 erred, 0 failed" + (summary (run-test test))))) (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))))) + (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)) - (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))))) - + (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"))) + (let ((suite (make-test-suite "TestSuite")) + (result (make-test-results))) (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)))) + (run-test suite :result result) + (assert-equal "2 run, 0 erred, 1 failed" (summary result)))) (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)))) + (assert-equal "3 run, 1 erred, 1 failed" + (summary (run-test (make-test-suite 'was-run))))) + +(textui-test-run (make-test-suite 'test-case-test) :handle-errors nil) -(text-testrunner (make-test-suite 'test-case-test)) +(defun do-tests () + (or (was-successful + (run-test (make-test-suite 'test-case-test))) + (error "Failed tests")))