|
rlm@10
|
1 ; The use and distribution terms for this software are covered by the
|
|
rlm@10
|
2 ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php)
|
|
rlm@10
|
3 ; which can be found in the file epl-v10.html at the root of this distribution.
|
|
rlm@10
|
4 ; By using this software in any fashion, you are agreeing to be bound by
|
|
rlm@10
|
5 ; the terms of this license.
|
|
rlm@10
|
6 ; You must not remove this notice, or any other, from this software.
|
|
rlm@10
|
7
|
|
rlm@10
|
8 ; Author: Stuart Halloway
|
|
rlm@10
|
9
|
|
rlm@10
|
10 (ns clojure.test-clojure.helpers
|
|
rlm@10
|
11 (:use clojure.test))
|
|
rlm@10
|
12
|
|
rlm@10
|
13 (defn temp-ns
|
|
rlm@10
|
14 "Create and return a temporary ns, using clojure.core + uses"
|
|
rlm@10
|
15 [& uses]
|
|
rlm@10
|
16 (binding [*ns* *ns*]
|
|
rlm@10
|
17 (in-ns (gensym))
|
|
rlm@10
|
18 (apply clojure.core/use 'clojure.core uses)
|
|
rlm@10
|
19 *ns*))
|
|
rlm@10
|
20
|
|
rlm@10
|
21 (defmacro eval-in-temp-ns [& forms]
|
|
rlm@10
|
22 `(binding [*ns* *ns*]
|
|
rlm@10
|
23 (in-ns (gensym))
|
|
rlm@10
|
24 (clojure.core/use 'clojure.core)
|
|
rlm@10
|
25 (eval
|
|
rlm@10
|
26 '(do ~@forms))))
|
|
rlm@10
|
27
|
|
rlm@10
|
28 (defn causes
|
|
rlm@10
|
29 [^Throwable throwable]
|
|
rlm@10
|
30 (loop [causes []
|
|
rlm@10
|
31 t throwable]
|
|
rlm@10
|
32 (if t (recur (conj causes t) (.getCause t)) causes)))
|
|
rlm@10
|
33
|
|
rlm@10
|
34 ;; this is how I wish clojure.test/thrown? worked...
|
|
rlm@10
|
35 ;; Does body throw expected exception, anywhere in the .getCause chain?
|
|
rlm@10
|
36 (defmethod assert-expr 'fails-with-cause?
|
|
rlm@10
|
37 [msg [_ exception-class msg-re & body :as form]]
|
|
rlm@10
|
38 `(try
|
|
rlm@10
|
39 ~@body
|
|
rlm@10
|
40 (report {:type :fail, :message ~msg, :expected '~form, :actual nil})
|
|
rlm@10
|
41 (catch Throwable t#
|
|
rlm@10
|
42 (if (some (fn [cause#]
|
|
rlm@10
|
43 (and
|
|
rlm@10
|
44 (= ~exception-class (class cause#))
|
|
rlm@10
|
45 (re-find ~msg-re (.getMessage cause#))))
|
|
rlm@10
|
46 (causes t#))
|
|
rlm@10
|
47 (report {:type :pass, :message ~msg,
|
|
rlm@10
|
48 :expected '~form, :actual t#})
|
|
rlm@10
|
49 (report {:type :fail, :message ~msg,
|
|
rlm@10
|
50 :expected '~form, :actual t#})))))
|
|
rlm@10
|
51
|
|
rlm@10
|
52
|
|
rlm@10
|
53 (defn get-field
|
|
rlm@10
|
54 "Access to private or protected field. field-name is a symbol or
|
|
rlm@10
|
55 keyword."
|
|
rlm@10
|
56 ([klass field-name]
|
|
rlm@10
|
57 (get-field klass field-name nil))
|
|
rlm@10
|
58 ([klass field-name inst]
|
|
rlm@10
|
59 (-> klass (.getDeclaredField (name field-name))
|
|
rlm@10
|
60 (doto (.setAccessible true))
|
|
rlm@10
|
61 (.get inst))))
|
|
rlm@10
|
62
|
|
rlm@10
|
63 (defn set-var-roots
|
|
rlm@10
|
64 [maplike]
|
|
rlm@10
|
65 (doseq [[var val] maplike]
|
|
rlm@10
|
66 (alter-var-root var (fn [_] val))))
|
|
rlm@10
|
67
|
|
rlm@10
|
68 (defn with-var-roots*
|
|
rlm@10
|
69 "Temporarily set var roots, run block, then put original roots back."
|
|
rlm@10
|
70 [root-map f & args]
|
|
rlm@10
|
71 (let [originals (doall (map (fn [[var _]] [var @var]) root-map))]
|
|
rlm@10
|
72 (set-var-roots root-map)
|
|
rlm@10
|
73 (try
|
|
rlm@10
|
74 (apply f args)
|
|
rlm@10
|
75 (finally
|
|
rlm@10
|
76 (set-var-roots originals)))))
|
|
rlm@10
|
77
|
|
rlm@10
|
78 (defmacro with-var-roots
|
|
rlm@10
|
79 [root-map & body]
|
|
rlm@10
|
80 `(with-var-roots* ~root-map (fn [] ~@body)))
|
|
rlm@10
|
81
|
|
rlm@10
|
82 (defn exception
|
|
rlm@10
|
83 "Use this function to ensure that execution of a program doesn't
|
|
rlm@10
|
84 reach certain point."
|
|
rlm@10
|
85 []
|
|
rlm@10
|
86 (throw (new Exception "Exception which should never occur")))
|
