1 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
3 ;;; Free Software published under an MIT-like license. See LICENSE ;;;
5 ;;; Copyright (c) 2012 Google, Inc. All rights reserved. ;;;
7 ;;; Original author: Scott McKay ;;;
9 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
11 (in-package "PROTO-TEST")
14 ;;; Ultra light-weight test framework
16 (defmacro define-test (test-name () &body body)
21 (warn "An error was signalled executing ~S: ~A"
24 (defmacro define-test-suite (suite-name () &body body)
25 (if (listp (car body))
27 `(defun ,suite-name ()
28 ,@(loop for test in (car body)
30 ;; The more sensible style
31 `(defun ,suite-name ()
32 ,@(loop for test in body
33 collect (list test)))))
35 (defvar *all-registered-tests* ())
36 (defmacro register-test (test-name)
37 `(pushnew ,test-name *all-registered-tests*))
39 (defmacro run-test (test-name)
41 (format t "~&Running test ~A" ',test-name)
42 (funcall ',test-name)))
44 (defun run-all-tests ()
45 (dolist (test *all-registered-tests*)
46 (format t "~&Running test ~A" test)
49 (defmacro assert-equal (actual expected &key (test 'equal))
50 `(unless (,test ,actual ,expected)
51 (warn "The value ~S is not equal to the expected value ~S"
52 ',actual ',expected)))
54 (defmacro assert-true (form)
56 (warn "The value ~S does not evaluate to 'true'"
59 (defmacro assert-false (form)
61 (warn "The value ~S does not evaluate to 'false'"
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)
73 (warn "Expected condition ~a while evaluating~{ ~s~}" ',condition ',body)))))