Created
September 21, 2013 05:08
-
-
Save coventry/6647413 to your computer and use it in GitHub Desktop.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
(ns debugger-playground.wrap2-test | |
(:use [clojure.pprint :only (pprint)]) | |
(:require [debugger-playground.wrap2 :as w] | |
[clojure.tools.trace :as trace] | |
[clojure.set :as set] | |
[debugger-playground.core :as c] | |
[clojure.test :refer :all])) | |
(require '[debugger-playground.wrap2 :as w] :reload) | |
(def special-forms | |
"Convenience for making sure I've covered everything" | |
(->> clojure.lang.Compiler/specials seq (map (comp symbol first)) set)) | |
(def covered (set/union w/treat-as-function-call w/treat-as-let | |
w/treat-as-deftype* | |
(keys w/exclude-initial-elements) | |
w/do-not-wrap-constituents | |
(keys w/general-wrap-dispatch))) | |
(assert (= (set/union covered #{'&}) special-forms) | |
[(set/difference covered special-forms) | |
(set/difference special-forms covered)]) | |
(assert (set/subset? w/do-not-wrap-return-value special-forms)) | |
(defn wrapper [form] `(~'w ~form)) | |
(def w identity) | |
(defmacro wrapper= | |
([input expected] `(wrapper= ~input ~expected nil)) | |
([input expected msg] | |
`(let [result# (w/walk-wrap wrapper ~input) | |
_# (eval result#)] | |
(is (= result# ~expected) ~msg)))) | |
(deftest function-wrapping | |
(wrapper= '( inc (dec 0)) | |
'(w (inc (w (dec 0)))) | |
"Wrapping should walk into function calls") | |
(wrapper= '( (comp inc) 0) | |
'(w ((w (comp inc)) 0)) | |
"Functions invocations returned by functions should be | |
wrapped")) | |
(deftest object-wrapping | |
;; Regression test | |
(wrapper= '[0 1] '[0 1])) | |
(deftest let-wrapping | |
(wrapper= '(let* [a (inc 0) e 1] (dec e)) | |
'(let* [a (w (inc 0)) e 1] (w (dec e))) | |
"Wrapping captures let*'s binding expressions")) | |
(deftest deftype*-wrapping | |
(defprotocol t (f [g h]) (k [l])) | |
(let [head '(deftype* | |
s | |
debugger_playground.wrap2_test.s | |
[g] | |
:implements | |
[debugger_playground.wrap2_test.t clojure.lang.IType])] | |
(wrapper= `(~@head ~'(f [g h] (inc g)) ~'(k [l] (l) (l 1))) | |
`(~@head ~'(f [g h] (w (inc g))) ~'(k [l] (w (l)) (w (l 1)))) | |
"deftype* methods should be wrapped"))) | |
(deftest throw-wrapping | |
;; Was getting the wrong result for this, because I thought the | |
;; throw argument should not be wrapped. Regression test. | |
(let [texpr '(throw (new java.lang.IllegalArgumentException (str "No"))) | |
result (w/walk-wrap wrapper texpr) | |
_ (is = '(throw (w (new java.lang.IllegalArgumentException (w (str "No"))))))] | |
(is (thrown? java.lang.IllegalArgumentException (eval result))))) | |
(deftest ignore-elements | |
(is (= | |
(w/wrap-ignore-elements | |
wrapper | |
'(deftype* a b [c d] :implements [e] (f [g h] (i j)) (k [l] (m) (n))) | |
5) | |
'(deftype* a b [c d] :implements [e] (w (f [g h] (w (i j)))) (w (k [l] (w (m)) (w (n)))))))) | |
(deftest dot-wrapping | |
(wrapper= '(. "." length) '(w (. "." length)) | |
"(. instance-expr member-symbol) Same form for (. Classname-symbol member-symbol)") | |
(wrapper= '( . "foo" (charAt 1)) | |
'(w (. "foo" (charAt 1)))) | |
(wrapper= '(. "foo" charAt (inc 0)) | |
'(w (. "foo" charAt (w (inc 0)))))) | |
(deftest case*-wrapping | |
(wrapper= '(let* [a "hello"] (case* a 1 1 (throw (new java.lang.IllegalArgumentException (str "No matching clause: " a))) {0 ["" 0], 1 ["hello" (count a) ]} :compact :hash-equiv #{1 2 3})) | |
'(let* [a "hello"] (w (case* a 1 1 (throw (w (new java.lang.IllegalArgumentException (w (str "No matching clause: " a))))) {0 ["" 0], 1 ["hello" (w (count a))]} :compact :hash-equiv #{1 2 3}))))) | |
(deftest fn*-wrapping | |
(wrapper= '(fn* a ([b c] b (a (inc c))) ([] (a 1))) | |
'(fn* a ([b c] b (w (a (w (inc c))))) ([] (w (a 1))))) | |
(wrapper= '(fn* ([b c] b (dec (inc c))) ([] (dec 1))) | |
'(fn* ([b c] b (w (dec (w (inc c))))) ([] (w (dec 1)))))) | |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment