path: root/src/clojure/contrib/test_is.clj

;;; test_is.clj: test framework for Clojure

;; by Stuart Sierra, http://stuartsierra.com/
;; January 21, 2009

;; Thanks to Chas Emerick, Allen Rohner, and Stuart Halloway for
;; contributions and suggestions.

;; Copyright (c) Stuart Sierra, 2008. All rights reserved.  The use
;; and distribution terms for this software are covered by the Eclipse
;; Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
;; which can be found in the file epl-v10.html at the root of this
;; distribution.  By using this software in any fashion, you are
;; agreeing to be bound by the terms of this license.  You must not
;; remove this notice, or any other, from this software.



(comment
  ;; Inspired by many Common Lisp test frameworks and clojure/test,
  ;; this file is a Clojure test framework.
  ;;
  ;;
  ;;
  ;; ASSERTIONS
  ;;
  ;; The core of the library is the "is" macro, which lets you make
  ;; assertions of any arbitrary expression:

  (is (= 4 (+ 2 2)))
  (is (instance? Integer 256))
  (is (.startsWith "abcde" "ab"))

  ;; You can type an "is" expression directly at the REPL, which will
  ;; print a message if it fails.
  ;;
  ;;     user> (is (= 5 (+ 2 2)))
  ;;
  ;;     FAIL in  (:1)
  ;;     expected: (= 5 (+ 2 2))
  ;;       actual: (not (= 5 4))
  ;;     false
  ;;
  ;; The "expected:" line shows you the original expression, and the
  ;; "actual:" shows you what actually happened.  In this case, it
  ;; shows that (+ 2 2) returned 4, which is not = to 5.  Finally, the
  ;; "false" on the last line is the value returned from the
  ;; expression.  The "is" macro always returns the result of the
  ;; inner expression.
  ;;
  ;; There are two special assertions for testing exceptions.  The
  ;;  "(is (thrown? c ...))" form tests if an exception of class c is
  ;;  thrown:

  (is (thrown? ArithmeticException (/ 1 0))) 

  ;; "(is (thrown-with-msg? c re ...))" does the same thing and also
  ;; tests that the message on the exception matches the regular
  ;; expression re:

  (is (thrown-with-msg? ArithmeticException #"Divide by zero"
                        (/ 1 0)))

  ;;
  ;;
  ;;
  ;; DOCUMENTING TESTS
  ;;
  ;; "is" takes an optional second argument, a string describing the
  ;; assertion.  This message will be included in the error report.

  (is (= 5 (+ 2 2)) "Crazy arithmetic")

  ;; In addition, you can document groups of assertions with the
  ;; "testing" macro, which takes a string followed by any number of
  ;; "is" assertions.  The string will be included in failure reports.
  ;; Calls to "testing" may be nested, and all of the strings will be
  ;; joined together with spaces in the final report, in a style
  ;; similar to RSpec <http://rspec.info/>

  (testing "Arithmetic"
    (testing "with positive integers"
      (= 4 (+ 2 2))
      (= 7 (+ 3 4)))
    (testing "with negative integers"
      (= -4 (+ -2 -2))
      (= -1 (+ 3 -4))))

  ;; Note that, unlike RSpec, the "testing" macro may only be used
  ;; INSIDE a "deftest" or "with-test" form (see below).
  ;;
  ;;
  ;;
  ;; DEFINING TESTS
  ;;
  ;; There are two ways to define tests.  The "with-test" macro takes
  ;; a defn or def form as its first argument, followed by any number
  ;; of assertions.  The tests will be stored as metadata on the
  ;; definition.

  (with-test
      (defn my-function [x y]
        (+ x y))
    (is (= 4 (my-function 2 2)))
    (is (= 7 (my-function 3 4))))

  ;; As of Clojure SVN rev. 1221, this does not work with defmacro.
  ;; See http://code.google.com/p/clojure/issues/detail?id=51
  ;;
  ;; The other way lets you define tests separately from the rest of
  ;; your code, even in a different namespace:

  (deftest addition
    (is (= 4 (+ 2 2)))
    (is (= 7 (+ 3 4))))

  (deftest subtraction
    (is (= 1 (- 4 3)))
    (is (= 3 (- 7 4))))

  ;; This creates functions named "addition" and "subtraction", which
  ;; can be called like any other function.  Therefore, tests can be
  ;; grouped and composed, in a style similar to the test framework in
  ;; Peter Seibel's "Practical Common Lisp"
  ;; <http://www.gigamonkeys.com/book/practical-building-a-unit-test-framework.html>

  (deftest arithmetic
    (addition)
    (subtraction))

  ;; The names of the nested tests will be joined in a list, like
  ;; "(arithmetic addition)", in failure reports.  You can use nested
  ;; tests to set up a context shared by several tests.
  ;;
  ;;
  ;;
  ;; RUNNING TESTS
  ;;
  ;; Run tests with the function "(run-tests namespaces...)":

  (run-tests 'your.namespace 'some.other.namespace)

  ;; If you don't specify any namespaces, the current namespace is
  ;; used.  To run all tests in all namespaces, use "(run-all-tests)".
  ;;
  ;; By default, these functions will search for all tests defined in
  ;; a namespace and run them in an undefined order.  However, if you
  ;; are composing tests, as in the "arithmetic" example above, you
  ;; probably do not want the "addition" and "subtraction" tests run
  ;; separately.  In that case, you must define a special function
  ;; named "test-ns-hook" that runs your tests in the correct order:

  (defn test-ns-hook []
    (arithmetic))

  ;;
  ;;
  ;;
  ;; OMITTING TESTS FROM PRODUCTION CODE
  ;;
  ;; You can bind the variable "*load-tests*" to false when loading or
  ;; compiling code in production.  This will prevent any tests from
  ;; being created by "with-test" or "deftest".
  ;;
  ;;
  ;;
  ;; EXTENDING TEST-IS (ADVANCED)
  ;;
  ;; You can extend the behavior of the "is" macro by defining new
  ;; methods for the "assert-expr" multimethod.  These methods are
  ;; called during expansion of the "is" macro, so they should return
  ;; quoted forms to be evaluated.
  ;;
  ;; You can plug in your own test-reporting framework by rebinding
  ;; the "report" function: (report event msg expected actual)
  ;;
  ;; "report" will be called once for each assertion.  The "event"
  ;; argument will give the outcome of the assertion: one of :pass,
  ;; :fail, or :error.  The "msg" argument will be the message given
  ;; to the "is" macro.  The "expected" argument will be a quoted form
  ;; of the original assertion.  The "actual" argument will be a
  ;; quoted form indicating what actually occurred.  The "testing"
  ;; strings will be a list in "*testing-contexts*", and the vars
  ;; being tested will be a list in "*testing-vars*".
  ;;
  ;; (report :info msg nil nil) is used to print informational
  ;; messages, such as the name of the namespace being tested.

  ) ;; end comment



(ns clojure.contrib.test-is
  (:require [clojure.contrib.template :as temp]
            [clojure.contrib.stacktrace :as stack]))

;; Nothing is marked "private" here, so you can rebind things to plug
;; in your own testing or reporting frameworks.


;;; USER-MODIFIABLE GLOBALS

(defonce
  #^{:doc "True by default.  If set to false, no test functions will
   be created by deftest, set-test, or with-test.  Use this to omit
   tests when compiling or loading production code."}
  *load-tests* true)

(def
 #^{:doc "The maximum depth of stack traces to print when an Exception
  is thrown during a test.  Defaults to nil, which means print the 
  complete stack trace."}
 *stack-trace-depth* nil)


;;; GLOBALS USED BY THE REPORTING FUNCTIONS

(def *report-counters* nil)	  ; bound to a ref of a map in test-ns

(def *initial-report-counters*  ; used to initialize *report-counters*
     {:test 0, :pass 0, :fail 0, :error 0})

(def *testing-vars* (list))  ; bound to hierarchy of vars being tested

(def *testing-contexts* (list))           ; bound to "testing" strings



;;; UTILITIES FOR REPORTING FUNCTIONS

(defn file-position
  "Returns a vector [filename line-number] for the nth call up the
  stack."
  [n]
  (let [s (nth (.getStackTrace (new java.lang.Throwable)) n)]
    [(.getFileName s) (.getLineNumber s)]))

(defn testing-vars-str
  "Returns a string representation of the current test.  Renders names
  in *testing-vars* as a list, then the source file and line of
  current assertion."
  []
  (let [[file line] (file-position 4)]
    (str
     ;; Uncomment to include namespace in failure report:
     ;;(ns-name (:ns (meta (first *testing-vars*)))) "/ "
     (reverse (map #(:name (meta %)) *testing-vars*))
     " (" file ":" line ")")))

(defn testing-contexts-str
  "Returns a string representation of the current test context. Joins
  strings in *testing-contexts* with spaces."
  []
  (apply str (interpose " " (reverse *testing-contexts*))))

(defn inc-report-counter
  "Increments the named counter in *report-counters*, a ref to a map.
  Does nothing if *report-counters* is nil."
  [name]
  (when *report-counters*
    (dosync (commute *report-counters* assoc name
                     (inc (or (*report-counters* name) 0))))))



;;; TEST RESULT REPORTING

(defmulti
  #^{:doc "Handles the result of a single assertion.  'event' is one
   of :pass, :fail, or :error.  'msg' is a comment string associated
   with the assertion.  'expected' and 'actual' are quoted forms,
   which will be rendered with pr-str.

   Special case: if 'event' is :info, just the 'msg' will be
   printed.

   You can rebind this function during testing to plug in your own
   test-reporting framework."}
  report (fn [event msg expected actual] event))

(defmethod report :info [event msg expected actual]
  (newline)
  (println msg))

(defmethod report :pass [event msg expected actual]
  (inc-report-counter :pass))

(defmethod report :fail [event msg expected actual]
  (inc-report-counter :fail)
  (println "\nFAIL in" (testing-vars-str))
  (when (seq *testing-contexts*) (println (testing-contexts-str)))
  (when msg (println msg))
  (println "expected:" (pr-str expected))
  (println "  actual:" (pr-str actual)))

(defmethod report :error [event msg expected actual]
  (inc-report-counter :error)
  (println "\nERROR in" (testing-vars-str))
  (when (seq *testing-contexts*) (println (testing-contexts-str)))
  (when msg (println msg))
  (println "expected:" (pr-str expected))
  (print "  actual: ")
  (if (instance? Throwable actual)
    (stack/print-cause-trace actual *stack-trace-depth*)
    (prn actual)))



;;; UTILITIES FOR ASSERTIONS

(defn get-possibly-unbound-var
  "Like var-get but returns nil if the var is unbound."
  [v]
  (try (var-get v)
       (catch IllegalStateException e
         nil)))

(defn function?
  "Returns true if argument is a function or a symbol that resolves to
  a function (not a macro)."
  [x]
  (if (symbol? x)
    (when-let [v (resolve x)]
      (when-let [value (get-possibly-unbound-var v)]
        (and