;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; Name:        example.lisp
;;;; Purpose:     Example file for XLTest
;;;; Authors:     Kevin Rosenberg and Craig Brozefsky
;;;;
;;;; Put in public domain by Kevin Rosenberg and onShore, Inc
;;;; $Id: example.lisp,v 1.1 2003/08/04 06:00:01 kevin Exp $
;;;; *************************************************************************

(defpackage #:xltest-example
  (:use #:cl #:xltest)
  (:export
   #:math-test-suite))

(in-package #:xltest-example)

;;; First we define some basic fixtures that we are going to need to
;;; perform our tests.  A fixture is a place to hold data we need
;;; during testing.  Often there are many test cases that use the same
;;; data.  Each of these test cases is an instance of a test-fixture.

(def-test-fixture math-fixture ()
  ((numbera
    :accessor numbera)
   (numberb
    :accessor numberb))
  (:documentation "Test fixture for math testing"))

;;; Then we define a setup method for the fixture.  This method is run
;;; prior to perfoming any test with an instance of this fixture.  It
;;; should perform all initialization needed, and assume that it is starting
;;; with a pristine environment, well to a point, use your head here.

(defmethod setup ((fix math-fixture))
  (setf (numbera fix) 2)
  (setf (numberb fix) 3))

;;; Then we define a teardown method, which should return the instance
;;; to it's original form and reset the environment.  In this case
;;; there is little for us to do since the fixture is quite static.
;;; In other cases we may need to clear some database tables, or
;;; otherwise get rid of state built up while perofmring the test.
;;; Here we just return T.

(defmethod teardown ((fix math-fixture))
  t)

;;; Once we hav a fixture we can start defining method on it which
;;; will perform tests.  These methods should take one argument, an
;;; instance of the fixture.  The method performs some operation and
;;; then performs some tests to determine if the proper behavior
;;; occured.  If there is a failure to behave as excpeted the method
;;; raises a test-failure object by calling the method FAILURE.  This
;;; is much like calling ERROR in that it stops processing that
;;; method.  Each method should only check for one aspect of behavior.
;;; This way triggering one failure would not result in another
;;; behavior check from being skipped.  It does not matter what these
;;; methods return

(defmethod test-addition ((test math-fixture))
  (let ((result (+ (numbera test) (numberb test))))
    (test-assert (= result 5))))

(defmethod test-subtraction ((test math-fixture))
  (let ((result (- (numberb test) (numbera test))))
    (assert-equal result 1)))

;;; This method is meant to signal a failure
(defmethod test-subtraction-2 ((test math-fixture))
  (let ((result (- (numbera test) (numberb test))))
    (assert-equal result 1)))


;;; Now we can create a test-suite.  A test-suite contains a group of
;;; test-cases (instances of test-fixture) and/or other test-suites.
;;; We can specify which tests are in a test-suite when we define the
;;; test-suite, or we can add them later.  See the documentation and
;;; argument list for make-test-case for details on how to specify a
;;; test-case.

(defparameter *manual-math-test-suite*
    (make-test-suite
     "Math Test Suite"
     "Simple test suite for arithmetic operators."
     '(("Addition Test" math-fixture
			:test-thunk test-addition
			:description "A simple test of the + operator")
       ("Subtraction Test" math-fixture
	:test-thunk test-subtraction
	:description "A simple test of the - operator"))))

(add-test (make-test-case "Subtraction Test 2" 'math-fixture
			  :test-thunk 'test-subtraction-2
			  :description "A broken substraction test, should fail.")
	  *manual-math-test-suite*)


(defparameter *dynamic-math-test-suite* (make-test-suite 'math-fixture))

;;;; Finally we can run our test suite and see how it performs.
(report-result (run-test *manual-math-test-suite*
			 :handle-errors t) :verbose t)

(report-result (run-test *dynamic-math-test-suite*
			 :handle-errors t) :verbose nil)