tests/qtest.lisp

   1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
   2 ;;;                                                                  ;;;
   3 ;;; Free Software published under an MIT-like license. See LICENSE   ;;;
   4 ;;;                                                                  ;;;
   5 ;;; Copyright (c) 2012 Google, Inc.  All rights reserved.            ;;;
   6 ;;;                                                                  ;;;
   7 ;;; Original author: Scott McKay                                     ;;;
   8 ;;;                                                                  ;;;
   9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  10
  11 (in-package "PROTO-TEST")
  12
  13
  14 ;;; Ultra light-weight test framework
  15
  16 (defmacro define-test (test-name () &body body)
  17   `(defun ,test-name ()
  18      (handler-case
  19          (progn ,@body)
  20        (error (e)
  21          (warn "An error was signalled executing ~S: ~A"
  22                ',test-name e)))))
  23
  24 (defmacro define-test-suite (suite-name () &body body)
  25   (if (listp (car body))
  26     ;; QRes-style body
  27     `(defun ,suite-name ()
  28        ,@(loop for test in (car body)
  29                collect (list test)))
  30     ;; The more sensible style
  31     `(defun ,suite-name ()
  32        ,@(loop for test in body
  33                collect (list test)))))
  34
  35 (defvar *all-registered-tests* ())
  36 (defmacro register-test (test-name)
  37   `(pushnew ,test-name *all-registered-tests*))
  38
  39 (defmacro run-test (test-name)
  40   `(progn
  41      (format t "~&Running test ~A" ',test-name)
  42      (funcall ',test-name)))
  43
  44 (defun run-all-tests ()
  45   (dolist (test *all-registered-tests*)
  46     (format t "~&Running test ~A" test)
  47     (funcall test)))
  48
  49 (defmacro assert-equal (actual expected &key (test '#'equal))
  50   `(unless (funcall ,test ,actual ,expected)
  51      (warn "The value of ~S (~S) is not equal to the expected value ~S"
  52            ',actual ,actual ,expected)))
  53
  54 (defmacro assert-true (form)
  55   `(unless ,form
  56      (warn "The value of ~S (~S) does not evaluate to 'true'"
  57            ',form ,form)))
  58
  59 (defmacro assert-false (form)
  60   `(when ,form
  61      (warn "The value ~S (~S) does not evaluate to 'false'"
  62            ',form ,form)))
  63
  64 (defmacro assert-error (condition &body body)
  65   "Checks if BODY signals a condition of class CONDITION. If it does not, a failure is
  66    reported. If it is, the condition is caught and the condition object returned so that the test
  67    can perform further checks on the condition object."
  68   (let ((c (gensym "C")))
  69     `(handler-case (progn ,@body)
  70        (,condition (,c)
  71          ,c)
  72        (:no-error ()
  73          (warn "Expected condition ~a while evaluating~{ ~s~}" ',condition ',body)))))