1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/test.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,758 @@
     1.4 +;   Copyright (c) Rich Hickey. All rights reserved.
     1.5 +;   The use and distribution terms for this software are covered by the
     1.6 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
     1.7 +;   which can be found in the file epl-v10.html at the root of this distribution.
     1.8 +;   By using this software in any fashion, you are agreeing to be bound by
     1.9 +;   the terms of this license.
    1.10 +;   You must not remove this notice, or any other, from this software.
    1.11 +
    1.12 +;;; test.clj: test framework for Clojure
    1.13 +
    1.14 +;; by Stuart Sierra
    1.15 +;; March 28, 2009
    1.16 +
    1.17 +;; Thanks to Chas Emerick, Allen Rohner, and Stuart Halloway for
    1.18 +;; contributions and suggestions.
    1.19 +
    1.20 +(ns 
    1.21 +  ^{:author "Stuart Sierra, with contributions and suggestions by 
    1.22 +  Chas Emerick, Allen Rohner, and Stuart Halloway",
    1.23 +     :doc "A unit testing framework.
    1.24 +
    1.25 +   ASSERTIONS
    1.26 +
    1.27 +   The core of the library is the \"is\" macro, which lets you make
    1.28 +   assertions of any arbitrary expression:
    1.29 +
    1.30 +   (is (= 4 (+ 2 2)))
    1.31 +   (is (instance? Integer 256))
    1.32 +   (is (.startsWith \"abcde\" \"ab\"))
    1.33 +
    1.34 +   You can type an \"is\" expression directly at the REPL, which will
    1.35 +   print a message if it fails.
    1.36 +
    1.37 +       user> (is (= 5 (+ 2 2)))
    1.38 +
    1.39 +       FAIL in  (:1)
    1.40 +       expected: (= 5 (+ 2 2))
    1.41 +         actual: (not (= 5 4))
    1.42 +       false
    1.43 +
    1.44 +   The \"expected:\" line shows you the original expression, and the
    1.45 +   \"actual:\" shows you what actually happened.  In this case, it
    1.46 +   shows that (+ 2 2) returned 4, which is not = to 5.  Finally, the
    1.47 +   \"false\" on the last line is the value returned from the
    1.48 +   expression.  The \"is\" macro always returns the result of the
    1.49 +   inner expression.
    1.50 +
    1.51 +   There are two special assertions for testing exceptions.  The
    1.52 +   \"(is (thrown? c ...))\" form tests if an exception of class c is
    1.53 +   thrown:
    1.54 +
    1.55 +   (is (thrown? ArithmeticException (/ 1 0))) 
    1.56 +
    1.57 +   \"(is (thrown-with-msg? c re ...))\" does the same thing and also
    1.58 +   tests that the message on the exception matches the regular
    1.59 +   expression re:
    1.60 +
    1.61 +   (is (thrown-with-msg? ArithmeticException #\"Divide by zero\"
    1.62 +                         (/ 1 0)))
    1.63 +
    1.64 +   DOCUMENTING TESTS
    1.65 +
    1.66 +   \"is\" takes an optional second argument, a string describing the
    1.67 +   assertion.  This message will be included in the error report.
    1.68 +
    1.69 +   (is (= 5 (+ 2 2)) \"Crazy arithmetic\")
    1.70 +
    1.71 +   In addition, you can document groups of assertions with the
    1.72 +   \"testing\" macro, which takes a string followed by any number of
    1.73 +   assertions.  The string will be included in failure reports.
    1.74 +   Calls to \"testing\" may be nested, and all of the strings will be
    1.75 +   joined together with spaces in the final report, in a style
    1.76 +   similar to RSpec <http://rspec.info/>
    1.77 +
    1.78 +   (testing \"Arithmetic\"
    1.79 +     (testing \"with positive integers\"
    1.80 +       (is (= 4 (+ 2 2)))
    1.81 +       (is (= 7 (+ 3 4))))
    1.82 +     (testing \"with negative integers\"
    1.83 +       (is (= -4 (+ -2 -2)))
    1.84 +       (is (= -1 (+ 3 -4)))))
    1.85 +
    1.86 +   Note that, unlike RSpec, the \"testing\" macro may only be used
    1.87 +   INSIDE a \"deftest\" or \"with-test\" form (see below).
    1.88 +
    1.89 +
    1.90 +   DEFINING TESTS
    1.91 +
    1.92 +   There are two ways to define tests.  The \"with-test\" macro takes
    1.93 +   a defn or def form as its first argument, followed by any number
    1.94 +   of assertions.  The tests will be stored as metadata on the
    1.95 +   definition.
    1.96 +
    1.97 +   (with-test
    1.98 +       (defn my-function [x y]
    1.99 +         (+ x y))
   1.100 +     (is (= 4 (my-function 2 2)))
   1.101 +     (is (= 7 (my-function 3 4))))
   1.102 +
   1.103 +   As of Clojure SVN rev. 1221, this does not work with defmacro.
   1.104 +   See http://code.google.com/p/clojure/issues/detail?id=51
   1.105 +
   1.106 +   The other way lets you define tests separately from the rest of
   1.107 +   your code, even in a different namespace:
   1.108 +
   1.109 +   (deftest addition
   1.110 +     (is (= 4 (+ 2 2)))
   1.111 +     (is (= 7 (+ 3 4))))
   1.112 +
   1.113 +   (deftest subtraction
   1.114 +     (is (= 1 (- 4 3)))
   1.115 +     (is (= 3 (- 7 4))))
   1.116 +
   1.117 +   This creates functions named \"addition\" and \"subtraction\", which
   1.118 +   can be called like any other function.  Therefore, tests can be
   1.119 +   grouped and composed, in a style similar to the test framework in
   1.120 +   Peter Seibel's \"Practical Common Lisp\"
   1.121 +   <http://www.gigamonkeys.com/book/practical-building-a-unit-test-framework.html>
   1.122 +
   1.123 +   (deftest arithmetic
   1.124 +     (addition)
   1.125 +     (subtraction))
   1.126 +
   1.127 +   The names of the nested tests will be joined in a list, like
   1.128 +   \"(arithmetic addition)\", in failure reports.  You can use nested
   1.129 +   tests to set up a context shared by several tests.
   1.130 +
   1.131 +
   1.132 +   RUNNING TESTS
   1.133 +
   1.134 +   Run tests with the function \"(run-tests namespaces...)\":
   1.135 +
   1.136 +   (run-tests 'your.namespace 'some.other.namespace)
   1.137 +
   1.138 +   If you don't specify any namespaces, the current namespace is
   1.139 +   used.  To run all tests in all namespaces, use \"(run-all-tests)\".
   1.140 +
   1.141 +   By default, these functions will search for all tests defined in
   1.142 +   a namespace and run them in an undefined order.  However, if you
   1.143 +   are composing tests, as in the \"arithmetic\" example above, you
   1.144 +   probably do not want the \"addition\" and \"subtraction\" tests run
   1.145 +   separately.  In that case, you must define a special function
   1.146 +   named \"test-ns-hook\" that runs your tests in the correct order:
   1.147 +
   1.148 +   (defn test-ns-hook []
   1.149 +     (arithmetic))
   1.150 +
   1.151 +
   1.152 +   OMITTING TESTS FROM PRODUCTION CODE
   1.153 +
   1.154 +   You can bind the variable \"*load-tests*\" to false when loading or
   1.155 +   compiling code in production.  This will prevent any tests from
   1.156 +   being created by \"with-test\" or \"deftest\".
   1.157 +
   1.158 +
   1.159 +   FIXTURES (new)
   1.160 +
   1.161 +   Fixtures allow you to run code before and after tests, to set up
   1.162 +   the context in which tests should be run.
   1.163 +
   1.164 +   A fixture is just a function that calls another function passed as
   1.165 +   an argument.  It looks like this:
   1.166 +
   1.167 +   (defn my-fixture [f]
   1.168 +      Perform setup, establish bindings, whatever.
   1.169 +     (f)  Then call the function we were passed.
   1.170 +      Tear-down / clean-up code here.
   1.171 +    )
   1.172 +
   1.173 +   Fixtures are attached to namespaces in one of two ways.  \"each\"
   1.174 +   fixtures are run repeatedly, once for each test function created
   1.175 +   with \"deftest\" or \"with-test\".  \"each\" fixtures are useful for
   1.176 +   establishing a consistent before/after state for each test, like
   1.177 +   clearing out database tables.
   1.178 +
   1.179 +   \"each\" fixtures can be attached to the current namespace like this:
   1.180 +   (use-fixtures :each fixture1 fixture2 ...)
   1.181 +   The fixture1, fixture2 are just functions like the example above.
   1.182 +   They can also be anonymous functions, like this:
   1.183 +   (use-fixtures :each (fn [f] setup... (f) cleanup...))
   1.184 +
   1.185 +   The other kind of fixture, a \"once\" fixture, is only run once,
   1.186 +   around ALL the tests in the namespace.  \"once\" fixtures are useful
   1.187 +   for tasks that only need to be performed once, like establishing
   1.188 +   database connections, or for time-consuming tasks.
   1.189 +
   1.190 +   Attach \"once\" fixtures to the current namespace like this:
   1.191 +   (use-fixtures :once fixture1 fixture2 ...)
   1.192 +
   1.193 +
   1.194 +   SAVING TEST OUTPUT TO A FILE
   1.195 +
   1.196 +   All the test reporting functions write to the var *test-out*.  By
   1.197 +   default, this is the same as *out*, but you can rebind it to any
   1.198 +   PrintWriter.  For example, it could be a file opened with
   1.199 +   clojure.java.io/writer.
   1.200 +
   1.201 +
   1.202 +   EXTENDING TEST-IS (ADVANCED)
   1.203 +
   1.204 +   You can extend the behavior of the \"is\" macro by defining new
   1.205 +   methods for the \"assert-expr\" multimethod.  These methods are
   1.206 +   called during expansion of the \"is\" macro, so they should return
   1.207 +   quoted forms to be evaluated.
   1.208 +
   1.209 +   You can plug in your own test-reporting framework by rebinding
   1.210 +   the \"report\" function: (report event)
   1.211 +
   1.212 +   The 'event' argument is a map.  It will always have a :type key,
   1.213 +   whose value will be a keyword signaling the type of event being
   1.214 +   reported.  Standard events with :type value of :pass, :fail, and
   1.215 +   :error are called when an assertion passes, fails, and throws an
   1.216 +   exception, respectively.  In that case, the event will also have
   1.217 +   the following keys:
   1.218 +
   1.219 +     :expected   The form that was expected to be true
   1.220 +     :actual     A form representing what actually occurred
   1.221 +     :message    The string message given as an argument to 'is'
   1.222 +
   1.223 +   The \"testing\" strings will be a list in \"*testing-contexts*\", and
   1.224 +   the vars being tested will be a list in \"*testing-vars*\".
   1.225 +
   1.226 +   Your \"report\" function should wrap any printing calls in the
   1.227 +   \"with-test-out\" macro, which rebinds *out* to the current value
   1.228 +   of *test-out*.
   1.229 +
   1.230 +   For additional event types, see the examples in the code.
   1.231 +"}
   1.232 +  clojure.test
   1.233 +  (:require [clojure.template :as temp]
   1.234 +            [clojure.stacktrace :as stack]))
   1.235 +
   1.236 +;; Nothing is marked "private" here, so you can rebind things to plug
   1.237 +;; in your own testing or reporting frameworks.
   1.238 +
   1.239 +
   1.240 +;;; USER-MODIFIABLE GLOBALS
   1.241 +
   1.242 +(defonce
   1.243 +  ^{:doc "True by default.  If set to false, no test functions will
   1.244 +   be created by deftest, set-test, or with-test.  Use this to omit
   1.245 +   tests when compiling or loading production code."
   1.246 +    :added "1.1"}
   1.247 +  *load-tests* true)
   1.248 +
   1.249 +(def
   1.250 + ^{:doc "The maximum depth of stack traces to print when an Exception
   1.251 +  is thrown during a test.  Defaults to nil, which means print the 
   1.252 +  complete stack trace."
   1.253 +   :added "1.1"}
   1.254 + *stack-trace-depth* nil)
   1.255 +
   1.256 +
   1.257 +;;; GLOBALS USED BY THE REPORTING FUNCTIONS
   1.258 +
   1.259 +(def *report-counters* nil)	  ; bound to a ref of a map in test-ns
   1.260 +
   1.261 +(def *initial-report-counters*  ; used to initialize *report-counters*
   1.262 +     {:test 0, :pass 0, :fail 0, :error 0})
   1.263 +
   1.264 +(def *testing-vars* (list))  ; bound to hierarchy of vars being tested
   1.265 +
   1.266 +(def *testing-contexts* (list)) ; bound to hierarchy of "testing" strings
   1.267 +
   1.268 +(def *test-out* *out*)         ; PrintWriter for test reporting output
   1.269 +
   1.270 +(defmacro with-test-out
   1.271 +  "Runs body with *out* bound to the value of *test-out*."
   1.272 +  {:added "1.1"}
   1.273 +  [& body]
   1.274 +  `(binding [*out* *test-out*]
   1.275 +     ~@body))
   1.276 +
   1.277 +;;; UTILITIES FOR REPORTING FUNCTIONS
   1.278 +
   1.279 +(defn file-position
   1.280 +  "Returns a vector [filename line-number] for the nth call up the
   1.281 +  stack.
   1.282 +
   1.283 +  Deprecated in 1.2: The information needed for test reporting is
   1.284 +  now on :file and :line keys in the result map."
   1.285 +  {:added "1.1"
   1.286 +   :deprecated "1.2"}
   1.287 +  [n]
   1.288 +  (let [^StackTraceElement s (nth (.getStackTrace (new java.lang.Throwable)) n)]
   1.289 +    [(.getFileName s) (.getLineNumber s)]))
   1.290 +
   1.291 +(defn testing-vars-str
   1.292 +  "Returns a string representation of the current test.  Renders names
   1.293 +  in *testing-vars* as a list, then the source file and line of
   1.294 +  current assertion."
   1.295 +  {:added "1.1"}
   1.296 +  [m]
   1.297 +  (let [{:keys [file line]} m]
   1.298 +    (str
   1.299 +     ;; Uncomment to include namespace in failure report:
   1.300 +     ;;(ns-name (:ns (meta (first *testing-vars*)))) "/ "
   1.301 +     (reverse (map #(:name (meta %)) *testing-vars*))
   1.302 +     " (" file ":" line ")")))
   1.303 +
   1.304 +(defn testing-contexts-str
   1.305 +  "Returns a string representation of the current test context. Joins
   1.306 +  strings in *testing-contexts* with spaces."
   1.307 +  {:added "1.1"}
   1.308 +  []
   1.309 +  (apply str (interpose " " (reverse *testing-contexts*))))
   1.310 +
   1.311 +(defn inc-report-counter
   1.312 +  "Increments the named counter in *report-counters*, a ref to a map.
   1.313 +  Does nothing if *report-counters* is nil."
   1.314 +  {:added "1.1"}
   1.315 +  [name]
   1.316 +  (when *report-counters*
   1.317 +    (dosync (commute *report-counters* assoc name
   1.318 +                     (inc (or (*report-counters* name) 0))))))
   1.319 +
   1.320 +;;; TEST RESULT REPORTING
   1.321 +
   1.322 +(defmulti
   1.323 +  ^{:doc "Generic reporting function, may be overridden to plug in
   1.324 +   different report formats (e.g., TAP, JUnit).  Assertions such as
   1.325 +   'is' call 'report' to indicate results.  The argument given to
   1.326 +   'report' will be a map with a :type key.  See the documentation at
   1.327 +   the top of test_is.clj for more information on the types of
   1.328 +   arguments for 'report'."
   1.329 +     :dynamic true
   1.330 +     :added "1.1"}
   1.331 +  report :type)
   1.332 +
   1.333 +(defn- file-and-line 
   1.334 +  [exception depth]
   1.335 +  (let [^StackTraceElement s (nth (.getStackTrace exception) depth)]
   1.336 +    {:file (.getFileName s) :line (.getLineNumber s)}))
   1.337 +
   1.338 +(defn do-report
   1.339 +  "Add file and line information to a test result and call report.
   1.340 +   If you are writing a custom assert-expr method, call this function
   1.341 +   to pass test results to report."
   1.342 +  {:added "1.2"}
   1.343 +  [m]
   1.344 +  (report
   1.345 +   (case
   1.346 +    (:type m)
   1.347 +    :fail (merge (file-and-line (new java.lang.Throwable) 1) m)
   1.348 +    :error (merge (file-and-line (:actual m) 0) m) 
   1.349 +    m)))
   1.350 +
   1.351 +(defmethod report :default [m]
   1.352 +  (with-test-out (prn m)))
   1.353 +
   1.354 +(defmethod report :pass [m]
   1.355 +  (with-test-out (inc-report-counter :pass)))
   1.356 +
   1.357 +(defmethod report :fail [m]
   1.358 +  (with-test-out
   1.359 +    (inc-report-counter :fail)
   1.360 +    (println "\nFAIL in" (testing-vars-str m))
   1.361 +    (when (seq *testing-contexts*) (println (testing-contexts-str)))
   1.362 +    (when-let [message (:message m)] (println message))
   1.363 +    (println "expected:" (pr-str (:expected m)))
   1.364 +    (println "  actual:" (pr-str (:actual m)))))
   1.365 +
   1.366 +(defmethod report :error [m]
   1.367 +  (with-test-out
   1.368 +   (inc-report-counter :error)
   1.369 +   (println "\nERROR in" (testing-vars-str m))
   1.370 +   (when (seq *testing-contexts*) (println (testing-contexts-str)))
   1.371 +   (when-let [message (:message m)] (println message))
   1.372 +   (println "expected:" (pr-str (:expected m)))
   1.373 +   (print "  actual: ")
   1.374 +   (let [actual (:actual m)]
   1.375 +     (if (instance? Throwable actual)
   1.376 +       (stack/print-cause-trace actual *stack-trace-depth*)
   1.377 +       (prn actual)))))
   1.378 +
   1.379 +(defmethod report :summary [m]
   1.380 +  (with-test-out
   1.381 +   (println "\nRan" (:test m) "tests containing"
   1.382 +            (+ (:pass m) (:fail m) (:error m)) "assertions.")
   1.383 +   (println (:fail m) "failures," (:error m) "errors.")))
   1.384 +
   1.385 +(defmethod report :begin-test-ns [m]
   1.386 +  (with-test-out
   1.387 +   (println "\nTesting" (ns-name (:ns m)))))
   1.388 +
   1.389 +;; Ignore these message types:
   1.390 +(defmethod report :end-test-ns [m])
   1.391 +(defmethod report :begin-test-var [m])
   1.392 +(defmethod report :end-test-var [m])
   1.393 +
   1.394 +
   1.395 +
   1.396 +;;; UTILITIES FOR ASSERTIONS
   1.397 +
   1.398 +(defn get-possibly-unbound-var
   1.399 +  "Like var-get but returns nil if the var is unbound."
   1.400 +  {:added "1.1"}
   1.401 +  [v]
   1.402 +  (try (var-get v)
   1.403 +       (catch IllegalStateException e
   1.404 +         nil)))
   1.405 +
   1.406 +(defn function?
   1.407 +  "Returns true if argument is a function or a symbol that resolves to
   1.408 +  a function (not a macro)."
   1.409 +  {:added "1.1"}
   1.410 +  [x]
   1.411 +  (if (symbol? x)
   1.412 +    (when-let [v (resolve x)]
   1.413 +      (when-let [value (get-possibly-unbound-var v)]
   1.414 +        (and (fn? value)
   1.415 +             (not (:macro (meta v))))))
   1.416 +    (fn? x)))
   1.417 +
   1.418 +(defn assert-predicate
   1.419 +  "Returns generic assertion code for any functional predicate.  The
   1.420 +  'expected' argument to 'report' will contains the original form, the
   1.421 +  'actual' argument will contain the form with all its sub-forms
   1.422 +  evaluated.  If the predicate returns false, the 'actual' form will
   1.423 +  be wrapped in (not...)."
   1.424 +  {:added "1.1"}
   1.425 +  [msg form]
   1.426 +  (let [args (rest form)
   1.427 +        pred (first form)]
   1.428 +    `(let [values# (list ~@args)
   1.429 +           result# (apply ~pred values#)]
   1.430 +       (if result#
   1.431 +         (do-report {:type :pass, :message ~msg,
   1.432 +                  :expected '~form, :actual (cons ~pred values#)})
   1.433 +         (do-report {:type :fail, :message ~msg,
   1.434 +                  :expected '~form, :actual (list '~'not (cons '~pred values#))}))
   1.435 +       result#)))
   1.436 +
   1.437 +(defn assert-any
   1.438 +  "Returns generic assertion code for any test, including macros, Java
   1.439 +  method calls, or isolated symbols."
   1.440 +  {:added "1.1"}
   1.441 +  [msg form]
   1.442 +  `(let [value# ~form]
   1.443 +     (if value#
   1.444 +       (do-report {:type :pass, :message ~msg,
   1.445 +                :expected '~form, :actual value#})
   1.446 +       (do-report {:type :fail, :message ~msg,
   1.447 +                :expected '~form, :actual value#}))
   1.448 +     value#))
   1.449 +
   1.450 +
   1.451 +
   1.452 +;;; ASSERTION METHODS
   1.453 +
   1.454 +;; You don't call these, but you can add methods to extend the 'is'
   1.455 +;; macro.  These define different kinds of tests, based on the first
   1.456 +;; symbol in the test expression.
   1.457 +
   1.458 +(defmulti assert-expr 
   1.459 +  (fn [msg form]
   1.460 +    (cond
   1.461 +      (nil? form) :always-fail
   1.462 +      (seq? form) (first form)
   1.463 +      :else :default)))
   1.464 +
   1.465 +(defmethod assert-expr :always-fail [msg form]
   1.466 +  ;; nil test: always fail
   1.467 +  `(do-report {:type :fail, :message ~msg}))
   1.468 +
   1.469 +(defmethod assert-expr :default [msg form]
   1.470 +  (if (and (sequential? form) (function? (first form)))
   1.471 +    (assert-predicate msg form)
   1.472 +    (assert-any msg form)))
   1.473 +
   1.474 +(defmethod assert-expr 'instance? [msg form]
   1.475 +  ;; Test if x is an instance of y.
   1.476 +  `(let [klass# ~(nth form 1)
   1.477 +         object# ~(nth form 2)]
   1.478 +     (let [result# (instance? klass# object#)]
   1.479 +       (if result#
   1.480 +         (do-report {:type :pass, :message ~msg,
   1.481 +                  :expected '~form, :actual (class object#)})
   1.482 +         (do-report {:type :fail, :message ~msg,
   1.483 +                  :expected '~form, :actual (class object#)}))
   1.484 +       result#)))
   1.485 +
   1.486 +(defmethod assert-expr 'thrown? [msg form]
   1.487 +  ;; (is (thrown? c expr))
   1.488 +  ;; Asserts that evaluating expr throws an exception of class c.
   1.489 +  ;; Returns the exception thrown.
   1.490 +  (let [klass (second form)
   1.491 +        body (nthnext form 2)]
   1.492 +    `(try ~@body
   1.493 +          (do-report {:type :fail, :message ~msg,
   1.494 +                   :expected '~form, :actual nil})
   1.495 +          (catch ~klass e#
   1.496 +            (do-report {:type :pass, :message ~msg,
   1.497 +                     :expected '~form, :actual e#})
   1.498 +            e#))))
   1.499 +
   1.500 +(defmethod assert-expr 'thrown-with-msg? [msg form]
   1.501 +  ;; (is (thrown-with-msg? c re expr))
   1.502 +  ;; Asserts that evaluating expr throws an exception of class c.
   1.503 +  ;; Also asserts that the message string of the exception matches
   1.504 +  ;; (with re-find) the regular expression re.
   1.505 +  (let [klass (nth form 1)
   1.506 +        re (nth form 2)
   1.507 +        body (nthnext form 3)]
   1.508 +    `(try ~@body
   1.509 +          (do-report {:type :fail, :message ~msg, :expected '~form, :actual nil})
   1.510 +          (catch ~klass e#
   1.511 +            (let [m# (.getMessage e#)]
   1.512 +              (if (re-find ~re m#)
   1.513 +                (do-report {:type :pass, :message ~msg,
   1.514 +                         :expected '~form, :actual e#})
   1.515 +                (do-report {:type :fail, :message ~msg,
   1.516 +                         :expected '~form, :actual e#})))
   1.517 +            e#))))
   1.518 +
   1.519 +
   1.520 +(defmacro try-expr
   1.521 +  "Used by the 'is' macro to catch unexpected exceptions.
   1.522 +  You don't call this."
   1.523 +  {:added "1.1"}
   1.524 +  [msg form]
   1.525 +  `(try ~(assert-expr msg form)
   1.526 +        (catch Throwable t#
   1.527 +          (do-report {:type :error, :message ~msg,
   1.528 +                      :expected '~form, :actual t#}))))
   1.529 +
   1.530 +
   1.531 +
   1.532 +;;; ASSERTION MACROS
   1.533 +
   1.534 +;; You use these in your tests.
   1.535 +
   1.536 +(defmacro is
   1.537 +  "Generic assertion macro.  'form' is any predicate test.
   1.538 +  'msg' is an optional message to attach to the assertion.
   1.539 +  
   1.540 +  Example: (is (= 4 (+ 2 2)) \"Two plus two should be 4\")
   1.541 +
   1.542 +  Special forms:
   1.543 +
   1.544 +  (is (thrown? c body)) checks that an instance of c is thrown from
   1.545 +  body, fails if not; then returns the thing thrown.
   1.546 +
   1.547 +  (is (thrown-with-msg? c re body)) checks that an instance of c is
   1.548 +  thrown AND that the message on the exception matches (with
   1.549 +  re-find) the regular expression re."
   1.550 +  {:added "1.1"} 
   1.551 +  ([form] `(is ~form nil))
   1.552 +  ([form msg] `(try-expr ~msg ~form)))
   1.553 +
   1.554 +(defmacro are
   1.555 +  "Checks multiple assertions with a template expression.
   1.556 +  See clojure.template/do-template for an explanation of
   1.557 +  templates.
   1.558 +
   1.559 +  Example: (are [x y] (= x y)  
   1.560 +                2 (+ 1 1)
   1.561 +                4 (* 2 2))
   1.562 +  Expands to: 
   1.563 +           (do (is (= 2 (+ 1 1)))
   1.564 +               (is (= 4 (* 2 2))))
   1.565 +
   1.566 +  Note: This breaks some reporting features, such as line numbers."
   1.567 +  {:added "1.1"}
   1.568 +  [argv expr & args]
   1.569 +  `(temp/do-template ~argv (is ~expr) ~@args))
   1.570 +
   1.571 +(defmacro testing
   1.572 +  "Adds a new string to the list of testing contexts.  May be nested,
   1.573 +  but must occur inside a test function (deftest)."
   1.574 +  {:added "1.1"}
   1.575 +  [string & body]
   1.576 +  `(binding [*testing-contexts* (conj *testing-contexts* ~string)]
   1.577 +     ~@body))
   1.578 +
   1.579 +
   1.580 +
   1.581 +;;; DEFINING TESTS
   1.582 +
   1.583 +(defmacro with-test
   1.584 +  "Takes any definition form (that returns a Var) as the first argument.
   1.585 +  Remaining body goes in the :test metadata function for that Var.
   1.586 +
   1.587 +  When *load-tests* is false, only evaluates the definition, ignoring
   1.588 +  the tests."
   1.589 +  {:added "1.1"}
   1.590 +  [definition & body]
   1.591 +  (if *load-tests*
   1.592 +    `(doto ~definition (alter-meta! assoc :test (fn [] ~@body)))
   1.593 +    definition))
   1.594 +
   1.595 +
   1.596 +(defmacro deftest
   1.597 +  "Defines a test function with no arguments.  Test functions may call
   1.598 +  other tests, so tests may be composed.  If you compose tests, you
   1.599 +  should also define a function named test-ns-hook; run-tests will
   1.600 +  call test-ns-hook instead of testing all vars.
   1.601 +
   1.602 +  Note: Actually, the test body goes in the :test metadata on the var,
   1.603 +  and the real function (the value of the var) calls test-var on
   1.604 +  itself.
   1.605 +
   1.606 +  When *load-tests* is false, deftest is ignored."
   1.607 +  {:added "1.1"}
   1.608 +  [name & body]
   1.609 +  (when *load-tests*
   1.610 +    `(def ~(vary-meta name assoc :test `(fn [] ~@body))
   1.611 +          (fn [] (test-var (var ~name))))))
   1.612 +
   1.613 +(defmacro deftest-
   1.614 +  "Like deftest but creates a private var."
   1.615 +  {:added "1.1"}
   1.616 +  [name & body]
   1.617 +  (when *load-tests*
   1.618 +    `(def ~(vary-meta name assoc :test `(fn [] ~@body) :private true)
   1.619 +          (fn [] (test-var (var ~name))))))
   1.620 +
   1.621 +
   1.622 +(defmacro set-test
   1.623 +  "Experimental.
   1.624 +  Sets :test metadata of the named var to a fn with the given body.
   1.625 +  The var must already exist.  Does not modify the value of the var.
   1.626 +
   1.627 +  When *load-tests* is false, set-test is ignored."
   1.628 +  {:added "1.1"}
   1.629 +  [name & body]
   1.630 +  (when *load-tests*
   1.631 +    `(alter-meta! (var ~name) assoc :test (fn [] ~@body))))
   1.632 +
   1.633 +
   1.634 +
   1.635 +;;; DEFINING FIXTURES
   1.636 +
   1.637 +(defn- add-ns-meta
   1.638 +  "Adds elements in coll to the current namespace metadata as the
   1.639 +  value of key."
   1.640 +  {:added "1.1"}
   1.641 +  [key coll]
   1.642 +  (alter-meta! *ns* assoc key coll))
   1.643 +
   1.644 +(defmulti use-fixtures
   1.645 +  "Wrap test runs in a fixture function to perform setup and
   1.646 +  teardown. Using a fixture-type of :each wraps every test
   1.647 +  individually, while:once wraps the whole run in a single function."
   1.648 +  {:added "1.1"}
   1.649 +  (fn [fixture-type & args] fixture-type))
   1.650 +
   1.651 +(defmethod use-fixtures :each [fixture-type & args]
   1.652 +  (add-ns-meta ::each-fixtures args))
   1.653 +
   1.654 +(defmethod use-fixtures :once [fixture-type & args]
   1.655 +  (add-ns-meta ::once-fixtures args))
   1.656 +
   1.657 +(defn- default-fixture
   1.658 +  "The default, empty, fixture function.  Just calls its argument."
   1.659 +  {:added "1.1"}
   1.660 +  [f]
   1.661 +  (f))
   1.662 +
   1.663 +(defn compose-fixtures
   1.664 +  "Composes two fixture functions, creating a new fixture function
   1.665 +  that combines their behavior."
   1.666 +  {:added "1.1"}
   1.667 +  [f1 f2]
   1.668 +  (fn [g] (f1 (fn [] (f2 g)))))
   1.669 +
   1.670 +(defn join-fixtures
   1.671 +  "Composes a collection of fixtures, in order.  Always returns a valid
   1.672 +  fixture function, even if the collection is empty."
   1.673 +  {:added "1.1"}
   1.674 +  [fixtures]
   1.675 +  (reduce compose-fixtures default-fixture fixtures))
   1.676 +
   1.677 +
   1.678 +
   1.679 +
   1.680 +;;; RUNNING TESTS: LOW-LEVEL FUNCTIONS
   1.681 +
   1.682 +(defn test-var
   1.683 +  "If v has a function in its :test metadata, calls that function,
   1.684 +  with *testing-vars* bound to (conj *testing-vars* v)."
   1.685 +  {:dynamic true, :added "1.1"}
   1.686 +  [v]
   1.687 +  (when-let [t (:test (meta v))]
   1.688 +    (binding [*testing-vars* (conj *testing-vars* v)]
   1.689 +      (do-report {:type :begin-test-var, :var v})
   1.690 +      (inc-report-counter :test)
   1.691 +      (try (t)
   1.692 +           (catch Throwable e
   1.693 +             (do-report {:type :error, :message "Uncaught exception, not in assertion."
   1.694 +                      :expected nil, :actual e})))
   1.695 +      (do-report {:type :end-test-var, :var v}))))
   1.696 +
   1.697 +(defn test-all-vars
   1.698 +  "Calls test-var on every var interned in the namespace, with fixtures."
   1.699 +  {:added "1.1"}
   1.700 +  [ns]
   1.701 +  (let [once-fixture-fn (join-fixtures (::once-fixtures (meta ns)))
   1.702 +        each-fixture-fn (join-fixtures (::each-fixtures (meta ns)))]
   1.703 +    (once-fixture-fn
   1.704 +     (fn []
   1.705 +       (doseq [v (vals (ns-interns ns))]
   1.706 +         (when (:test (meta v))
   1.707 +           (each-fixture-fn (fn [] (test-var v)))))))))
   1.708 +
   1.709 +(defn test-ns
   1.710 +  "If the namespace defines a function named test-ns-hook, calls that.
   1.711 +  Otherwise, calls test-all-vars on the namespace.  'ns' is a
   1.712 +  namespace object or a symbol.
   1.713 +
   1.714 +  Internally binds *report-counters* to a ref initialized to
   1.715 +  *inital-report-counters*.  Returns the final, dereferenced state of
   1.716 +  *report-counters*."
   1.717 +  {:added "1.1"}
   1.718 +  [ns]
   1.719 +  (binding [*report-counters* (ref *initial-report-counters*)]
   1.720 +    (let [ns-obj (the-ns ns)]
   1.721 +      (do-report {:type :begin-test-ns, :ns ns-obj})
   1.722 +      ;; If the namespace has a test-ns-hook function, call that:
   1.723 +      (if-let [v (find-var (symbol (str (ns-name ns-obj)) "test-ns-hook"))]
   1.724 +	((var-get v))
   1.725 +        ;; Otherwise, just test every var in the namespace.
   1.726 +        (test-all-vars ns-obj))
   1.727 +      (do-report {:type :end-test-ns, :ns ns-obj}))
   1.728 +    @*report-counters*))
   1.729 +
   1.730 +
   1.731 +
   1.732 +;;; RUNNING TESTS: HIGH-LEVEL FUNCTIONS
   1.733 +
   1.734 +(defn run-tests
   1.735 +  "Runs all tests in the given namespaces; prints results.
   1.736 +  Defaults to current namespace if none given.  Returns a map
   1.737 +  summarizing test results."
   1.738 +  {:added "1.1"}
   1.739 +  ([] (run-tests *ns*))
   1.740 +  ([& namespaces]
   1.741 +     (let [summary (assoc (apply merge-with + (map test-ns namespaces))
   1.742 +                     :type :summary)]
   1.743 +       (do-report summary)
   1.744 +       summary)))
   1.745 +
   1.746 +(defn run-all-tests
   1.747 +  "Runs all tests in all namespaces; prints results.
   1.748 +  Optional argument is a regular expression; only namespaces with
   1.749 +  names matching the regular expression (with re-matches) will be
   1.750 +  tested."
   1.751 +  {:added "1.1"}
   1.752 +  ([] (apply run-tests (all-ns)))
   1.753 +  ([re] (apply run-tests (filter #(re-matches re (name (ns-name %))) (all-ns)))))
   1.754 +
   1.755 +(defn successful?
   1.756 +  "Returns true if the given test summary indicates all tests
   1.757 +  were successful, false otherwise."
   1.758 +  {:added "1.1"}
   1.759 +  [summary]
   1.760 +  (and (zero? (:fail summary 0))
   1.761 +       (zero? (:error summary 0))))