xptest-example.lisp

   1 ;;; -*- Mode: Lisp -*-
   2 ;;;; xptest-eaxmple.lisp --- Example of test suite based on Extreme
   3 ;;;;                         Programming Framework by Kent Beck
   4 ;;;;
   5 ;;;; Author: Craig Brozefsky <craig@onshore.com>
   6 ;;;; Put in public domain by onShore, Inc
   7
   8 (defpackage #:xp-test-example
   9   (:use #:common-lisp #:xp-test)
  10   (:export
  11    #:math-test-suite))
  12
  13 (in-package #:xp-test-example)
  14
  15 ;;; First we define some basic fixtures that we are going to need to
  16 ;;; perform our tests.  A fixture is a place to hold data we need
  17 ;;; during testing.  Often there are many test cases that use the same
  18 ;;; data.  Each of these test cases is an instance of a test-fixture.
  19
  20 (def-test-fixture math-fixture ()
  21   ((numbera
  22     :accessor numbera)
  23    (numberb
  24     :accessor numberb))
  25   (:documentation "Test fixture for math testing"))
  26
  27 ;;; Then we define a setup method for the fixture.  This method is run
  28 ;;; prior to perfoming any test with an instance of this fixture.  It
  29 ;;; should perform all initialization needed, and assume that it is starting
  30 ;;; with a pristine environment, well to a point, use your head here.
  31
  32 (defmethod setup ((fix math-fixture))
  33   (setf (numbera fix) 2)
  34   (setf (numberb fix) 3))
  35
  36 ;;; Then we define a teardown method, which should return the instance
  37 ;;; to it's original form and reset the environment.  In this case
  38 ;;; there is little for us to do since the fixture is quite static.
  39 ;;; In other cases we may need to clear some database tables, or
  40 ;;; otherwise get rid of state built up while perofmring the test.
  41 ;;; Here we just return T.
  42
  43 (defmethod teardown ((fix math-fixture))
  44   t)
  45
  46 ;;; Once we hav a fixture we can start defining method on it which
  47 ;;; will perform tests.  These methods should take one argument, an
  48 ;;; instance of the fixture.  The method performs some operation and
  49 ;;; then performs some tests to determine if the proper behavior
  50 ;;; occured.  If there is a failure to behave as excpeted the method
  51 ;;; raises a test-failure object by calling the method FAILURE.  This
  52 ;;; is much like calling ERROR in that it stops processing that
  53 ;;; method.  Each method should only check for one aspect of behavior.
  54 ;;; This way triggering one failure would not result in another
  55 ;;; behavior check from being skipped.  It does not matter what these
  56 ;;; methods return
  57
  58 (defmethod addition-test ((test math-fixture))
  59   (let ((result (+ (numbera test) (numberb test))))
  60     (unless (= result 5)
  61       (failure "Result was not 5 when adding ~A and ~A"
  62                (numbera test) (numberb test)))))
  63
  64 (defmethod subtraction-test ((test math-fixture))
  65   (let ((result (- (numberb test) (numbera test))))
  66     (unless (= result 1)
  67       (failure "Result was not 1 when subtracting ~A ~A"
  68               (numberb test) (numbera test)))))
  69
  70 ;;; This method is meant to signal a failure
  71 (defmethod subtraction-test2 ((test math-fixture))
  72   (let ((result (- (numbera test) (numberb test))))
  73     (unless (= result 1)
  74       (failure "Result was not 1 when subtracting ~A ~A"
  75               (numbera test) (numberb test)))))
  76
  77
  78 ;;; Now we can create a test-suite.  A test-suite contains a group of
  79 ;;; test-cases (instances of test-fixture) and/or other test-suites.
  80 ;;; We can specify which tests are in a test-suite when we define the
  81 ;;; test-suite, or we can add them later.  See the documentation and
  82 ;;; argument list for make-test-case for details on how to specify a
  83 ;;; test-case.
  84
  85 (setf math-test-suite (make-test-suite
  86                        "Math Test Suite"
  87                        "Simple test suite for arithmetic operators."
  88                        ("Addition Test" 'math-fixture
  89                         :test-thunk 'addition-test
  90                         :description "A simple test of the + operator")
  91                        ("Subtraction Test" 'math-fixture
  92                         :test-thunk 'subtraction-test
  93                         :description "A simple test of the - operator")))
  94
  95 (add-test (make-test-case "Substraction Test 2" 'math-fixture
  96                           :test-thunk 'subtraction-test2
  97                           :description "A broken substraction test, should fail.")
  98           math-test-suite)
  99
 100 ;;;; Finally we can run our test suite and see how it performs.
 101 ;;;; (report-result (run-test math-test-suite) :verbose t)