Skip to content

Commit

Permalink
Implement a Trace command in the debugger
Browse files Browse the repository at this point in the history 
This command skips all further breakpoints (like :continue), but prints
their values via println.

Also fix and sanitize some tests for debug.clj
  • Loading branch information
@Malabarba
Malabarba committed Jan 31, 2016
1 parent 1349a89 commit 32f55ee
Show file tree
Hide file tree
Showing 5 changed files with 90 additions and 65 deletions.
25 changes: 20 additions & 5 deletions src/cider/nrepl/middleware/debug.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -83,15 +83,18 @@
"True if the breakpoint at coordinates should be skipped.
If the first element of `*skip-breaks*` is :all, return true.
Otherwise, the first element should be :deeper or :before.
Otherwise, the first element should be :deeper, :before, or :trace.
If :deeper, return true if the given coordinates are deeper than the
rest of `*skip-breaks*`. If :before, return true if they represent a
place before the rest."
rest of `*skip-breaks*`.
If :before, return true if they represent a place before the rest.
If :trace, return false."
[coordinates]
(when-let [[mode & skip-coords] @*skip-breaks*]
(case mode
;; From :continue, skip everything.
:all true
;; From :trace, never skip.
:trace false
;; From :out, skip some breaks.
:deeper (let [parent (take (count skip-coords) coordinates)]
(and (= skip-coords parent)
Expand Down Expand Up @@ -272,7 +275,7 @@
a :code entry, its value is used for operations such as :eval, which
would otherwise interactively prompt for an expression."
[value extras]
(let [commands (cond->> [:next :continue :out :here :inspect :locals :inject :eval :stacktrace :quit]
(let [commands (cond->> [:next :continue :out :here :inspect :locals :inject :eval :stacktrace :trace :quit]
(not (map? *msg*)) (remove #{:quit})
(cljs/grab-cljs-env *msg*) identity)
response-raw (read-debug extras commands nil)
Expand All @@ -295,13 +298,21 @@
:eval (let [return (read-debug-eval-expression "Expression to evaluate: " extras code)]
(read-debug-command value (assoc extras :debug-value (pr-short return))))
:stacktrace (stack-then-read-command value extras)
:trace (do (skip-breaks! :trace) value)
:quit (abort!))))

(defn print-step-indented [depth form value]
(print (apply str (repeat (dec depth) "| ")))
(binding [*print-length* 4
*print-level* 2]
(pr form))
(println "=>" (pr-short value)))

;;; ## High-level functions
(defmacro breakpoint
"Send the result of form and its coordinates to the client.
Sends a response to the message stored in debugger-message."
[form coor]
[form coor original-form]
`(binding [*skip-breaks* (or *skip-breaks* (atom nil))
*locals* ~(sanitize-env &env)
*pprint-fn* (:pprint-fn *msg*)]
Expand All @@ -311,6 +322,10 @@
(not (seq @debugger-message)) (do (println "Debugger not initialized")
(skip-breaks! :all)
val#)
;; The length of `coor` is a good indicator of current code
;; depth.
(= (first @*skip-breaks*) :trace) (do (print-step-indented ~(count coor) '~original-form val#)
val#)
:else (read-debug-command
val#
;; This *msg* is evaluated at compile-time, so it's
Expand Down
34 changes: 19 additions & 15 deletions src/cider/nrepl/middleware/util/instrument.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -135,23 +135,25 @@
(with-break (m/merge-meta (function form) (meta form))))
([form]
(let [{coor ::coor,
orig ::original-form,
bf ::breakfunction} (meta form)]
(when verbose-debug
(println "[DBG]" (not (not bf)) coor form))
(println "[DBG]" (not (not bf)) coor (or orig form)))
(cond
(and bf (seq coor))
(list bf form coor)
(list bf form coor orig)
;; If the form is a list and has no metadata, maybe it was
;; destroyed by a macro. Try guessing the coor by looking at
;; the first element. This fixes `->`, for instance.
(listy? form)
(let [{coor ::coor,
orig ::original-form,
bf ::breakfunction} (meta (first form))
coor (if (= (last coor) 0)
(pop coor)
coor)]
(if (and bf (seq coor))
(list bf form coor)
(list bf form coor orig)
form))
:else form))))

Expand Down Expand Up @@ -265,18 +267,20 @@
and wraps in a breakpoint any form that contains the previously
attached metadata."
[form]
(->> form
;; Fill the form with metadata. This will later tell us which
;; of the final (post-expansion) forms correspond to user
;; code (and where it came from).
(walk-indexed (fn [i f] (m/merge-meta f {::coor i})))
;; Expand so we don't have to deal with macros.
(m/macroexpand-all)
;; Go through everything again, and instrument any form with
;; debug metadata.
(instrument)
(#(do (when verbose-debug (println "[DBG]" %))
%))))
;; Fill the form with metadata. This will later tell us which of the
;; final (post-expansion) forms correspond to user code (and where
;; it came from).
(-> (walk-indexed (fn [i f] (m/merge-meta f {::coor i}))
form)
;; Expand so we don't have to deal with macros.
(m/macroexpand-all ::original-form)
;; Go through everything again, and instrument any form with
;; debug metadata.
(instrument)
(#(do (when verbose-debug
(println "[DBG]" %)
(flush))
%))))

(defn list-instrumented-defs [ns]
(let [ns (if (instance? clojure.lang.Namespace ns) ns
Expand Down
21 changes: 12 additions & 9 deletions src/cider/nrepl/middleware/util/meta.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -14,23 +14,26 @@
(apply vary-meta obj merge metamaps)
(catch Exception e obj)))

(defn strip-meta [form]
(if (meta form)
(with-meta form nil)
form))

(defn macroexpand-all
"Like clojure.walk/macroexpand-all, but preserves and macroexpands
metadata."
[form]
metadata. Also store the original form (unexpanded and stripped of
metadata) in the metadata of the expanded form under original-key."
[form & [original-key]]
(let [md (meta form)
expanded (walk/walk macroexpand-all
expanded (walk/walk #(macroexpand-all % original-key)
identity
(if (seq? form) (macroexpand form) form))]
(if md
;; Macroexpand the metadata too, because sometimes metadata
;; contains, for example, functions. This is the case for
;; deftest forms.
(merge-meta expanded
(macroexpand-all md))
(macroexpand-all md)
(when original-key
{original-key (strip-meta form)}))
expanded)))

(defn strip-meta [form]
(if (meta form)
(with-meta form nil)
form))
44 changes: 22 additions & 22 deletions test/clj/cider/nrepl/middleware/debug_test.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -127,16 +127,16 @@
(is (= "HI" (:message (last (:causes @resp)))))))))

(deftest initialize
(reset! d/debugger-message nil)
(let [resp (atom nil)]
(with-redefs [t/send (fn [_ response] (reset! resp response))]
(#'d/initialize {:hi true}))
(is (= @d/debugger-message {:hi true}))
(is (not (:status @resp))))
(let [resp (atom nil)]
(with-redefs [t/send (fn [_ response] (reset! resp response))]
(#'d/initialize {:hi true}))
(is (:status @resp))))
(with-redefs [d/debugger-message (atom nil)]
(let [resp (atom nil)]
(with-redefs [t/send (fn [_ response] (reset! resp response))]
(#'d/initialize {:hi true}))
(is (= @d/debugger-message {:hi true}))
(is (not (:status @resp))))
(let [resp (atom nil)]
(with-redefs [t/send (fn [_ response] (reset! resp response))]
(#'d/initialize {:hi true}))
(is (:status @resp)))))

(deftest locals-for-message
(let [x 1
Expand Down Expand Up @@ -200,20 +200,20 @@
(deftest breakpoint
;; Map merging
(with-redefs [d/read-debug-command (fn [v e] (assoc e :value v))
d/debugger-message (atom [:fake])]
(binding [*msg* {:session (atom {}) :code :code, :id :id,
:file :file, :line :line, :column :column}]
(let [m (eval '(cider.nrepl.middleware.debug/breakpoint (inc 10) [6]))]
d/debugger-message (atom [:fake])
d/*skip-breaks* (atom nil)]
(binding [*msg* {:session (atom {}) :code :code, :id :id,
:file :file, :line :line, :column :column}]
(let [m (eval `(d/breakpoint (inc 10) [6] ~'(inc 10)))]
(are [k v] (= (k m) v)
:value 11
:value 11
:debug-value "11"
:coor [6]
:file :file
:line :line
:column :column
:code :code
:coor [6]
:file :file
:line :line
:column :column
:code :code
:original-id :id))
;; Locals capturing
(reset! @#'d/debugger-message nil)
(is (= (eval '(let [x 10] (cider.nrepl.middleware.debug/breakpoint cider.nrepl.middleware.debug/*locals* [])))
(is (= (:value (eval `(let [~'x 10] (d/breakpoint d/*locals* [] nil))))
'{x 10})))))
31 changes: 17 additions & 14 deletions test/clj/cider/nrepl/middleware/util/instrument_test.clj
View file
Original file line number Diff line number Diff line change
Expand Up @@ -44,6 +44,9 @@
(-> #(t/tag-form % #'bp)
(walk/postwalk form)
t/instrument-tagged-code
;; A final macroexpand-all to cause the `bp` macro above to
;; execute. In regular usage, this would be a complete
;; expand+eval done by the Clojure compiler.
m/macroexpand-all)
;; Replace #'bp with 'bp for easier print and comparison.
(walk/postwalk #(if (= % #'bp) 'bp %) @bp-tracker))
Expand Down Expand Up @@ -77,28 +80,28 @@
(= x 1) true
false never
:else final)
'#{[final [6]] [x [1 1]] [never [4]] [(= (bp x [1 1]) 1) [1]]}))
'#{[final [6]] [x [1 1]] [never [4]] [(= (bp x [1 1] x) 1) [1]]}))

(deftest instrument-recur
(is (= (breakpoint-tester '(loop [x '(1 2)]
(if (seq x)
(recur (rest x))
x)))
'#{[(rest (bp x [2 2 1 1])) [2 2 1]]
'#{[(rest (bp x [2 2 1 1] x)) [2 2 1]]
[x [2 2 1 1]]
[x [2 1 1]]
[x [2 3]]
[(seq (bp x [2 1 1])) [2 1]]}))
[(seq (bp x [2 1 1] x)) [2 1]]}))

(is (= (breakpoint-tester '(fn [x]
(if (seq x)
(recur (rest x))
x)))
'#{[(rest (bp x [2 2 1 1])) [2 2 1]]
'#{[(rest (bp x [2 2 1 1] x)) [2 2 1]]
[x [2 2 1 1]]
[x [2 1 1]]
[x [2 3]]
[(seq (bp x [2 1 1])) [2 1]]})))
[(seq (bp x [2 1 1] x)) [2 1]]})))

(deftest instrument-reify
(is (= (breakpoint-tester '(reify Transport
Expand All @@ -108,21 +111,21 @@
(inspect-reply msg response)
(.send transport response))
this)))
'#{[(. (bp transport [3 2 3 1]) send (bp response [3 2 3 2])) [3 2 3]]
'#{[(. (bp transport [3 2 3 1] transport) send (bp response [3 2 3 2] response)) [3 2 3]]
[response [3 2 1 1]]
[(if (bp (contains? (bp response [3 2 1 1]) :value) [3 2 1])
(bp (inspect-reply (bp msg [3 2 2 1]) (bp response [3 2 2 2])) [3 2 2])
(bp (. (bp transport [3 2 3 1]) send (bp response [3 2 3 2])) [3 2 3]))
[(if (bp (contains? (bp response [3 2 1 1] response) :value) [3 2 1] (contains? response :value))
(bp (inspect-reply (bp msg [3 2 2 1] msg) (bp response [3 2 2 2] response)) [3 2 2] (inspect-reply msg response))
(bp (. (bp transport [3 2 3 1] transport) send (bp response [3 2 3 2] response)) [3 2 3] (.send transport response)))
[3 2]]
[response [3 2 2 2]]
[response [3 2 3 2]]
[transport [2 2 1]]
[(inspect-reply (bp msg [3 2 2 1]) (bp response [3 2 2 2])) [3 2 2]]
[(inspect-reply (bp msg [3 2 2 1] msg) (bp response [3 2 2 2] response)) [3 2 2]]
[transport [3 2 3 1]]
[this [3 3]]
[msg [3 2 2 1]]
[(contains? (bp response [3 2 1 1]) :value) [3 2 1]]
[(. (bp transport [2 2 1]) recv) [2 2]]})))
[(contains? (bp response [3 2 1 1] response) :value) [3 2 1]]
[(. (bp transport [2 2 1] transport) recv) [2 2]]})))

(deftest instrument-function-call
(is (empty? (breakpoint-tester '(System/currentTimeMillis))))
Expand All @@ -131,8 +134,8 @@
(let [start-time (System/currentTimeMillis)]
(Thread/sleep 1000)
(- (System/currentTimeMillis) start-time))))
'#{[(let* [start-time (bp (. System currentTimeMillis) [3 1 1])] (bp (. Thread sleep 1000) [3 2]) (bp (- (bp (. System currentTimeMillis) [3 3 1]) (bp start-time [3 3 2])) [3 3])) [3]]
[(- (bp (. System currentTimeMillis) [3 3 1]) (bp start-time [3 3 2])) [3 3]]
'#{[(let* [start-time (bp (. System currentTimeMillis) [3 1 1] (System/currentTimeMillis))] (bp (. Thread sleep 1000) [3 2] (Thread/sleep 1000)) (bp (- (bp (. System currentTimeMillis) [3 3 1] (System/currentTimeMillis)) (bp start-time [3 3 2] start-time)) [3 3] (- (System/currentTimeMillis) start-time))) [3]]
[(- (bp (. System currentTimeMillis) [3 3 1] (System/currentTimeMillis)) (bp start-time [3 3 2] start-time)) [3 3]]
[(. System currentTimeMillis) [3 1 1]]
[(. Thread sleep 1000) [3 2]]
[start-time [3 3 2]]
Expand Down

0 comments on commit 32f55ee

Please sign in to comment.