1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/src/clojure/test_clojure/helpers.clj	Sat Aug 21 06:25:44 2010 -0400
     1.3 @@ -0,0 +1,86 @@
     1.4 +;   The use and distribution terms for this software are covered by the
     1.5 +;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
     1.6 +;   which can be found in the file epl-v10.html at the root of this distribution.
     1.7 +;   By using this software in any fashion, you are agreeing to be bound by
     1.8 +;   the terms of this license.
     1.9 +;   You must not remove this notice, or any other, from this software.
    1.10 +
    1.11 +; Author: Stuart Halloway
    1.12 +
    1.13 +(ns clojure.test-clojure.helpers
    1.14 +  (:use clojure.test))
    1.15 +
    1.16 +(defn temp-ns
    1.17 +  "Create and return a temporary ns, using clojure.core + uses"
    1.18 +  [& uses]
    1.19 +  (binding [*ns* *ns*]
    1.20 +    (in-ns (gensym))
    1.21 +    (apply clojure.core/use 'clojure.core uses)
    1.22 +    *ns*))
    1.23 +
    1.24 +(defmacro eval-in-temp-ns [& forms]
    1.25 +  `(binding [*ns* *ns*]
    1.26 +     (in-ns (gensym))
    1.27 +     (clojure.core/use 'clojure.core)
    1.28 +     (eval
    1.29 +      '(do ~@forms))))
    1.30 +
    1.31 +(defn causes
    1.32 +  [^Throwable throwable]
    1.33 +  (loop [causes []
    1.34 +         t throwable]
    1.35 +    (if t (recur (conj causes t) (.getCause t)) causes)))
    1.36 +
    1.37 +;; this is how I wish clojure.test/thrown? worked...
    1.38 +;; Does body throw expected exception, anywhere in the .getCause chain?
    1.39 +(defmethod assert-expr 'fails-with-cause?
    1.40 +  [msg [_ exception-class msg-re & body :as form]]
    1.41 +  `(try
    1.42 +   ~@body
    1.43 +   (report {:type :fail, :message ~msg, :expected '~form, :actual nil})
    1.44 +   (catch Throwable t#
    1.45 +     (if (some (fn [cause#]
    1.46 +                 (and
    1.47 +                  (= ~exception-class (class cause#))
    1.48 +                  (re-find ~msg-re (.getMessage cause#))))
    1.49 +               (causes t#))
    1.50 +       (report {:type :pass, :message ~msg,
    1.51 +                :expected '~form, :actual t#})
    1.52 +       (report {:type :fail, :message ~msg,
    1.53 +                :expected '~form, :actual t#})))))
    1.54 +
    1.55 +
    1.56 +(defn get-field
    1.57 +  "Access to private or protected field.  field-name is a symbol or
    1.58 +  keyword."
    1.59 +  ([klass field-name]
    1.60 +     (get-field klass field-name nil))
    1.61 +  ([klass field-name inst]
    1.62 +     (-> klass (.getDeclaredField (name field-name))
    1.63 +         (doto (.setAccessible true))
    1.64 +         (.get inst))))
    1.65 +
    1.66 +(defn set-var-roots
    1.67 +  [maplike]
    1.68 +  (doseq [[var val] maplike]
    1.69 +    (alter-var-root var (fn [_] val))))
    1.70 +
    1.71 +(defn with-var-roots*
    1.72 +  "Temporarily set var roots, run block, then put original roots back."
    1.73 +  [root-map f & args]
    1.74 +  (let [originals (doall (map (fn [[var _]] [var @var]) root-map))]
    1.75 +    (set-var-roots root-map)
    1.76 +    (try
    1.77 +     (apply f args)
    1.78 +     (finally
    1.79 +      (set-var-roots originals)))))
    1.80 +
    1.81 +(defmacro with-var-roots
    1.82 +  [root-map & body]
    1.83 +  `(with-var-roots* ~root-map (fn [] ~@body)))
    1.84 +
    1.85 +(defn exception
    1.86 +  "Use this function to ensure that execution of a program doesn't
    1.87 +  reach certain point."
    1.88 +  []
    1.89 +  (throw (new Exception "Exception which should never occur")))