tests.lisp

   1 ;;;; -*- Mode: LISP; Syntax: ANSI-Common-Lisp; Base: 10 -*-
   2 ;;;; *************************************************************************
   3 ;;;; FILE IDENTIFICATION
   4 ;;;;
   5 ;;;; Id:      $Id$
   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 #+ignore
  53 (def-test-method test-not-condition-with-cond ((self was-run) :run nil)
  54   (assert-not-condition 'test-condition
  55                         (signal 'test-condition)))
  56
  57
  58 ;;; Second helper test case
  59
  60 (defclass test-two-cases (test-case)
  61   ())
  62
  63 (def-test-method test-1 ((self test-two-cases) :run nil)
  64     (assert-true t))
  65
  66 (def-test-method test-2 ((self test-two-cases) :run nil)
  67     (assert-false nil))
  68
  69 ;;; Main test fixture
  70
  71 (defclass test-case-test (test-case)
  72   ())
  73
  74
  75 (def-test-method test-template-method ((self test-case-test) :run nil)
  76   (let ((test (named-test 'test-method (get-suite was-run))))
  77     (run test)
  78     (assert-equal (ws-log test) "setup test-method teardown ")))
  79
  80 (def-test-method test-results ((self test-case-test) :run nil)
  81   (assert-equal "1 run, 0 erred, 0 failed"
  82                 (summary (run (named-test 'test-method
  83                                           (get-suite was-run))))))
  84
  85 (def-test-method test-eql ((self test-case-test) :run nil)
  86   (assert-equal "1 run, 0 erred, 0 failed"
  87                 (summary (run (named-test 'test-eql (get-suite was-run))))))
  88
  89 (def-test-method test-not-eql ((self test-case-test) :run nil)
  90   (assert-equal "1 run, 0 erred, 0 failed"
  91                 (summary (run (named-test 'test-not-eql
  92                                           (get-suite was-run))))))
  93
  94 (def-test-method test-fn ((self test-case-test) :run nil)
  95   (let ((test (make-instance 'test-case :name 'test-fn
  96                               :method-body
  97                               (lambda ()
  98                                 (declare (ignore test))
  99                                 (assert-equal 10 10)))))
 100     (assert-equal "1 run, 0 erred, 0 failed"
 101                   (summary (run test)))))
 102
 103 (def-test-method test-failed-result ((self test-case-test) :run nil)
 104   (assert-equal "1 run, 0 erred, 1 failed"
 105                 (summary (run
 106                           (named-test 'test-broken-method
 107                                       (get-suite was-run))))))
 108
 109 (def-test-method test-error-result ((self test-case-test) :run nil)
 110     (assert-equal "1 run, 1 erred, 0 failed"
 111                   (summary (run
 112                             (named-test 'test-error-method
 113                                         (get-suite was-run))))))
 114
 115 (def-test-method test-suite ((self test-case-test) :run nil)
 116   (let ((suite (make-instance 'test-suite))
 117         (result (make-test-results)))
 118     (add-test suite (named-test 'test-method (get-suite was-run)))
 119     (add-test suite (named-test 'test-broken-method (get-suite was-run)))
 120     (run-on-test-results suite result)
 121     (assert-equal "2 run, 0 erred, 1 failed" (summary result))))
 122
 123 (def-test-method test-dynamic-suite ((self test-case-test) :run nil)
 124   (assert-equal "2 run, 0 erred, 0 failed"
 125                 (summary (run (get-suite test-two-cases)))))
 126
 127 (def-test-method test-condition ((self test-case-test) :run nil)
 128   (assert-condition
 129    'test-condition
 130    (error 'test-condition)))
 131
 132 (def-test-method test-condition-without-cond ((self test-case-test)
 133                                               :run nil)
 134   (assert-equal "1 run, 0 erred, 1 failed"
 135                 (summary (run
 136                           (named-test 'test-condition-without-cond
 137                                       (get-suite was-run))))))
 138
 139 #+ignore
 140 (def-test-method test-not-condition ((self test-case-test) :run nil)
 141   (assert-not-condition
 142    'test-condition
 143    (progn)))
 144
 145 #+ignore
 146 (def-test-method test-not-condition-with-cond ((self test-case-test)
 147                                               :run nil)
 148   (assert-equal "1 run, 0 erred, 1 failed"
 149                 (summary (run
 150                           (named-test 'test-not-condition-with-cond
 151                                       (get-suite was-run))))))
 152
 153 #+ignore
 154 (textui-test-run (get-suite test-case-test))
 155
 156
 157 (defun do-tests ()
 158   (or (was-successful (run (get-suite test-case-test)))
 159       (error "Failed tests")))