1 files changed, 238 insertions, 0 deletions
diff --git a/src/clojure/contrib/test_is.clj b/src/clojure/contrib/test_is.clj
new file mode 100644
index 00000000..8374b772
--- /dev/null
+++ b/src/clojure/contrib/test_is.clj
@@ -0,0 +1,238 @@
+;;; test_is.clj: test framework for Clojure
+
+;; by Stuart Sierra, http://stuartsierra.com/
+;; September 25, 2008
+
+;; Thanks to Chas Emerick for contributions.
+;; Thanks to Allen Rohner for assert-raises.
+
+;; Copyright (c) 2008 Stuart Sierra. All rights reserved.  The use and
+;; distribution terms for this software are covered by the Common
+;; Public License 1.0 (http://www.opensource.org/licenses/cpl1.0.php)
+;; which can be found in the file CPL.TXT 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.
+
+
+
+;; Inspired by many Common Lisp test frameworks and clojure/test, this
+;; file is a Clojure test framework.
+;;
+;; Define tests as :test metadata on your fns.  Use the "is" macro
+;; for assertions.  Examples:
+;;
+;;     (defn add2
+;;       ([x] (+ x 2))
+;;       {:test (fn [] (is (= (add2 3) 5))
+;;                     (is (= (add2 -4) -2)
+;;                     (is (> (add2 50) 50)))})
+;;
+;; You can also define tests in isolation with the "deftest" macro:
+;;
+;;     (deftest test-new-fn
+;;       (is (= (new-fn) "Awesome")))
+;;
+;; You can test that a function throws an exception with the "throws"
+;; macro:
+;;
+;;     (defn factorial
+;;       ([n] (cond
+;;             (zero? n) 1  ; 0!=1 is often defined for convenience
+;;             (> n 0) (* n (factorial (dec n)))
+;;             :else (throw (IllegalArgumentException. "Negative factorial"))))
+;;       {:test (fn [] (is (= (factorial 3) 6))
+;;                     (is (= (factorial 6) 720))
+;;                     (throws IllegalArgumentException (factorial -2)))}) 
+;;
+;; Run tests with (run-tests). As in any language with macros, you may
+;; need to recompile functions after changing a macro definition.
+
+
+(ns clojure.contrib.test-is)
+
+(def
+ #^{:doc "PrintWriter to which test results are printed; defaults to
+ System.err."}
+ *test-out* (. System err))
+
+
+;;; PRIVATE
+
+(defmacro #^{:private true} defcounter [ref-name fn-name]
+  `(do (def ~(with-meta ref-name {:private true}) nil)
+       (defn ~fn-name []
+         (when ~ref-name (sync nil (commute ~ref-name inc))))))
+
+(defcounter *tests* count-test)
+(defcounter *assertions* count-assertion)
+(defcounter *failures* count-failure)
+(defcounter *exceptions* count-exception)
+
+(defmacro failure [reason message]
+  `(throw (new java.lang.AssertionError
+               (str ~reason (when ~message (str "; " ~message))))))
+
+(defn- assert-true [form message]
+  `(do (count-assertion)
+       (let [value# ~form]
+         (when-not value#
+           (failure (str ~(pr-str form) " was false/nil")
+                    ~message)))))
+
+;; Multimethod for testing expressions, dispatches on the first symbol
+;; in the expression.
+(defmulti assert-expr (fn [form message] (first form)))
+
+;; Test for (= actual expected) expressions.
+(defmethod assert-expr '= [form message]
+  (let [expr1 (second form)
+        expr2 (nth form 2)]
+    `(do (count-assertion)
+         (let [value1# ~expr1
+               value2# ~expr2]
+           (when-not (= value1# value2#)
+             (failure (str ~(pr-str expr1) " is " (pr-str value1#)
+                           " but should be " (pr-str value2#))
+                      ~message))))))
+
+;; Test for (instance? class object) expressions.
+(defmethod assert-expr 'instance? [form message]
+  (let [clazz (second form)
+        object (nth form 2)]
+    `(do (count-assertion)
+         (let [value1# ~clazz
+               value2# ~object]
+           (when-not (instance? value1# value2#)
+             (failure (str ~(pr-str object) " has " (class value2#)
+                           " but should have " (pr-str value1#))
+                      ~message))))))
+
+;; Generic expression test, just check if expression evaluates to
+;; logical true.
+(defmethod assert-expr :default [form message]
+  (assert-true form message))
+
+(defn- always-fail-assert [message]
+  `(do (count-assertion)
+       (failure ~message nil)))
+
+(defmacro #^{:private true} with-test-counters
+  "Creates dynamic bindings for counting the number of tests,
+  assertions, failures, and exceptions.  Returns the results in a
+  map."
+  [& body]
+  `(binding [*tests* (ref 0)
+             *assertions* (ref 0)
+             *failures* (ref 0)
+             *exceptions* (ref 0)]
+     ~@body
+     {:tests @*tests*
+      :assertions @*assertions*
+      :failures @*failures*
+      :exceptions @*exceptions*}))
+
+(defn- run-test-fn
+  "Calls the function; reports errors/exceptions."
+  [f name]
+  (try
+   (count-test)
+   (f)
+   (catch java.lang.AssertionError e
+     (count-failure)
+     (. *test-out* (println (str "FAIL in " name ": "
+                                 (.getMessage e)))))
+   (catch java.lang.Exception e
+     (count-exception)
+     (. *test-out* (println (str "EXCEPTION in " name ":")))
+     (.printStackTrace e *test-out*))))
+
+(defn- test-var
+  "Finds and calls the fn in a var's :test metadata."
+  [v]
+  (when-let [f (:test (meta v))]
+    (run-test-fn f (str v))))
+
+(defn- test-interns
+  "Tests all interned symbols in the namespace."
+  [ns]
+  (let [ns (if (symbol? ns) (find-ns ns) ns)]
+    (. *test-out* (println (str "Testing " ns)))
+    (dorun (map test-var (vals (ns-interns ns))))))
+
+
+;;; PUBLIC
+
+(defmacro is
+  "Generic assertion macro.  Throws AssertionError if form evaluates
+  logical false.  Optional message will be added to the error.
+
+  form may be one of:
+    * an equality test like (= expression expected-value)
+    * an instance? test like (instance? class expression)
+    * nil, which always fails
+    * an arbitrary expression, fails if it returns false/nil"
+  ([form] `(is ~form nil))
+  ([form message]
+     (cond
+      (nil? form) (always-fail-assert message)
+      (seq? form) (assert-expr form message)
+      :else (assert-true form message))))
+
+(defmacro throws
+  "Asserts that form throws an exception of the given class (or one of
+  its subclasses)."
+  ([class form]
+     `(throws ~class ~form nil))
+  ([class form message]
+  `(try
+    (count-assertion)
+    (let [value# ~form]
+      (failure (str "expected " ~(pr-str form) " to throw " ~class
+                    ", but returned " value#) ~message))
+    (catch ~class e# nil)  ; the correct exception was thrown
+    (catch java.lang.Throwable e#  ; some other exception was thrown
+      (failure (str "expected " ~(pr-str form) " to throw " ~class
+                    ", but threw " e#) ~message)))))
+
+(defn print-results
+  "Prints a summary of the results from test-ns to *test-out*."
+  [r]
+  (. *test-out*
+     (println (str "\nRan " (:tests r) " tests with "
+                   (:assertions r) " assertions.\n"
+                   (:failures r) " failures, "
+                   (:exceptions r) " exceptions.")))  )
+
+(defn test-ns
+  "Runs tests on all interned symbols in the namespaces 
+  (symbols or namespace objects).
+
+  Returns a map with the following keys:
+    :tests      => number of tests run
+    :assertions => number of assertions checked
+    :failures   => number of failed assertions
+    :exceptions => number of exceptions raised
+  
+  If no namespace is given, uses *ns*."
+  ([] (test-ns *ns*))
+  ([& namespaces]
+     (with-test-counters (dorun (map test-interns namespaces)))))
+
+(defn run-tests
+  "Runs tests in the given namespaces and prints a summary of
+  results.
+
+  If no namespace is given, uses *ns*."
+  [& namespaces]
+  (print-results (apply test-ns namespaces)))
+
+(defn run-all-tests
+  "Runs tests in all namespaces and prints a summary of results."
+  []
+  (apply run-tests (all-ns)))
+
+(defmacro deftest
+  "Defines a Var with no value and with body in its :test fn."
+  [name & body]
+  `(def ~(with-meta name {:test `(fn [] ~@body)})))