rlm@10: ;   The use and distribution terms for this software are covered by the
rlm@10: ;   Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
rlm@10: ;   which can be found in the file epl-v10.html at the root of this distribution.
rlm@10: ;   By using this software in any fashion, you are agreeing to be bound by
rlm@10: ;   the terms of this license.
rlm@10: ;   You must not remove this notice, or any other, from this software.
rlm@10: 
rlm@10: ; Author: Stuart Halloway
rlm@10: 
rlm@10: (ns clojure.test-clojure.helpers
rlm@10:   (:use clojure.test))
rlm@10: 
rlm@10: (defn temp-ns
rlm@10:   "Create and return a temporary ns, using clojure.core + uses"
rlm@10:   [& uses]
rlm@10:   (binding [*ns* *ns*]
rlm@10:     (in-ns (gensym))
rlm@10:     (apply clojure.core/use 'clojure.core uses)
rlm@10:     *ns*))
rlm@10: 
rlm@10: (defmacro eval-in-temp-ns [& forms]
rlm@10:   `(binding [*ns* *ns*]
rlm@10:      (in-ns (gensym))
rlm@10:      (clojure.core/use 'clojure.core)
rlm@10:      (eval
rlm@10:       '(do ~@forms))))
rlm@10: 
rlm@10: (defn causes
rlm@10:   [^Throwable throwable]
rlm@10:   (loop [causes []
rlm@10:          t throwable]
rlm@10:     (if t (recur (conj causes t) (.getCause t)) causes)))
rlm@10: 
rlm@10: ;; this is how I wish clojure.test/thrown? worked...
rlm@10: ;; Does body throw expected exception, anywhere in the .getCause chain?
rlm@10: (defmethod assert-expr 'fails-with-cause?
rlm@10:   [msg [_ exception-class msg-re & body :as form]]
rlm@10:   `(try
rlm@10:    ~@body
rlm@10:    (report {:type :fail, :message ~msg, :expected '~form, :actual nil})
rlm@10:    (catch Throwable t#
rlm@10:      (if (some (fn [cause#]
rlm@10:                  (and
rlm@10:                   (= ~exception-class (class cause#))
rlm@10:                   (re-find ~msg-re (.getMessage cause#))))
rlm@10:                (causes t#))
rlm@10:        (report {:type :pass, :message ~msg,
rlm@10:                 :expected '~form, :actual t#})
rlm@10:        (report {:type :fail, :message ~msg,
rlm@10:                 :expected '~form, :actual t#})))))
rlm@10: 
rlm@10: 
rlm@10: (defn get-field
rlm@10:   "Access to private or protected field.  field-name is a symbol or
rlm@10:   keyword."
rlm@10:   ([klass field-name]
rlm@10:      (get-field klass field-name nil))
rlm@10:   ([klass field-name inst]
rlm@10:      (-> klass (.getDeclaredField (name field-name))
rlm@10:          (doto (.setAccessible true))
rlm@10:          (.get inst))))
rlm@10: 
rlm@10: (defn set-var-roots
rlm@10:   [maplike]
rlm@10:   (doseq [[var val] maplike]
rlm@10:     (alter-var-root var (fn [_] val))))
rlm@10: 
rlm@10: (defn with-var-roots*
rlm@10:   "Temporarily set var roots, run block, then put original roots back."
rlm@10:   [root-map f & args]
rlm@10:   (let [originals (doall (map (fn [[var _]] [var @var]) root-map))]
rlm@10:     (set-var-roots root-map)
rlm@10:     (try
rlm@10:      (apply f args)
rlm@10:      (finally
rlm@10:       (set-var-roots originals)))))
rlm@10: 
rlm@10: (defmacro with-var-roots
rlm@10:   [root-map & body]
rlm@10:   `(with-var-roots* ~root-map (fn [] ~@body)))
rlm@10: 
rlm@10: (defn exception
rlm@10:   "Use this function to ensure that execution of a program doesn't
rlm@10:   reach certain point."
rlm@10:   []
rlm@10:   (throw (new Exception "Exception which should never occur")))