tests.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Id:      $Id: tests.lisp,v 1.14 2003/08/08 00:57:20 kevin Exp $
   6 ;;;; Purpose: Self Test suite for XLUnit
   7 ;;;;
   8 ;;;; *************************************************************************
   9
  10 (in-package #:cl-user)
  11 (defpackage #:xlunit-tests
  12   (:use #:cl #:xlunit)
  13   (:export #:do-tests))
  14 (in-package #:xlunit-tests)
  15
  16 (define-condition test-condition (error)
  17   ())
  18
  19
  20 ;; Helper test fixture
  21
  22 (defclass was-run (test-case)
  23   ((log :accessor ws-log)))
  24
  25 (defmethod set-up ((self was-run))
  26     (setf (ws-log self) "setup "))
  27
  28 (defmethod tear-down ((self was-run))
  29   (setf (ws-log self)
  30         (concatenate 'string (ws-log self) "teardown ")))
  31
  32 (def-test-method test-method ((self was-run) :run nil)
  33     (setf (ws-log self)
  34       (concatenate 'string (ws-log self) "test-method ")))
  35
  36 (def-test-method test-broken-method ((self was-run) :run nil)
  37     (assert-equal pi (/ 22 7)))
  38
  39 (def-test-method test-not-eql ((self was-run) :run nil)
  40     (assert-not-eql (cons t t) (cons t t)))
  41
  42 (def-test-method test-eql ((self was-run) :run nil)
  43     (let ((obj (cons t t)))
  44       (assert-eql obj obj)))
  45
  46 (def-test-method test-error-method ((self was-run) :run nil)
  47     (error "Err"))
  48
  49 (def-test-method test-condition-without-cond ((self was-run) :run nil)
  50   (assert-condition 'error (list 'no-error)))
  51
  52 (def-test-method test-not-condition-with-cond ((self was-run) :run nil)
  53   (assert-not-condition 'test-condition
  54                         (signal 'test-condition)))
  55
  56
  57 ;;; Second helper test case
  58
  59 (defclass test-two-cases (test-case)
  60   ())
  61
  62 (def-test-method test-1 ((self test-two-cases) :run nil)
  63     (assert-true t))
  64
  65 (def-test-method test-2 ((self test-two-cases) :run nil)
  66     (assert-false nil))
  67
  68 ;;; Main test fixture
  69
  70 (defclass test-case-test (test-case)
  71   ())
  72
  73
  74 (def-test-method test-template-method ((self test-case-test) :run nil)
  75   (let ((test (named-test 'test-method (get-suite was-run))))
  76     (run test)
  77     (assert-equal (ws-log test) "setup test-method teardown ")))
  78
  79 (def-test-method test-results ((self test-case-test) :run nil)
  80   (assert-equal "1 run, 0 erred, 0 failed"
  81                 (summary (run (named-test 'test-method
  82                                           (get-suite was-run))))))
  83
  84 (def-test-method test-eql ((self test-case-test) :run nil)
  85   (assert-equal "1 run, 0 erred, 0 failed"
  86                 (summary (run (named-test 'test-eql (get-suite was-run))))))
  87
  88 (def-test-method test-not-eql ((self test-case-test) :run nil)
  89   (assert-equal "1 run, 0 erred, 0 failed"
  90                 (summary (run (named-test 'test-not-eql
  91                                           (get-suite was-run))))))
  92
  93 (def-test-method test-fn ((self test-case-test) :run nil)
  94   (let ((test (make-instance 'test-case :name 'test-fn
  95                               :method-body
  96                               (lambda ()
  97                                 (declare (ignore test))
  98                                 (assert-equal 10 10)))))
  99     (assert-equal "1 run, 0 erred, 0 failed"
 100                   (summary (run test)))))
 101
 102 (def-test-method test-failed-result ((self test-case-test) :run nil)
 103   (assert-equal "1 run, 0 erred, 1 failed"
 104                 (summary (run
 105                           (named-test 'test-broken-method
 106                                       (get-suite was-run))))))
 107
 108 (def-test-method test-error-result ((self test-case-test) :run nil)
 109     (assert-equal "1 run, 1 erred, 0 failed"
 110                   (summary (run
 111                             (named-test 'test-error-method
 112                                         (get-suite was-run))))))
 113
 114 (def-test-method test-suite ((self test-case-test) :run nil)
 115   (let ((suite (make-instance 'test-suite))
 116         (result (make-test-results)))
 117     (add-test suite (named-test 'test-method (get-suite was-run)))
 118     (add-test suite (named-test 'test-broken-method (get-suite was-run)))
 119     (run-on-test-results suite result)
 120     (assert-equal "2 run, 0 erred, 1 failed" (summary result))))
 121
 122 (def-test-method test-dynamic-suite ((self test-case-test) :run nil)
 123   (assert-equal "2 run, 0 erred, 0 failed"
 124                 (summary (run (get-suite test-two-cases)))))
 125
 126 (def-test-method test-condition ((self test-case-test) :run nil)
 127   (assert-condition
 128    'test-condition
 129    (error (make-instance 'test-condition))))
 130
 131 (def-test-method test-condition-without-cond ((self test-case-test)
 132                                               :run nil)
 133   (assert-equal "1 run, 0 erred, 1 failed"
 134                 (summary (run
 135                           (named-test 'test-condition-without-cond
 136                                       (get-suite was-run))))))
 137
 138 (def-test-method test-not-condition ((self test-case-test) :run nil)
 139   (assert-not-condition
 140    'test-condition
 141    (progn)))
 142
 143 (def-test-method test-not-condition-with-cond ((self test-case-test)
 144                                               :run nil)
 145   (assert-equal "1 run, 0 erred, 1 failed"
 146                 (summary (run
 147                           (named-test 'test-not-condition-with-cond
 148                                       (get-suite was-run))))))
 149
 150 (textui-test-run (get-suite test-case-test))
 151
 152
 153 (defun do-tests ()
 154   (or (was-successful (run (get-suite test-case-test)))
 155       (error "Failed tests")))