Merge branch 'gtic' of git://github.com/stuarthalloway/clojure into gtic

36 files changed, 5688 insertions, 0 deletions

diff --git a/build.xml b/build.xml
index 2fa8d8bd..8c90a2da 100644
--- a/build.xml
+++ b/build.xml
@@ -9,6 +9,7 @@
   </description>
 
   <property name="src" location="src"/>
+  <property name="test" location="test"/>
   <property name="jsrc" location="${src}/jvm"/>
   <property name="cljsrc" location="${src}/clj"/>
   <property name="build" location="classes"/>
@@ -92,6 +93,11 @@
       <arg value="clojure.xml"/>
       <arg value="clojure.zip"/>
       <arg value="clojure.inspector"/>
+      <arg value="clojure.walk"/>
+      <arg value="clojure.stacktrace"/>
+      <arg value="clojure.template"/>
+      <arg value="clojure.test"/>
+      <arg value="clojure.test.tap"/>
     </java>
   </target>
 
@@ -110,6 +116,19 @@
     <copy file="${clojure_jar}" tofile="${clojure_noversion_jar}" />
   </target>
 
+  <target name="test-clojure"
+          description="Run clojure tests">
+<!--           depends="clojure"> -->
+    <java classname="clojure.main">
+      <classpath>
+        <path location="${test}"/>
+        <path location="${clojure_jar}"/>
+      </classpath>
+      <arg value="-e"/>
+      <arg value="(require '(clojure [test-clojure :as main])) (main/run)"/>
+    </java>
+  </target>
+
   <target name="clojure-slim" depends="compile-java"
           description="Create clojure-slim jar file (omits compiled Clojure code)">
     <jar jarfile="${slim_jar}">
diff --git a/src/clj/clojure/stacktrace.clj b/src/clj/clojure/stacktrace.clj
new file mode 100644
index 00000000..fcdf47f8
--- /dev/null
+++ b/src/clj/clojure/stacktrace.clj
@@ -0,0 +1,75 @@
+;;; stacktrace.clj: print Clojure-centric stack traces
+
+;; by Stuart Sierra, http://stuartsierra.com/
+;; January 6, 2009
+
+;; Copyright (c) Stuart Sierra, 2009. 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.
+
+
+(ns 
+  #^{:author "Stuart Sierra",
+     :doc "Print Clojure-centric stack traces"}
+  clojure.stacktrace)
+
+(defn root-cause
+  "Returns the last 'cause' Throwable in a chain of Throwables."
+  [tr]
+  (if-let [cause (.getCause tr)]
+    (recur cause)
+    tr))
+
+(defn print-trace-element
+  "Prints a Clojure-oriented view of one element in a stack trace."
+  [e]
+  (let [class (.getClassName e)
+	method (.getMethodName e)] 
+    (let [match (re-matches #"^([A-Za-z0-9_.-]+)\$(\w+)__\d+$" class)]
+      (if (and match (= "invoke" method))
+	(apply printf "%s/%s" (rest match))
+	(printf "%s.%s" class method))))
+  (printf " (%s:%d)" (or (.getFileName e) "") (.getLineNumber e)))
+
+(defn print-throwable
+  "Prints the class and message of a Throwable."
+  [tr]
+  (printf "%s: %s" (.getName (class tr)) (.getMessage tr)))
+
+(defn print-stack-trace
+  "Prints a Clojure-oriented stack trace of tr, a Throwable.
+  Prints a maximum of n stack frames (default: unlimited).
+  Does not print chained exceptions (causes)."
+  ([tr] (print-stack-trace tr nil))
+  ([tr n]
+     (let [st (.getStackTrace tr)]
+       (print-throwable tr)
+       (newline)
+       (print " at ") 
+       (print-trace-element (first st))
+       (newline)
+       (doseq [e (if (nil? n)
+		   (rest st)
+		   (take (dec n) (rest st)))]
+	 (print "    ")
+	 (print-trace-element e)
+	 (newline)))))
+
+(defn print-cause-trace
+  "Like print-stack-trace but prints chained exceptions (causes)."
+  ([tr] (print-cause-trace tr nil))
+  ([tr n]
+     (print-stack-trace tr n)
+     (when-let [cause (.getCause tr)]
+       (print "Caused by: " )
+       (recur cause n))))
+
+(defn e
+  "REPL utility.  Prints a brief stack trace for the root cause of the
+  most recent exception."  
+  []
+  (print-stack-trace (root-cause *e) 8))
diff --git a/src/clj/clojure/template.clj b/src/clj/clojure/template.clj
new file mode 100644
index 00000000..2515b04e
--- /dev/null
+++ b/src/clj/clojure/template.clj
@@ -0,0 +1,55 @@
+;;; template.clj - anonymous functions that pre-evaluate sub-expressions
+
+;; By Stuart Sierra, http://stuartsierra.com/
+;; June 23, 2009
+
+;; Copyright (c) Stuart Sierra, 2009. 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.
+
+;; CHANGE LOG
+;;
+;; June 23, 2009: complete rewrite, eliminated _1,_2,... argument
+;; syntax
+;;
+;; January 20, 2009: added "template?" and checks for valid template
+;; expressions.
+;;
+;; December 15, 2008: first version
+
+
+(ns #^{:author "Stuart Sierra"
+       :doc "Macros that expand to repeated copies of a template expression."}
+  clojure.template
+  (:require [clojure.walk :as walk]))
+
+(defn apply-template
+  "For use in macros.  argv is an argument list, as in defn.  expr is
+  a quoted expression using the symbols in argv.  values is a sequence
+  of values to be used for the arguments.
+
+  apply-template will recursively replace argument symbols in expr
+  with their corresponding values, returning a modified expr.
+
+  Example: (apply-template '[x] '(+ x x) '[2])
+           ;=> (+ 2 2)"
+  [argv expr values]
+  (assert (vector? argv))
+  (assert (every? symbol? argv))
+  (walk/prewalk-replace (zipmap argv values) expr))
+
+(defmacro do-template
+  "Repeatedly copies expr (in a do block) for each group of arguments
+  in values.  values are automatically partitioned by the number of
+  arguments in argv, an argument vector as in defn.
+
+  Example: (macroexpand '(do-template [x y] (+ y x) 2 4 3 5))
+           ;=> (do (+ 4 2) (+ 5 3))"
+  [argv expr & values]
+  (let [c (count argv)]
+    `(do ~@(map (fn [a] (apply-template argv expr a)) 
+                (partition c values)))))
diff --git a/src/clj/clojure/test.clj b/src/clj/clojure/test.clj
new file mode 100644
index 00000000..601d2b4d
--- /dev/null
+++ b/src/clj/clojure/test.clj
@@ -0,0 +1,923 @@
+;;; test_is.clj: test framework for Clojure
+
+;; by Stuart Sierra, http://stuartsierra.com/
+;; March 28, 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
+  ;; 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"
+      (is (= 4 (+ 2 2)))
+      (is (= 7 (+ 3 4))))
+    (testing "with negative integers"
+      (is (= -4 (+ -2 -2)))
+      (is (= -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".
+  ;;
+  ;;
+  ;;
+  ;; FIXTURES (new)
+  ;;
+  ;; Fixtures allow you to run code before and after tests, to set up
+  ;; the context in which tests should be run.
+  ;;
+  ;; A fixture is just a function that calls another function passed as
+  ;; an argument.  It looks like this:
+  (defn my-fixture [f]
+    ;; Perform setup, establish bindings, whatever.
+    (f) ;; Then call the function we were passed.
+    ;; Tear-down / clean-up code here.
+    )
+
+  ;; Fixtures are attached to namespaces in one of two ways.  "each"
+  ;; fixtures are run repeatedly, once for each test function created
+  ;; with "deftest" or "with-test".  "each" fixtures are useful for
+  ;; establishing a consistent before/after state for each test, like
+  ;; clearing out database tables.
+  ;;
+  ;; "each" fixtures can be attached to the current namespace like this:
+  (use-fixtures :each fixture1 fixture2 ...)
+  ;; The fixture1, fixture2 are just functions like the example above.
+  ;; They can also be anonymous functions, like this:
+  (use-fixtures :each (fn [f] setup... (f) cleanup...))
+  ;;
+  ;; The other kind of fixture, a "once" fixture, is only run once,
+  ;; around ALL the tests in the namespace.  "once" fixtures are useful
+  ;; for tasks that only need to be performed once, like establishing
+  ;; database connections, or for time-consuming tasks.
+  ;;
+  ;; Attach "once" fixtures to the current namespace like this:
+  (use-fixtures :once fixture1 fixture2 ...)
+  ;;
+  ;;
+  ;;
+  ;; SAVING TEST OUTPUT TO A FILE
+  ;;
+  ;; All the test reporting functions write to the var *test-out*.  By
+  ;; default, this is the same as *out*, but you can rebind it to any
+  ;; PrintWriter.  For example, it could be a file opened with
+  ;; clojure.contrib.duck-streams/writer.
+  ;;
+  ;;
+  ;;
+  ;; 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)
+  ;;
+  ;; The 'event' argument is a map.  It will always have a :type key,
+  ;; whose value will be a keyword signaling the type of event being
+  ;; reported.  Standard events with :type value of :pass, :fail, and
+  ;; :error are called when an assertion passes, fails, and throws an
+  ;; exception, respectively.  In that case, the event will also have
+  ;; the following keys:
+  ;;
+  ;;   :expected   The form that was expected to be true
+  ;;   :actual     A form representing what actually occurred
+  ;;   :message    The string message given as an argument to 'is'
+  ;;
+  ;; The "testing" strings will be a list in "*testing-contexts*", and
+  ;; the vars being tested will be a list in "*testing-vars*".
+  ;;
+  ;; Your "report" function should wrap any printing calls in the
+  ;; "with-test-out" macro, which rebinds *out* to the current value
+  ;; of *test-out*.
+  ;;
+  ;; For additional event types, see the examples in the code below.
+
+  ) ;; end comment
+
+
+
+(ns 
+  #^{:author "Stuart Sierra, with contributions and suggestions by 
+Chas Emerick, Allen Rohner, and Stuart Halloway",
+     :doc "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
+   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\"
+       (is (= 4 (+ 2 2)))
+       (is (= 7 (+ 3 4))))
+     (testing \"with negative integers\"
+       (is (= -4 (+ -2 -2)))
+       (is (= -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\".
+
+
+   FIXTURES (new)
+
+   Fixtures allow you to run code before and after tests, to set up
+   the context in which tests should be run.
+
+   A fixture is just a function that calls another function passed as
+   an argument.  It looks like this:
+
+   (defn my-fixture [f]
+      Perform setup, establish bindings, whatever.
+     (f)  Then call the function we were passed.
+      Tear-down / clean-up code here.
+    )
+
+   Fixtures are attached to namespaces in one of two ways.  \"each\"
+   fixtures are run repeatedly, once for each test function created
+   with \"deftest\" or \"with-test\".  \"each\" fixtures are useful for
+   establishing a consistent before/after state for each test, like
+   clearing out database tables.
+
+   \"each\" fixtures can be attached to the current namespace like this:
+   (use-fixtures :each fixture1 fixture2 ...)
+   The fixture1, fixture2 are just functions like the example above.
+   They can also be anonymous functions, like this:
+   (use-fixtures :each (fn [f] setup... (f) cleanup...))
+
+   The other kind of fixture, a \"once\" fixture, is only run once,
+   around ALL the tests in the namespace.  \"once\" fixtures are useful
+   for tasks that only need to be performed once, like establishing
+   database connections, or for time-consuming tasks.
+
+   Attach \"once\" fixtures to the current namespace like this:
+   (use-fixtures :once fixture1 fixture2 ...)
+
+
+   SAVING TEST OUTPUT TO A FILE
+
+   All the test reporting functions write to the var *test-out*.  By
+   default, this is the same as *out*, but you can rebind it to any
+   PrintWriter.  For example, it could be a file opened with
+   clojure.contrib.duck-streams/writer.
+
+
+   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)
+
+   The 'event' argument is a map.  It will always have a :type key,
+   whose value will be a keyword signaling the type of event being
+   reported.  Standard events with :type value of :pass, :fail, and
+   :error are called when an assertion passes, fails, and throws an
+   exception, respectively.  In that case, the event will also have
+   the following keys:
+
+     :expected   The form that was expected to be true
+     :actual     A form representing what actually occurred
+     :message    The string message given as an argument to 'is'
+
+   The \"testing\" strings will be a list in \"*testing-contexts*\", and
+   the vars being tested will be a list in \"*testing-vars*\".
+
+   Your \"report\" function should wrap any printing calls in the
+   \"with-test-out\" macro, which rebinds *out* to the current value
+   of *test-out*.
+
+   For additional event types, see the examples in the code.
+"}
+  clojure.test
+  (:require [clojure.template :as temp]
+            [clojure.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 hierarchy of "testing" strings
+
+(def *test-out* *out*)         ; PrintWriter for test reporting output
+
+(defmacro with-test-out
+  "Runs body with *out* bound to the value of *test-out*."
+  [& body]
+  `(binding [*out* *test-out*]
+     ~@body))
+
+
+
+;;; 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 "Generic reporting function, may be overridden to plug in
+   different report formats (e.g., TAP, JUnit).  Assertions such as
+   'is' call 'report' to indicate results.  The argument given to
+   'report' will be a map with a :type key.  See the documentation at
+   the top of test_is.clj for more information on the types of
+   arguments for 'report'."}
+  report :type)
+
+(defmethod report :default [m]
+  (with-test-out (prn m)))
+
+(defmethod report :pass [m]
+  (with-test-out (inc-report-counter :pass)))
+
+(defmethod report :fail [m]
+  (with-test-out
+   (inc-report-counter :fail)
+   (println "\nFAIL in" (testing-vars-str))
+   (when (seq *testing-contexts*) (println (testing-contexts-str)))
+   (when-let [message (:message m)] (println message))
+   (println "expected:" (pr-str (:expected m)))
+   (println "  actual:" (pr-str (:actual m)))))
+
+(defmethod report :error [m]
+  (with-test-out
+   (inc-report-counter :error)
+   (println "\nERROR in" (testing-vars-str))
+   (when (seq *testing-contexts*) (println (testing-contexts-str)))
+   (when-let [message (:message m)]