thread-local version of with-redefs

with-local-redefs.clj

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Commentary                                                            ;;
;;                                                                       ;;
;; The goal for writing this started with the idea to have tests run in  ;;
;; parallel using the leiningen plugin eftest                            ;;
;; https://github.com/weavejester/eftest.                                ;;
;;                                                                       ;;
;; With tests using with-redefs, it was not possible to run them in      ;;
;; parallel if they were changing the root binding of the same           ;;
;; vars. Here, we are binding the root of the var to one function that   ;;
;; respects per-thread rebindings, if any exist.                         ;;
;;                                                                       ;;
;; Known caveats:                                                        ;;
;; - This per-therad rebinding will only work with clojure concurrency   ;;
;;   primitives which copy per-thread bindings to newly spawned threads, ;;
;;   eg, using clojure futures. But will not work for, say a             ;;
;;   java.lang.Thread.                                                   ;;
;; - As of now this only supports functions being bound and not other    ;;
;;   vars which store values, say (def x 19) for example.                ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;



(def ^:dynamic local-redefinitions {})

(defn current->original-definition
  [v]
  (when (var? v)
    (get (meta v) ::original)))


(defn redefiniton-fn
  [a-var]
  (fn [& args]
    (let [current-f (get local-redefinitions
                         a-var
                         (current->original-definition a-var))]
      (apply current-f args))))


(defn dynamic-redefs
  [vars func]
  (let [un-redefs (remove #(::already-bound? (meta %)) vars)]
    (doseq [a-var un-redefs]
      (locking a-var
        (when-not (::already-bound? (meta a-var))
          (let [old-val (.getRawRoot ^clojure.lang.Var a-var)]
            (.bindRoot ^clojure.lang.Var a-var
                       (redefiniton-fn a-var))
            (alter-meta! a-var
                         (fn [m]
                           (assoc m
                                  ::already-bound? true
                                  ::original old-val))))))))
  (func))


(defn xs->map
  [xs]
  (reduce (fn [acc [k v]] (assoc acc `(var ~k) v))
          {}
          (partition 2 xs)))


(defmacro with-dynamic-redefs
  [bindings & body]
  ;; @TODO: Add support for non-functions
  (let [map-bindings (xs->map bindings)]
    `(let [old-rebindings# local-redefinitions]
       (binding [local-redefinitions (merge old-rebindings# ~map-bindings)]
         (dynamic-redefs ~(vec (keys map-bindings))
                         (fn [] ~@body))))))



(comment ;; for testing
  (defn funk [& args] {:original-args args})
  (dotimes [i 1000]
    (let [f1 (future (with-dynamic-redefs [funk (constantly -100)]
                       (Thread/sleep (rand-int 10))
                       {:100 (funk) :t (.getName (Thread/currentThread))}))

          f2 (future (with-dynamic-redefs [funk (constantly -200)]
                       (Thread/sleep (rand-int 1000))
                       {:200 (funk 9) :t (.getName (Thread/currentThread))}))
          f3 (future (do
                       (Thread/sleep (rand-int 1000))
                       {:orig (funk 9) :t (.getName (Thread/currentThread))}))]
      (when (or (not= (:100 @f1) -100)
                (not= (:200 @f2) -200)
                (not= (:orig @f3) {:original-args '(9)}))
        (println "FAIL")
        (prn @f1)
        (prn @f2)
        (println "----------------\n\n")))))

Absolutely, I would love your contribution!