Mercurial > lasercutter

     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")))
author	Robert McIntyre <rlm@mit.edu>
date	Sat, 21 Aug 2010 06:25:44 -0400
parents
children