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