1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/test/tap.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,116 @@
     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_is/tap.clj: Extension to test for TAP output
    1.13 +
    1.14 +;; by Stuart Sierra
    1.15 +;; March 31, 2009
    1.16 +
    1.17 +;; Inspired by ClojureCheck by Meikel Brandmeyer:
    1.18 +;; http://kotka.de/projects/clojure/clojurecheck.html
    1.19 +
    1.20 +
    1.21 +;; DOCUMENTATION
    1.22 +;;
    1.23 +
    1.24 +
    1.25 +
    1.26 +(ns ^{:doc "clojure.test extensions for the Test Anything Protocol (TAP)
    1.27 +
    1.28 +  TAP is a simple text-based syntax for reporting test results.  TAP
    1.29 +  was originally develped for Perl, and now has implementations in
    1.30 +  several languages.  For more information on TAP, see
    1.31 +  http://testanything.org/ and
    1.32 +  http://search.cpan.org/~petdance/TAP-1.0.0/TAP.pm
    1.33 +
    1.34 +  To use this library, wrap any calls to
    1.35 +  clojure.test/run-tests in the with-tap-output macro,
    1.36 +  like this:
    1.37 +
    1.38 +    (use 'clojure.test)
    1.39 +    (use 'clojure.test.tap)
    1.40 +
    1.41 +    (with-tap-output
    1.42 +     (run-tests 'my.cool.library))"
    1.43 +       :author "Stuart Sierra"}
    1.44 +  clojure.test.tap
    1.45 +  (:require [clojure.test :as t]
    1.46 +            [clojure.stacktrace :as stack]))
    1.47 +
    1.48 +(defn print-tap-plan
    1.49 +  "Prints a TAP plan line like '1..n'.  n is the number of tests"
    1.50 +  {:added "1.1"}
    1.51 +  [n]
    1.52 +  (println (str "1.." n)))
    1.53 +
    1.54 +(defn print-tap-diagnostic
    1.55 +  "Prints a TAP diagnostic line.  data is a (possibly multi-line)
    1.56 +  string."
    1.57 +  {:added "1.1"}
    1.58 +  [data]
    1.59 +  (doseq [line (.split ^String data "\n")]
    1.60 +    (println "#" line)))
    1.61 +
    1.62 +(defn print-tap-pass
    1.63 +  "Prints a TAP 'ok' line.  msg is a string, with no line breaks"
    1.64 +  {:added "1.1"}
    1.65 +  [msg]
    1.66 +  (println "ok" msg))
    1.67 +
    1.68 +(defn print-tap-fail 
    1.69 +  "Prints a TAP 'not ok' line.  msg is a string, with no line breaks"
    1.70 +  {:added "1.1"}
    1.71 +  [msg]
    1.72 +  (println "not ok" msg))
    1.73 +
    1.74 +;; This multimethod will override test/report
    1.75 +(defmulti tap-report (fn [data] (:type data)))
    1.76 +
    1.77 +(defmethod tap-report :default [data]
    1.78 +  (t/with-test-out
    1.79 +   (print-tap-diagnostic (pr-str data))))
    1.80 +
    1.81 +(defmethod tap-report :pass [data]
    1.82 +  (t/with-test-out
    1.83 +   (t/inc-report-counter :pass)
    1.84 +   (print-tap-pass (t/testing-vars-str))
    1.85 +   (when (seq t/*testing-contexts*)
    1.86 +     (print-tap-diagnostic (t/testing-contexts-str)))
    1.87 +   (when (:message data)
    1.88 +     (print-tap-diagnostic (:message data)))
    1.89 +   (print-tap-diagnostic (str "expected:" (pr-str (:expected data))))
    1.90 +   (print-tap-diagnostic (str "  actual:" (pr-str (:actual data))))))
    1.91 +
    1.92 +(defmethod tap-report :error [data]
    1.93 +  (t/with-test-out
    1.94 +   (t/inc-report-counter :error)
    1.95 +   (print-tap-fail (t/testing-vars-str))
    1.96 +   (when (seq t/*testing-contexts*)
    1.97 +     (print-tap-diagnostic (t/testing-contexts-str)))
    1.98 +   (when (:message data)
    1.99 +     (print-tap-diagnostic (:message data)))
   1.100 +   (print-tap-diagnostic "expected:" (pr-str (:expected data)))
   1.101 +   (print-tap-diagnostic "  actual: ")
   1.102 +   (print-tap-diagnostic
   1.103 +    (with-out-str
   1.104 +      (if (instance? Throwable (:actual data))
   1.105 +        (stack/print-cause-trace (:actual data) t/*stack-trace-depth*)
   1.106 +        (prn (:actual data)))))))
   1.107 +
   1.108 +(defmethod tap-report :summary [data]
   1.109 +  (t/with-test-out
   1.110 +   (print-tap-plan (+ (:pass data) (:fail data) (:error data)))))
   1.111 +
   1.112 +
   1.113 +(defmacro with-tap-output
   1.114 +  "Execute body with modified test reporting functions that produce
   1.115 +  TAP output"
   1.116 +  {:added "1.1"}
   1.117 +  [& body]
   1.118 +  `(binding [t/report tap-report]
   1.119 +     ~@body))