├── .gitignore ├── LICENSE ├── README.md ├── dev └── gumshoe │ ├── dev.clj │ └── quick_test.clj ├── project.clj ├── src └── gumshoe │ ├── plugin.clj │ └── track.clj └── test ├── clojure ├── test_clojure │ ├── def.clj │ └── metadata.clj └── test_helper.clj └── gumshoe └── track_test.clj /.gitignore: -------------------------------------------------------------------------------- 1 | /target 2 | /classes 3 | /checkouts 4 | pom.xml 5 | pom.xml.asc 6 | *.jar 7 | *.class 8 | /.lein-* 9 | /.nrepl-port 10 | .hgignore 11 | .hg/ 12 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | THE ACCOMPANYING PROGRAM IS PROVIDED UNDER THE TERMS OF THIS ECLIPSE PUBLIC 2 | LICENSE ("AGREEMENT"). ANY USE, REPRODUCTION OR DISTRIBUTION OF THE PROGRAM 3 | CONSTITUTES RECIPIENT'S ACCEPTANCE OF THIS AGREEMENT. 4 | 5 | 1. DEFINITIONS 6 | 7 | "Contribution" means: 8 | 9 | a) in the case of the initial Contributor, the initial code and 10 | documentation distributed under this Agreement, and 11 | 12 | b) in the case of each subsequent Contributor: 13 | 14 | i) changes to the Program, and 15 | 16 | ii) additions to the Program; 17 | 18 | where such changes and/or additions to the Program originate from and are 19 | distributed by that particular Contributor. A Contribution 'originates' from 20 | a Contributor if it was added to the Program by such Contributor itself or 21 | anyone acting on such Contributor's behalf. Contributions do not include 22 | additions to the Program which: (i) are separate modules of software 23 | distributed in conjunction with the Program under their own license 24 | agreement, and (ii) are not derivative works of the Program. 25 | 26 | "Contributor" means any person or entity that distributes the Program. 27 | 28 | "Licensed Patents" mean patent claims licensable by a Contributor which are 29 | necessarily infringed by the use or sale of its Contribution alone or when 30 | combined with the Program. 31 | 32 | "Program" means the Contributions distributed in accordance with this 33 | Agreement. 34 | 35 | "Recipient" means anyone who receives the Program under this Agreement, 36 | including all Contributors. 37 | 38 | 2. GRANT OF RIGHTS 39 | 40 | a) Subject to the terms of this Agreement, each Contributor hereby grants 41 | Recipient a non-exclusive, worldwide, royalty-free copyright license to 42 | reproduce, prepare derivative works of, publicly display, publicly perform, 43 | distribute and sublicense the Contribution of such Contributor, if any, and 44 | such derivative works, in source code and object code form. 45 | 46 | b) Subject to the terms of this Agreement, each Contributor hereby grants 47 | Recipient a non-exclusive, worldwide, royalty-free patent license under 48 | Licensed Patents to make, use, sell, offer to sell, import and otherwise 49 | transfer the Contribution of such Contributor, if any, in source code and 50 | object code form. This patent license shall apply to the combination of the 51 | Contribution and the Program if, at the time the Contribution is added by the 52 | Contributor, such addition of the Contribution causes such combination to be 53 | covered by the Licensed Patents. The patent license shall not apply to any 54 | other combinations which include the Contribution. No hardware per se is 55 | licensed hereunder. 56 | 57 | c) Recipient understands that although each Contributor grants the licenses 58 | to its Contributions set forth herein, no assurances are provided by any 59 | Contributor that the Program does not infringe the patent or other 60 | intellectual property rights of any other entity. Each Contributor disclaims 61 | any liability to Recipient for claims brought by any other entity based on 62 | infringement of intellectual property rights or otherwise. As a condition to 63 | exercising the rights and licenses granted hereunder, each Recipient hereby 64 | assumes sole responsibility to secure any other intellectual property rights 65 | needed, if any. For example, if a third party patent license is required to 66 | allow Recipient to distribute the Program, it is Recipient's responsibility 67 | to acquire that license before distributing the Program. 68 | 69 | d) Each Contributor represents that to its knowledge it has sufficient 70 | copyright rights in its Contribution, if any, to grant the copyright license 71 | set forth in this Agreement. 72 | 73 | 3. REQUIREMENTS 74 | 75 | A Contributor may choose to distribute the Program in object code form under 76 | its own license agreement, provided that: 77 | 78 | a) it complies with the terms and conditions of this Agreement; and 79 | 80 | b) its license agreement: 81 | 82 | i) effectively disclaims on behalf of all Contributors all warranties and 83 | conditions, express and implied, including warranties or conditions of title 84 | and non-infringement, and implied warranties or conditions of merchantability 85 | and fitness for a particular purpose; 86 | 87 | ii) effectively excludes on behalf of all Contributors all liability for 88 | damages, including direct, indirect, special, incidental and consequential 89 | damages, such as lost profits; 90 | 91 | iii) states that any provisions which differ from this Agreement are offered 92 | by that Contributor alone and not by any other party; and 93 | 94 | iv) states that source code for the Program is available from such 95 | Contributor, and informs licensees how to obtain it in a reasonable manner on 96 | or through a medium customarily used for software exchange. 97 | 98 | When the Program is made available in source code form: 99 | 100 | a) it must be made available under this Agreement; and 101 | 102 | b) a copy of this Agreement must be included with each copy of the Program. 103 | 104 | Contributors may not remove or alter any copyright notices contained within 105 | the Program. 106 | 107 | Each Contributor must identify itself as the originator of its Contribution, 108 | if any, in a manner that reasonably allows subsequent Recipients to identify 109 | the originator of the Contribution. 110 | 111 | 4. COMMERCIAL DISTRIBUTION 112 | 113 | Commercial distributors of software may accept certain responsibilities with 114 | respect to end users, business partners and the like. While this license is 115 | intended to facilitate the commercial use of the Program, the Contributor who 116 | includes the Program in a commercial product offering should do so in a 117 | manner which does not create potential liability for other Contributors. 118 | Therefore, if a Contributor includes the Program in a commercial product 119 | offering, such Contributor ("Commercial Contributor") hereby agrees to defend 120 | and indemnify every other Contributor ("Indemnified Contributor") against any 121 | losses, damages and costs (collectively "Losses") arising from claims, 122 | lawsuits and other legal actions brought by a third party against the 123 | Indemnified Contributor to the extent caused by the acts or omissions of such 124 | Commercial Contributor in connection with its distribution of the Program in 125 | a commercial product offering. The obligations in this section do not apply 126 | to any claims or Losses relating to any actual or alleged intellectual 127 | property infringement. In order to qualify, an Indemnified Contributor must: 128 | a) promptly notify the Commercial Contributor in writing of such claim, and 129 | b) allow the Commercial Contributor tocontrol, and cooperate with the 130 | Commercial Contributor in, the defense and any related settlement 131 | negotiations. The Indemnified Contributor may participate in any such claim 132 | at its own expense. 133 | 134 | For example, a Contributor might include the Program in a commercial product 135 | offering, Product X. That Contributor is then a Commercial Contributor. If 136 | that Commercial Contributor then makes performance claims, or offers 137 | warranties related to Product X, those performance claims and warranties are 138 | such Commercial Contributor's responsibility alone. Under this section, the 139 | Commercial Contributor would have to defend claims against the other 140 | Contributors related to those performance claims and warranties, and if a 141 | court requires any other Contributor to pay any damages as a result, the 142 | Commercial Contributor must pay those damages. 143 | 144 | 5. NO WARRANTY 145 | 146 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, THE PROGRAM IS PROVIDED ON 147 | AN "AS IS" BASIS, WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, EITHER 148 | EXPRESS OR IMPLIED INCLUDING, WITHOUT LIMITATION, ANY WARRANTIES OR 149 | CONDITIONS OF TITLE, NON-INFRINGEMENT, MERCHANTABILITY OR FITNESS FOR A 150 | PARTICULAR PURPOSE. Each Recipient is solely responsible for determining the 151 | appropriateness of using and distributing the Program and assumes all risks 152 | associated with its exercise of rights under this Agreement , including but 153 | not limited to the risks and costs of program errors, compliance with 154 | applicable laws, damage to or loss of data, programs or equipment, and 155 | unavailability or interruption of operations. 156 | 157 | 6. DISCLAIMER OF LIABILITY 158 | 159 | EXCEPT AS EXPRESSLY SET FORTH IN THIS AGREEMENT, NEITHER RECIPIENT NOR ANY 160 | CONTRIBUTORS SHALL HAVE ANY LIABILITY FOR ANY DIRECT, INDIRECT, INCIDENTAL, 161 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING WITHOUT LIMITATION 162 | LOST PROFITS), HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN 163 | CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) 164 | ARISING IN ANY WAY OUT OF THE USE OR DISTRIBUTION OF THE PROGRAM OR THE 165 | EXERCISE OF ANY RIGHTS GRANTED HEREUNDER, EVEN IF ADVISED OF THE POSSIBILITY 166 | OF SUCH DAMAGES. 167 | 168 | 7. GENERAL 169 | 170 | If any provision of this Agreement is invalid or unenforceable under 171 | applicable law, it shall not affect the validity or enforceability of the 172 | remainder of the terms of this Agreement, and without further action by the 173 | parties hereto, such provision shall be reformed to the minimum extent 174 | necessary to make such provision valid and enforceable. 175 | 176 | If Recipient institutes patent litigation against any entity (including a 177 | cross-claim or counterclaim in a lawsuit) alleging that the Program itself 178 | (excluding combinations of the Program with other software or hardware) 179 | infringes such Recipient's patent(s), then such Recipient's rights granted 180 | under Section 2(b) shall terminate as of the date such litigation is filed. 181 | 182 | All Recipient's rights under this Agreement shall terminate if it fails to 183 | comply with any of the material terms or conditions of this Agreement and 184 | does not cure such failure in a reasonable period of time after becoming 185 | aware of such noncompliance. If all Recipient's rights under this Agreement 186 | terminate, Recipient agrees to cease use and distribution of the Program as 187 | soon as reasonably practicable. However, Recipient's obligations under this 188 | Agreement and any licenses granted by Recipient relating to the Program shall 189 | continue and survive. 190 | 191 | Everyone is permitted to copy and distribute copies of this Agreement, but in 192 | order to avoid inconsistency the Agreement is copyrighted and may only be 193 | modified in the following manner. The Agreement Steward reserves the right to 194 | publish new versions (including revisions) of this Agreement from time to 195 | time. No one other than the Agreement Steward has the right to modify this 196 | Agreement. The Eclipse Foundation is the initial Agreement Steward. The 197 | Eclipse Foundation may assign the responsibility to serve as the Agreement 198 | Steward to a suitable separate entity. Each new version of the Agreement will 199 | be given a distinguishing version number. The Program (including 200 | Contributions) may always be distributed subject to the version of the 201 | Agreement under which it was received. In addition, after a new version of 202 | the Agreement is published, Contributor may elect to distribute the Program 203 | (including its Contributions) under the new version. Except as expressly 204 | stated in Sections 2(a) and 2(b) above, Recipient receives no rights or 205 | licenses to the intellectual property of any Contributor under this 206 | Agreement, whether expressly, by implication, estoppel or otherwise. All 207 | rights in the Program not expressly granted under this Agreement are 208 | reserved. 209 | 210 | This Agreement is governed by the laws of the State of New York and the 211 | intellectual property laws of the United States of America. No party to this 212 | Agreement will bring a legal action under this Agreement more than one year 213 | after the cause of action arose. Each party waives its rights to a jury trial 214 | in any resulting litigation. 215 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # gumshoe 2 | 3 | A debugging tool for tracking arguments passed to Clojure functions. 4 | 5 | "Extremism in the defense of debugging is no vice!" 6 | 7 | ## Usage 8 | 9 | In your project.clj: 10 | 11 | ``` 12 | [dato/gumshoe "0.1.5"] 13 | ``` 14 | 15 | Use `deft` in place of `defn` to have the arguments to the function defined in the namespace. 16 | 17 | Arguments are prefixed with "-{name-of-function}-". For example: 18 | 19 | ```clojure 20 | user> (deft add-ten [num] 21 | (+ num 10)) 22 | #'user/add-ten 23 | user> (add-ten 2) 24 | 12 25 | user> -add-ten-num 26 | 2 27 | ``` 28 | 29 | Works with destructuring: 30 | 31 | ```clojure 32 | user> (deft destructure-example [{:keys [a b] :as args}] 33 | a) 34 | #'user/destructure-example 35 | user> -destructure-example-a 36 | 1 37 | user> -destructure-example-b 38 | nil 39 | user> -destructure-example-args 40 | {:a 1, :c 2} 41 | ``` 42 | 43 | Careful with recursion: 44 | ```clojure 45 | user> (deft recur-example [x] 46 | (if (= 0 x) 47 | :done 48 | (recur (dec x)))) 49 | #'user/recur-example 50 | user> (recur-example 10) 51 | :done 52 | user> -recur-example-x 53 | 0 ;; returns 0 because the value gets redefined on each trip through the function 54 | ``` 55 | 56 | ## Automatically using deft in development 57 | 58 | Gumshoe ships with a plugin that will replace clojure's `defn` with Gumshoe's `deft`. With the plugin, you'll automatically get tracking for every function in your project! 59 | 60 | Either in your project's `project.clj` file or in the `:user` profile in `~/.lein/profiles.clj` 61 | 62 | ``` 63 | :plugins [[dato/gumshoe "0.1.5"]] 64 | ``` 65 | 66 | Putting gumshoe in your user profile is handy, but it's safer to create a separate profile just for gumshoe: 67 | 68 | ``` 69 | {:gumshoe {:plugins [[dato/gumshoe "0.1.5"]]} 70 | :user {:plugins ...}} 71 | ``` 72 | 73 | Then use with-profile in lein to use gumshoe only in dev: 74 | 75 | ``` 76 | lein with-profile +gumshoe run 77 | ``` 78 | 79 | ## Testing and development 80 | 81 | If you want to make changes and have a place to test them out, there is an 82 | example service in the dev directory. To start it, run: 83 | 84 | ``` 85 | lein with-profile dev run -m gumshoe.dev 86 | ``` 87 | 88 | Then connect to the repl on port 3005 and open your browser to http://localhost:4579 89 | 90 | The ports are configurable with `NREPL_PORT` and `HTTP_PORT`. 91 | 92 | ## TODO 93 | 94 | 1. Add motivation to the about section on the README 95 | 2. Turn on tracking for all functions in a namespace 96 | 3. Update trackers when functions are redefined, similar to ring's reload middleware 97 | 98 | ## License 99 | 100 | Distributed under the Eclipse Public License either version 1.0 or (at 101 | your option) any later version. 102 | -------------------------------------------------------------------------------- /dev/gumshoe/dev.clj: -------------------------------------------------------------------------------- 1 | (ns gumshoe.dev 2 | (:require [clojure.pprint] 3 | [clojure.tools.nrepl.server :refer (start-server stop-server)] 4 | [clojure.tools.logging :as log] 5 | [compojure.core :refer (routes GET POST)] 6 | [compojure.route] 7 | [cider.nrepl] 8 | [hiccup.page] 9 | [hiccup.core] 10 | [immutant.web :as web] 11 | [gumshoe.track])) 12 | 13 | (gumshoe.track/deft test-fn [a b & {:keys [c d e] :as extra-args}] 14 | (println "test-fn was called with" a b extra-args) 15 | :test-fn) 16 | 17 | (defn something-something [a b d] 18 | :something-something) 19 | 20 | (defmulti test-multi (fn [x] x)) 21 | 22 | (defmethod test-multi :default 23 | [x] 24 | :default) 25 | 26 | (defmethod test-multi :a 27 | [x] 28 | :first-test-multi) 29 | 30 | (defmethod test-multi :b 31 | [x] 32 | :second-test-multi) 33 | 34 | (defn body [] 35 | (hiccup.page/html5 36 | [:head 37 | [:title "Gumshoe Dev"] 38 | [:meta {:charset "utf-8"}]] 39 | [:body 40 | [:div "Test fn: " (test-fn 3 4 :c 4 :d 7)] 41 | [:div "Test multi default: " (test-multi nil)] 42 | [:div "Test multi a: " (test-multi :a)] 43 | [:div "Test multi b: " (test-multi :b)] 44 | [:div "Something something: " (something-something 1 2 3)] 45 | [:div "Vars: " 46 | [:pre (hiccup.core/h 47 | (pr-str 48 | (into {} 49 | (filter #(re-find #"^-test-fn-[a-z]$" (name (first %))) 50 | (ns-map 'gumshoe.dev)))))]]])) 51 | 52 | (defn route-handler [] 53 | (routes 54 | (GET "/" [] 55 | {:status 200 :body (body)}) 56 | (compojure.route/resources "/" {:root "public" 57 | :mime-types {:svg "image/svg"}}) 58 | (fn [req] 59 | {:status 404 60 | :body "Sorry, we couldn't find that page. Back to home."}))) 61 | 62 | (defn handler [] 63 | (-> (route-handler))) 64 | 65 | (defn nrepl-port [] 66 | (if (System/getenv "NREPL_PORT") 67 | (Integer/parseInt (System/getenv "NREPL_PORT")) 68 | 3005)) 69 | 70 | (defn server-port [] 71 | (if (System/getenv "HTTP_PORT") 72 | (Integer/parseInt (System/getenv "HTTP_PORT")) 73 | 4579)) 74 | 75 | (defn start-web [] 76 | (let [port (server-port)] 77 | (println "Starting web server on port" port) 78 | (def web-server (web/server (web/run 79 | (handler) 80 | {:port port 81 | :host "0.0.0.0"}))))) 82 | 83 | (defn start-nrepl [] 84 | (let [port (nrepl-port)] 85 | (println "Starting nrepl on port" port) 86 | (def nrepl-server (start-server :port port :handler cider.nrepl/cider-nrepl-handler)))) 87 | 88 | (defn init [] 89 | (start-nrepl) 90 | (start-web)) 91 | 92 | (defn restart-web [] 93 | (.stop web-server) 94 | (start-web)) 95 | 96 | 97 | (defn -main [] 98 | (init)) 99 | -------------------------------------------------------------------------------- /dev/gumshoe/quick_test.clj: -------------------------------------------------------------------------------- 1 | (ns gumshoe.quick-test 2 | (:require [gumshoe.track :refer (deft)]) 3 | (:refer-clojure :exclude [find-ns all-ns find-var ns-aliases] ;[find-ns find-var all-ns ns-aliases] 4 | )) 5 | 6 | (def NSES :cljs.analyzer/namespaces) 7 | 8 | (deft easier [a] 9 | (println a)) 10 | 11 | (deft all-ns 12 | [env] 13 | (NSES env)) 14 | 15 | (deft test-fn [a b c] 16 | a) 17 | 18 | (let [a (rand-int 1000)] 19 | (println "rand-int" a) 20 | (println "res" (test-fn a 2 3)) 21 | (println "-test-fn-a" (ns-resolve 'gumshoe.quick-test '-test-fn-a)) 22 | (println -test-fn-a)) 23 | -------------------------------------------------------------------------------- /project.clj: -------------------------------------------------------------------------------- 1 | (defproject dato/gumshoe "0.1.5" 2 | :description "Debugging tool for tracking arguments passed to Clojure functions" 3 | :url "http://example.com/FIXME" 4 | :license {:name "Eclipse Public License" 5 | :url "http://www.eclipse.org/legal/epl-v10.html"} 6 | :profiles {:dev {:source-paths ["src" "dev"] 7 | :plugins [[cider/cider-nrepl "0.9.1"]] 8 | :dependencies [[org.clojure/clojure] 9 | [org.clojure/tools.nrepl "0.2.10"] 10 | [cider/cider-nrepl "0.9.1" :exclusions [org.clojure/tools.nrepl]] 11 | [org.clojure/tools.logging "0.3.1"] 12 | [compojure "1.3.4"] 13 | [hiccup "1.0.5"] 14 | [org.immutant/web "2.0.2"]]}}) 15 | -------------------------------------------------------------------------------- /src/gumshoe/plugin.clj: -------------------------------------------------------------------------------- 1 | (ns gumshoe.plugin 2 | (:require [clojure.java.io :as io] 3 | [leiningen.core.main :as lein])) 4 | 5 | ;; TODO: better way to handle this 6 | (def VERSION "0.1.5") 7 | 8 | (defn middleware 9 | [{:keys [dependencies] :as project}] 10 | (let [lein-version-ok? (lein/version-satisfies? (lein/leiningen-version) "2.5.2") 11 | clojure-version (->> dependencies 12 | (some (fn [[id version & _]] 13 | (when (= id 'org.clojure/clojure) 14 | version)))) 15 | clojure-version-ok? (if (nil? clojure-version) 16 | ;; Lein 2.5.2+ uses Clojure 1.7 by default 17 | lein-version-ok? 18 | (lein/version-satisfies? clojure-version "1.7.0"))] 19 | 20 | (when-not lein-version-ok? 21 | (lein/warn "Warning: gumshoe requires Leiningen 2.5.2 or greater.")) 22 | (when-not clojure-version-ok? 23 | (lein/warn "Warning: gumshoe requires Clojure 1.7 or greater.")) 24 | (when-not (and lein-version-ok? clojure-version-ok?) 25 | (lein/warn "Warning: gumshoe will not be included in your project.")) 26 | 27 | (cond-> project 28 | (and clojure-version-ok? lein-version-ok?) 29 | (-> (update-in [:dependencies] 30 | (fnil into []) 31 | [['dato/gumshoe VERSION]]) 32 | (update-in [:injections] 33 | (fnil into []) 34 | ['(do (require 'gumshoe.track) 35 | (gumshoe.track/deft-everything))]))))) 36 | -------------------------------------------------------------------------------- /src/gumshoe/track.clj: -------------------------------------------------------------------------------- 1 | (ns gumshoe.track) 2 | 3 | (defn assert-valid-fdecl 4 | "A good fdecl looks like (([a] ...) ([a b] ...)) near the end of defn." 5 | [fdecl] 6 | (when (empty? fdecl) (throw (IllegalArgumentException. 7 | "Parameter declaration missing"))) 8 | (let [argdecls (map 9 | #(if (seq? %) 10 | (first %) 11 | (throw (IllegalArgumentException. 12 | (if (seq? (first fdecl)) 13 | (str "Invalid signature \"" 14 | % 15 | "\" should be a list") 16 | (str "Parameter declaration \"" 17 | % 18 | "\" should be a vector"))))) 19 | fdecl) 20 | bad-args (seq (remove #(vector? %) argdecls))] 21 | (when bad-args 22 | (throw (IllegalArgumentException. (str "Parameter declaration \"" (first bad-args) 23 | "\" should be a vector")))))) 24 | 25 | (defn sigs [fdecl] 26 | (assert-valid-fdecl fdecl) 27 | (let [asig 28 | (fn [fdecl] 29 | (let [arglist (first fdecl) 30 | ;elide implicit macro args 31 | arglist (if (clojure.lang.Util/equals '&form (first arglist)) 32 | (clojure.lang.RT/subvec arglist 2 (clojure.lang.RT/count arglist)) 33 | arglist) 34 | body (next fdecl)] 35 | (if (map? (first body)) 36 | (if (next body) 37 | (with-meta arglist (conj (if (meta arglist) (meta arglist) {}) (first body))) 38 | arglist) 39 | arglist)))] 40 | (if (seq? (first fdecl)) 41 | (loop [ret [] fdecls fdecl] 42 | (if fdecls 43 | (recur (conj ret (asig (first fdecls))) (next fdecls)) 44 | (seq ret))) 45 | (list (asig fdecl))))) 46 | 47 | (defmacro def-locals [base-ns base-name] 48 | (let [env# &env] 49 | `(do 50 | ~@(for [k (keys env#) 51 | :when (not (contains? #{'&env '&form} k)) 52 | :let [;; remove tag to prevent type hint for primitive local error 53 | k (with-meta k (dissoc (meta k) :tag)) 54 | ;; use name to prevent def-ing fully qualified names 55 | base (-> base-name 56 | name 57 | ;; don't let clojure think this is a namespace separator 58 | (.replace "/" "divide")) 59 | sym (symbol (str "-" base "-" k))]] 60 | (list 'def sym k)) 61 | nil))) 62 | 63 | (defn deft [&form &env name & fdecl] 64 | ;; Note: Cannot delegate this check to def because of the call to (with-meta name ..) 65 | (if (instance? clojure.lang.Symbol name) 66 | nil 67 | (throw (IllegalArgumentException. "First argument to deft must be a symbol"))) 68 | (let [m (if (string? (first fdecl)) 69 | {:doc (first fdecl)} 70 | {}) 71 | fdecl (if (string? (first fdecl)) 72 | (next fdecl) 73 | fdecl) 74 | m (if (map? (first fdecl)) 75 | (conj m (first fdecl)) 76 | m) 77 | fdecl (if (map? (first fdecl)) 78 | (next fdecl) 79 | fdecl) 80 | fdecl (if (vector? (first fdecl)) 81 | (list fdecl) 82 | fdecl) 83 | m (if (map? (last fdecl)) 84 | (conj m (last fdecl)) 85 | m) 86 | fdecl (if (map? (last fdecl)) 87 | (butlast fdecl) 88 | fdecl) 89 | m (conj {:arglists (list 'quote (sigs fdecl))} m) 90 | m (let [inline (:inline m) 91 | ifn (first inline) 92 | iname (second inline)] 93 | ;; same as: (if (and (= 'fn ifn) (not (symbol? iname))) ...) 94 | (if (if (clojure.lang.Util/equiv 'fn ifn) 95 | (if (instance? clojure.lang.Symbol iname) false true)) 96 | ;; inserts the same fn name to the inline fn if it does not have one 97 | (assoc m :inline (cons ifn (cons (clojure.lang.Symbol/intern (.concat (.getName ^clojure.lang.Symbol name) "__inliner")) 98 | (next inline)))) 99 | m)) 100 | m (conj (if (meta name) (meta name) {}) m) 101 | base-ns *ns*] 102 | (list 'def (with-meta name m) 103 | ;;todo - restore propagation of fn name 104 | ;;must figure out how to convey primitive hints to self calls first 105 | ;;(cons `fn fdecl) 106 | (concat (list `fn) (for [decl fdecl 107 | :let [args (first decl) 108 | body (rest decl) 109 | ;; pre/post conditions 110 | conds (when (and (next body) (map? (first body))) 111 | (list (first body))) 112 | ]] 113 | (concat (list args) 114 | conds 115 | ;; tracker 116 | (list `(def-locals ~base-ns ~name)) 117 | (if conds 118 | (next body) 119 | body))))))) 120 | 121 | (def deft-non-macro (deref (var deft))) 122 | 123 | (. (var deft) (setMacro)) 124 | 125 | (defonce defn-orig (deref (var defn))) 126 | 127 | (defn deft-everything 128 | "Redefines `defn` `deft`. All defns after this is run will use deft 129 | \"Extremism in the defense of debugging is no vice!\"" 130 | [] 131 | (intern 'clojure.core 'defn deft-non-macro) 132 | (. (var defn) (setMacro))) 133 | 134 | (defn undeft-everything [] 135 | (intern 'clojure.core 'defn defn-orig) 136 | (. (var defn) (setMacro))) 137 | ;; TODO: finish porting over tools.trace stuff for tracking an entire namespace 138 | 139 | ;; (defn track-var* 140 | ;; "If the specified Var holds an IFn and is not marked as a macro, its 141 | ;; contents is replaced with a version wrapped in a tracking call; 142 | ;; otherwise nothing happens. Can be undone with untrack-var. 143 | 144 | ;; In the unary case, v should be a Var object or a symbol to be 145 | ;; resolved in the current namespace. 146 | 147 | ;; In the binary case, ns should be a namespace object or a symbol 148 | ;; naming a namespace and s a symbol to be resolved in that namespace." 149 | ;; ([ns s] 150 | ;; (track-var* (ns-resolve ns s))) 151 | ;; ([v] 152 | ;; (let [^clojure.lang.Var v (if (var? v) v (resolve v)) 153 | ;; ns (.ns v) 154 | ;; s (.sym v)] 155 | ;; (if (and (ifn? @v) (-> v meta :macro not) (-> v meta ::tracked not)) 156 | ;; (let [f @v 157 | ;; vname (symbol (str ns "/" s))] 158 | ;; (doto v 159 | ;; (alter-var-root #(fn tracking-wrapper [& args] 160 | ;; ;(trace-fn-call vname % args) 161 | ;; )) 162 | ;; (alter-meta! assoc ::tracked f))))))) 163 | 164 | ;; (defn untrack-var* 165 | ;; "Reverses the effect of track-var / track-vars / track-ns for the 166 | ;; given Var, replacing the tracked function with the original, untracked 167 | ;; version. No-op for non-tracked Vars. 168 | 169 | ;; Argument types are the same as those for track-var." 170 | ;; ([ns s] 171 | ;; (untrack-var* (ns-resolve ns s))) 172 | ;; ([v] 173 | ;; (let [^clojure.lang.Var v (if (var? v) v (resolve v)) 174 | ;; ns (.ns v) 175 | ;; s (.sym v) 176 | ;; f ((meta v) ::tracked)] 177 | ;; (when f 178 | ;; (doto v 179 | ;; (alter-var-root (constantly ((meta v) ::tracked))) 180 | ;; (alter-meta! dissoc ::tracked)))))) 181 | 182 | ;; (defmacro track-vars 183 | ;; "Track each of the specified Vars. 184 | ;; The arguments may be Var objects or symbols to be resolved in the current 185 | ;; namespace." 186 | ;; [& vs] 187 | ;; `(do ~@(for [x vs] 188 | ;; `(if (var? ~x) 189 | ;; (track-var* ~x) 190 | ;; (track-var* (quote ~x)))))) 191 | 192 | ;; (defmacro untrack-vars 193 | ;; "Untrack each of the specified Vars. 194 | ;; Reverses the effect of track-var / track-vars / track-ns for each 195 | ;; of the arguments, replacing the tracked functions with the original, 196 | ;; untracked versions." 197 | ;; [& vs] 198 | ;; `(do ~@(for [x vs] 199 | ;; `(if (var? ~x) 200 | ;; (untrack-var* ~x) 201 | ;; (untrack-var* (quote ~x)))))) 202 | 203 | ;; (defn track-ns* 204 | ;; "Replaces each function from the given namespace with a version wrapped 205 | ;; in a tracking call. Can be undone with untrack-ns. ns should be a namespace 206 | ;; object or a symbol. 207 | 208 | ;; No-op for clojure.core and gumshoe.track" 209 | ;; [ns] 210 | ;; (let [ns (the-ns ns)] 211 | ;; (when-not ('#{clojure.core gumshoe.track} (.name ns)) 212 | ;; (let [ns-fns (->> ns ns-interns vals (filter (comp fn? var-get)))] 213 | ;; (doseq [f ns-fns] 214 | ;; (track-var* f)))))) 215 | 216 | ;; (defn resolves-as-var? 217 | ;; "Try to resolve the symbol in several ways to find out if it's a var or not." 218 | ;; [n] 219 | ;; (cond 220 | ;; (coll? n) nil 221 | ;; (try (find-ns n) (catch Exception _)) nil 222 | ;; :else 223 | ;; (if-let [v (try (ns-resolve *ns* n) (catch Exception _))] (var? v)))) 224 | 225 | ;; (defmacro track-ns 226 | ;; "Track all fns in the given name space. The given name space can be quoted, unquoted or stored in a var. 227 | ;; We must try to resolve the expression passed to us partially to find out if it needs to be quoted or not 228 | ;; when passed to track-ns*" 229 | ;; [n] 230 | ;; (let [quote? (not (or (resolves-as-var? n) (and (coll? n) (= (first n) (quote quote))))) 231 | ;; n (if quote? (list 'quote n) n)] 232 | ;; `(track-ns* ~n))) 233 | 234 | ;; (defn untrack-ns* 235 | ;; "Reverses the effect of track-var / track-vars / track-ns for the 236 | ;; Vars in the given namespace, replacing each tracked function from the 237 | ;; given namespace with the original, untracked version." 238 | ;; [ns] 239 | ;; (let [ns-fns (->> ns the-ns ns-interns vals)] 240 | ;; (doseq [f ns-fns] 241 | ;; (untrack-var* f)))) 242 | 243 | ;; (defmacro untrack-ns 244 | ;; "Untrack all fns in the given name space. The given name space can be quoted, unquoted or stored in a var. 245 | ;; We must try to resolve the expression passed to us partially to find out if it needs to be quoted or not 246 | ;; when passed to untrack-ns*" 247 | ;; [n] 248 | ;; (let [quote? (not (or (resolves-as-var? n) (and (coll? n) (= (first n) (quote quote))))) 249 | ;; n (if quote? (list 'quote n) n)] 250 | ;; `(untrack-ns* ~n))) 251 | 252 | ;; (defn tracked? 253 | ;; "Returns true if the given var is currently tracked, false otherwise" 254 | ;; [v] 255 | ;; (let [^clojure.lang.Var v (if (var? v) v (resolve v))] 256 | ;; (-> v meta ::tracked nil? not))) 257 | 258 | ;; (defn trackable? 259 | ;; "Returns true if the given var can be tracked, false otherwise" 260 | ;; [v] 261 | ;; (let [^clojure.lang.Var v (if (var? v) v (resolve v))] 262 | ;; (and (ifn? @v) (-> v meta :macro not)))) 263 | 264 | ;; ;; TODO: 265 | ;; ;; 1. Helper to replay the function call 266 | ;; ;; a. Handle multiple arities 267 | ;; ;; - How do you know which arity was last called? 268 | ;; ;; 2. 269 | -------------------------------------------------------------------------------- /test/clojure/test_clojure/def.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | (ns clojure.test-clojure.def 10 | (:use clojure.test clojure.test-helper 11 | ;; This ns doesn't seem to be necessary 12 | ;;clojure.test-clojure.protocols 13 | ) 14 | (:require [gumshoe.track :refer (deft)])) 15 | 16 | ;; Copy of clojure.test-clojure.def, with defn switched for deft 17 | 18 | (deftest deft-error-messages 19 | (testing "multiarity syntax invalid parameter declaration" 20 | (is (fails-with-cause? 21 | IllegalArgumentException 22 | #"Parameter declaration \"arg1\" should be a vector" 23 | (eval-in-temp-ns (deft foo (arg1 arg2)))))) 24 | 25 | (testing "multiarity syntax invalid signature" 26 | (is (fails-with-cause? 27 | IllegalArgumentException 28 | #"Invalid signature \"\[a b\]\" should be a list" 29 | (eval-in-temp-ns (deft foo 30 | ([a] 1) 31 | [a b]))))) 32 | 33 | (testing "assume single arity syntax" 34 | (is (fails-with-cause? 35 | IllegalArgumentException 36 | #"Parameter declaration \"a\" should be a vector" 37 | (eval-in-temp-ns (deft foo a))))) 38 | 39 | (testing "bad name" 40 | (is (fails-with-cause? 41 | IllegalArgumentException 42 | #"First argument to deft must be a symbol" 43 | (eval-in-temp-ns (deft "bad docstring" testname [arg1 arg2]))))) 44 | 45 | (testing "missing parameter/signature" 46 | (is (fails-with-cause? 47 | IllegalArgumentException 48 | #"Parameter declaration missing" 49 | (eval-in-temp-ns (deft testname))))) 50 | 51 | (testing "allow trailing map" 52 | (is (eval-in-temp-ns (deft a "asdf" ([a] 1) {:a :b})))) 53 | 54 | (testing "don't allow interleaved map" 55 | (is (fails-with-cause? 56 | IllegalArgumentException 57 | #"Invalid signature \"\{:a :b\}\" should be a list" 58 | (eval-in-temp-ns (deft a "asdf" ([a] 1) {:a :b} ([] 1))))))) 59 | 60 | (deftest non-dynamic-warnings 61 | (testing "no warning for **" 62 | (is (empty? (with-err-print-writer 63 | (eval-in-temp-ns (deft ** ([a b] (Math/pow (double a) (double b))))))))) 64 | (testing "warning for *hello*" 65 | (is (not (empty? (with-err-print-writer 66 | (eval-in-temp-ns (def *hello* "hi")))))))) 67 | 68 | (deftest dynamic-redefinition 69 | ;; too many contextual things for this kind of caching to work... 70 | (testing "classes are never cached, even if their bodies are the same" 71 | (is (= :b 72 | (eval 73 | '(do 74 | (clojure.core/require '[gumshoe.track :refer (deft)]) 75 | (defmacro my-macro [] :a) 76 | (deft do-macro [] (my-macro)) 77 | (defmacro my-macro [] :b) 78 | (deft do-macro [] (my-macro)) 79 | (do-macro))))))) 80 | 81 | (deftest nested-dynamic-declaration 82 | (testing "vars :dynamic meta data is applied immediately to vars declared anywhere" 83 | (is (= 10 84 | (eval 85 | '(do 86 | (list 87 | (declare ^:dynamic p) 88 | (deft q [] @p)) 89 | (binding [p (atom 10)] 90 | (q)))))))) 91 | -------------------------------------------------------------------------------- /test/clojure/test_clojure/metadata.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | 9 | ; Authors: Stuart Halloway, Frantisek Sodomka 10 | 11 | (ns clojure.test-clojure.metadata 12 | (:use clojure.test 13 | [clojure.test-helper :only (eval-in-temp-ns)] 14 | [gumshoe.track :refer (deft)]) 15 | (:require [clojure.set :as set])) 16 | 17 | (deftest deft-primitive-args 18 | (testing "Hinting the arg vector of a primitive-taking fn with a non-primitive type should not result in AbstractMethodError when invoked." 19 | (testing "CLJ-850 is fixed when this case passes." 20 | (is (= "foo" 21 | (eval-in-temp-ns 22 | (deft f ^String [^String s ^long i] s) 23 | (f "foo" 1))))) 24 | #_(testing "These cases should pass, even without a fix for CLJ-850." 25 | (is (= "foo" 26 | (eval-in-temp-ns 27 | (deft f ^String [^String s] s) 28 | (f "foo")))) 29 | (is (= 1 30 | (eval-in-temp-ns 31 | (deft f ^long [^String s ^long i] i) 32 | (f "foo" 1)))) 33 | (is (= 1 34 | (eval-in-temp-ns 35 | (deft f ^long [^long i] i) 36 | (f 1))))))) 37 | -------------------------------------------------------------------------------- /test/clojure/test_helper.clj: -------------------------------------------------------------------------------- 1 | ; Copyright (c) Rich Hickey. All rights reserved. 2 | ; The use and distribution terms for this software are covered by the 3 | ; Eclipse Public License 1.0 (http://opensource.org/licenses/eclipse-1.0.php) 4 | ; which can be found in the file epl-v10.html at the root of this distribution. 5 | ; By using this software in any fashion, you are agreeing to be bound by 6 | ; the terms of this license. 7 | ; You must not remove this notice, or any other, from this software. 8 | ; 9 | 10 | ;; clojure.test-helper 11 | ;; 12 | ;; Utility functions shared by various tests in the Clojure 13 | ;; test suite 14 | ;; 15 | ;; tomfaulhaber (gmail) 16 | ;; Created 04 November 2010 17 | 18 | (ns clojure.test-helper 19 | (:use clojure.test)) 20 | 21 | (let [nl (System/getProperty "line.separator")] 22 | (defn platform-newlines [s] (.replace s "\n" nl))) 23 | 24 | (defn temp-ns 25 | "Create and return a temporary ns, using clojure.core + uses" 26 | [& uses] 27 | (binding [*ns* *ns*] 28 | (in-ns (gensym)) 29 | (apply clojure.core/use 'clojure.core uses) 30 | *ns*)) 31 | 32 | (defmacro eval-in-temp-ns [& forms] 33 | `(binding [*ns* *ns*] 34 | (in-ns (gensym)) 35 | (clojure.core/use 'clojure.core) 36 | (clojure.core/use 'gumshoe.track) 37 | (eval 38 | '(do ~@forms)))) 39 | 40 | (defn causes 41 | [^Throwable throwable] 42 | (loop [causes [] 43 | t throwable] 44 | (if t (recur (conj causes t) (.getCause t)) causes))) 45 | 46 | ;; this is how I wish clojure.test/thrown? worked... 47 | ;; Does body throw expected exception, anywhere in the .getCause chain? 48 | (defmethod assert-expr 'fails-with-cause? 49 | [msg [_ exception-class msg-re & body :as form]] 50 | `(try 51 | ~@body 52 | (report {:type :fail, :message ~msg, :expected '~form, :actual nil}) 53 | (catch Throwable t# 54 | (if (some (fn [cause#] 55 | (and 56 | (= ~exception-class (class cause#)) 57 | (re-find ~msg-re (.getMessage cause#)))) 58 | (causes t#)) 59 | (report {:type :pass, :message ~msg, 60 | :expected '~form, :actual t#}) 61 | (report {:type :fail, :message ~msg, 62 | :expected '~form, :actual t#}))))) 63 | 64 | 65 | (defn get-field 66 | "Access to private or protected field. field-name is a symbol or 67 | keyword." 68 | ([klass field-name] 69 | (get-field klass field-name nil)) 70 | ([klass field-name inst] 71 | (-> klass (.getDeclaredField (name field-name)) 72 | (doto (.setAccessible true)) 73 | (.get inst)))) 74 | 75 | (defn set-var-roots 76 | [maplike] 77 | (doseq [[var val] maplike] 78 | (alter-var-root var (fn [_] val)))) 79 | 80 | (defn with-var-roots* 81 | "Temporarily set var roots, run block, then put original roots back." 82 | [root-map f & args] 83 | (let [originals (doall (map (fn [[var _]] [var @var]) root-map))] 84 | (set-var-roots root-map) 85 | (try 86 | (apply f args) 87 | (finally 88 | (set-var-roots originals))))) 89 | 90 | (defmacro with-var-roots 91 | [root-map & body] 92 | `(with-var-roots* ~root-map (fn [] ~@body))) 93 | 94 | (defn exception 95 | "Use this function to ensure that execution of a program doesn't 96 | reach certain point." 97 | [] 98 | (throw (new Exception "Exception which should never occur"))) 99 | 100 | (defmacro with-err-print-writer 101 | "Evaluate with err pointing to a temporary PrintWriter, and 102 | return err contents as a string." 103 | [& body] 104 | `(let [s# (java.io.StringWriter.) 105 | p# (java.io.PrintWriter. s#)] 106 | (binding [*err* p#] 107 | ~@body 108 | (str s#)))) 109 | 110 | (defmacro with-err-string-writer 111 | "Evaluate with err pointing to a temporary StringWriter, and 112 | return err contents as a string." 113 | [& body] 114 | `(let [s# (java.io.StringWriter.)] 115 | (binding [*err* s#] 116 | ~@body 117 | (str s#)))) 118 | 119 | (defmacro should-print-err-message 120 | "Turn on all warning flags, and test that error message prints 121 | correctly for all semi-reasonable bindings of *err*." 122 | [msg-re form] 123 | `(binding [*warn-on-reflection* true] 124 | (is (re-matches ~msg-re (with-err-string-writer (eval-in-temp-ns ~form)))) 125 | (is (re-matches ~msg-re (with-err-print-writer (eval-in-temp-ns ~form)))))) 126 | 127 | (defmacro should-not-reflect 128 | "Turn on all warning flags, and test that reflection does not occur 129 | (as identified by messages to *err*)." 130 | [form] 131 | `(binding [*warn-on-reflection* true] 132 | (is (nil? (re-find #"^Reflection warning" (with-err-string-writer (eval-in-temp-ns ~form))))) 133 | (is (nil? (re-find #"^Reflection warning" (with-err-print-writer (eval-in-temp-ns ~form))))))) 134 | -------------------------------------------------------------------------------- /test/gumshoe/track_test.clj: -------------------------------------------------------------------------------- 1 | (ns gumshoe.track-test 2 | (:require [clojure.test :refer :all] 3 | [gumshoe.track :refer (deft)])) 4 | 5 | ;; Tests are in ../clojure, ported from the clojure/clojure repo 6 | 7 | (deftest a-test 8 | (is (= 1 1))) 9 | --------------------------------------------------------------------------------